[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/igc c5268618e38 1/3: Merge branch 'master' into scratch/igc
|
From: |
Gerd Moellmann |
|
Subject: |
scratch/igc c5268618e38 1/3: Merge branch 'master' into scratch/igc |
|
Date: |
Sun, 26 May 2024 03:37:16 -0400 (EDT) |
branch: scratch/igc
commit c5268618e3805b8f199846afc2988bd656a55f50
Merge: 63f2db2380a 45a631134fb
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>
Merge branch 'master' into scratch/igc
---
.dir-locals.el | 6 +-
.gitignore | 4 +
INSTALL.REPO | 2 +-
admin/MAINTAINERS | 1 +
admin/merge-gnulib | 6 +-
admin/syncdoc-type-hierarchy.el | 5 +-
build-aux/make-info-dir | 5 +-
build-aux/makecounter.sh | 1 +
config.bat | 1 +
configure.ac | 37 +-
cross/Makefile.in | 2 +-
cross/ndk-build/ndk-build.mk.in | 1 +
doc/emacs/ack.texi | 3 +-
doc/emacs/android.texi | 46 +-
doc/emacs/calendar.texi | 262 +++--
doc/emacs/dired.texi | 13 +-
doc/emacs/display.texi | 7 +
doc/emacs/files.texi | 8 +
doc/emacs/frames.texi | 8 +-
doc/emacs/input.texi | 41 +-
doc/emacs/maintaining.texi | 53 +-
doc/emacs/misc.texi | 2 +-
doc/emacs/mule.texi | 10 +
doc/emacs/package.texi | 8 +-
doc/emacs/programs.texi | 9 +-
doc/emacs/regs.texi | 15 +-
doc/emacs/rmail.texi | 45 +-
doc/emacs/search.texi | 1 +
doc/emacs/sending.texi | 8 +-
doc/lispintro/emacs-lisp-intro.texi | 6 +-
doc/lispref/commands.texi | 12 +-
doc/lispref/compile.texi | 85 +-
doc/lispref/control.texi | 22 +-
doc/lispref/display.texi | 65 +-
doc/lispref/elisp.texi | 4 +-
doc/lispref/elisp_type_hierarchy.jpg | Bin 288444 -> 358821
bytes
doc/lispref/elisp_type_hierarchy.txt | 58 +-
doc/lispref/frames.texi | 32 +-
doc/lispref/functions.texi | 97 +-
doc/lispref/keymaps.texi | 6 +-
doc/lispref/lists.texi | 16 +-
doc/lispref/modes.texi | 10 +-
doc/lispref/objects.texi | 42 +-
doc/lispref/parsing.texi | 58 +-
doc/lispref/peg.texi | 13 +-
doc/lispref/processes.texi | 16 +-
doc/lispref/sequences.texi | 2 +-
doc/lispref/strings.texi | 18 +-
doc/lispref/variables.texi | 4 +-
doc/lispref/windows.texi | 20 +-
doc/misc/auth.texi | 2 +-
doc/misc/calc.texi | 11 +-
doc/misc/ede.texi | 12 +-
doc/misc/emacs-mime.texi | 4 +
doc/misc/erc.texi | 11 +-
doc/misc/ert.texi | 3 +-
doc/misc/eshell.texi | 25 +-
doc/misc/flymake.texi | 37 +-
doc/misc/gnus.texi | 93 ++
doc/misc/reftex.texi | 2 +-
doc/misc/tramp.texi | 311 ++++--
doc/misc/vtable.texi | 18 +-
doc/misc/widget.texi | 47 +-
etc/ERC-NEWS | 33 +-
etc/NEWS | 438 ++++++--
etc/NEWS.unknown | 31 +
etc/PROBLEMS | 65 +-
etc/compilation.txt | 39 +
etc/schema/README | 20 +
etc/schema/dotnet-appconfig.rnc | 411 +++++++
etc/schema/dotnet-packages-config.rnc | 11 +
etc/schema/dotnet-packages-props.rnc | 22 +
etc/schema/dotnet-resx.rnc | 57 +
etc/schema/msbuild.rnc | 1041 ++++++++++++++++++
etc/schema/nuget.rnc | 25 +
etc/schema/nuspec.rnc | 100 ++
etc/schema/schemas.xml | 27 +
java/INSTALL | 92 +-
java/Makefile.in | 99 +-
java/org/gnu/emacs/EmacsActivity.java | 44 +-
java/org/gnu/emacs/EmacsClipboard.java | 9 +-
java/org/gnu/emacs/EmacsContextMenu.java | 7 +-
java/org/gnu/emacs/EmacsCursor.java | 4 +-
java/org/gnu/emacs/EmacsDialog.java | 6 +-
java/org/gnu/emacs/EmacsDrawLine.java | 111 +-
java/org/gnu/emacs/EmacsDrawRectangle.java | 21 +-
java/org/gnu/emacs/EmacsFillRectangle.java | 107 +-
java/org/gnu/emacs/EmacsGC.java | 117 +-
java/org/gnu/emacs/EmacsHandleObject.java | 11 +-
java/org/gnu/emacs/EmacsInputConnection.java | 2 +-
java/org/gnu/emacs/EmacsNative.java | 150 ++-
java/org/gnu/emacs/EmacsOpenActivity.java | 47 +-
java/org/gnu/emacs/EmacsPixmap.java | 4 +-
java/org/gnu/emacs/EmacsPreferencesActivity.java | 6 +-
java/org/gnu/emacs/EmacsSafThread.java | 8 +-
java/org/gnu/emacs/EmacsSdk11Clipboard.java | 127 +--
java/org/gnu/emacs/EmacsSdk8Clipboard.java | 44 +-
java/org/gnu/emacs/EmacsService.java | 91 +-
java/org/gnu/emacs/EmacsThread.java | 38 +-
java/org/gnu/emacs/EmacsTileObject.java | 101 ++
java/org/gnu/emacs/EmacsView.java | 53 +-
java/org/gnu/emacs/EmacsWindow.java | 142 ++-
java/org/gnu/emacs/EmacsWindowManager.java | 2 +-
lib-src/emacsclient.c | 30 +-
lib-src/etags.c | 78 +-
lib-src/make-docfile.c | 10 +-
lib/acl.h | 10 +
lib/allocator.h | 10 +
lib/binary-io.h | 10 +
lib/boot-time-aux.h | 39 +-
lib/{count-trailing-zeros.c => byteswap.c} | 8 +-
lib/byteswap.in.h | 101 +-
lib/careadlinkat.h | 10 +
lib/cloexec.h | 10 +
lib/close-stream.h | 10 +
lib/count-leading-zeros.h | 138 ---
lib/count-one-bits.h | 166 ---
lib/count-trailing-zeros.h | 128 ---
lib/execinfo.in.h | 10 +
lib/fcntl.in.h | 3 +-
lib/filevercmp.h | 10 +
lib/fpending.h | 10 +
lib/fsusage.h | 14 +-
lib/ftoastr.h | 10 +
lib/gnulib.mk.in | 161 ++-
lib/idx.h | 10 +
lib/intprops-internal.h | 8 +-
lib/memset_explicit.c | 6 +-
lib/mini-gmp.c | 16 +-
lib/openat-priv.h | 10 +
lib/openat.h | 10 +
lib/save-cwd.h | 12 +-
lib/sha512.c | 2 +-
lib/{count-leading-zeros.c => stdbit.c} | 10 +-
lib/stdbit.in.h | 1077 +++++++++++++++++++
lib/{count-leading-zeros.c => stdc_bit_width.c} | 9 +-
lib/{count-one-bits.c => stdc_count_ones.c} | 11 +-
...count-trailing-zeros.c => stdc_leading_zeros.c} | 9 +-
...ount-trailing-zeros.c => stdc_trailing_zeros.c} | 9 +-
lib/stddef.in.h | 33 +-
lib/stdio.in.h | 19 +-
lib/stdlib.in.h | 57 +
lib/strftime.c | 69 +-
lib/sys_select.in.h | 2 +
lib/sys_types.in.h | 9 +
lib/u64.h | 68 +-
lib/unistd.in.h | 17 +-
lib/utimens.h | 19 +
lisp/arc-mode.el | 11 +-
lisp/auth-source.el | 40 +-
lisp/bindings.el | 2 +-
lisp/bookmark.el | 47 +-
lisp/calendar/todo-mode.el | 24 +-
lisp/cedet/srecode/find.el | 4 +-
lisp/cmuscheme.el | 6 +-
lisp/color.el | 41 +-
lisp/comint.el | 130 +--
lisp/completion-preview.el | 334 ++++--
lisp/cus-edit.el | 51 +-
lisp/cus-face.el | 5 +-
lisp/custom.el | 3 +-
lisp/dabbrev.el | 11 +-
lisp/dired-aux.el | 142 ++-
lisp/dired.el | 22 +-
lisp/dnd.el | 9 +-
lisp/doc-view.el | 58 +-
lisp/emacs-lisp/backtrace.el | 28 +-
lisp/emacs-lisp/byte-opt.el | 19 +-
lisp/emacs-lisp/byte-run.el | 18 +-
lisp/emacs-lisp/bytecomp.el | 110 +-
lisp/emacs-lisp/cconv.el | 38 +-
lisp/emacs-lisp/cl-generic.el | 2 +-
lisp/emacs-lisp/cl-preloaded.el | 15 +-
lisp/emacs-lisp/cl-print.el | 34 +-
lisp/emacs-lisp/cl-seq.el | 14 +-
lisp/emacs-lisp/comp-common.el | 66 +-
lisp/emacs-lisp/comp.el | 53 +-
lisp/emacs-lisp/disass.el | 39 +-
lisp/emacs-lisp/easy-mmode.el | 15 +-
lisp/emacs-lisp/edebug.el | 8 +-
lisp/emacs-lisp/ert.el | 3 +-
lisp/emacs-lisp/lisp-mode.el | 1 -
lisp/emacs-lisp/lisp.el | 3 +-
lisp/emacs-lisp/loaddefs-gen.el | 4 +-
lisp/emacs-lisp/map-ynp.el | 16 +-
lisp/emacs-lisp/multisession.el | 3 +
lisp/emacs-lisp/nadvice.el | 6 +-
lisp/emacs-lisp/oclosure.el | 96 +-
lisp/emacs-lisp/package-vc.el | 8 +-
lisp/emacs-lisp/package.el | 10 +-
lisp/emacs-lisp/pcase.el | 3 +-
lisp/emacs-lisp/regexp-opt.el | 3 +-
lisp/emacs-lisp/rx.el | 7 +
lisp/emacs-lisp/track-changes.el | 27 +-
lisp/emacs-lisp/vtable.el | 98 +-
lisp/emacs-lisp/warnings.el | 23 +-
lisp/env.el | 3 +-
lisp/epa-file.el | 9 +-
lisp/erc/erc-backend.el | 16 +-
lisp/erc/erc-button.el | 13 +-
lisp/erc/erc-common.el | 9 +
lisp/erc/erc-fill.el | 171 ++-
lisp/erc/erc-log.el | 4 +-
lisp/erc/erc-networks.el | 95 +-
lisp/erc/erc-services.el | 50 +-
lisp/erc/erc-stamp.el | 278 +++--
lisp/erc/erc-track.el | 6 +-
lisp/erc/erc.el | 201 +++-
lisp/eshell/em-glob.el | 30 +-
lisp/eshell/em-hist.el | 8 +-
lisp/eshell/em-ls.el | 1 -
lisp/eshell/em-unix.el | 4 +-
lisp/eshell/esh-cmd.el | 27 +-
lisp/eshell/esh-ext.el | 79 +-
lisp/eshell/esh-mode.el | 9 +-
lisp/eshell/esh-proc.el | 2 +
lisp/eshell/esh-util.el | 3 +-
lisp/eshell/eshell.el | 3 +-
lisp/face-remap.el | 7 +-
lisp/files.el | 57 +-
lisp/find-dired.el | 3 +-
lisp/gnus/gnus-draft.el | 46 +-
lisp/gnus/gnus-search.el | 9 +-
lisp/gnus/gnus-sum.el | 10 +-
lisp/gnus/gnus.el | 1 +
lisp/gnus/message.el | 6 +-
lisp/gnus/mm-view.el | 2 +-
lisp/gnus/mml-smime.el | 49 +-
lisp/gnus/mml.el | 8 +
lisp/gnus/nnatom.el | 277 +++++
lisp/gnus/nnfeed.el | 683 ++++++++++++
lisp/gnus/nnimap.el | 2 +-
lisp/gnus/smime.el | 7 +-
lisp/help-fns.el | 37 +-
lisp/help-mode.el | 4 +-
lisp/help.el | 11 +-
lisp/image/image-dired-tags.el | 24 -
lisp/image/image-dired-util.el | 2 +
lisp/image/image-dired.el | 22 +
lisp/imenu.el | 67 +-
lisp/info.el | 10 +-
lisp/international/textsec.el | 85 +-
lisp/isearch.el | 8 +-
lisp/jsonrpc.el | 7 +-
lisp/keymap.el | 46 +-
lisp/kmacro.el | 2 +-
lisp/loadup.el | 17 +
lisp/mail/rmailsum.el | 4 +-
lisp/mail/smtpmail.el | 2 +-
lisp/menu-bar.el | 31 +-
lisp/minibuffer.el | 103 +-
lisp/net/dictionary.el | 105 +-
lisp/net/eww.el | 136 ++-
lisp/net/rcirc.el | 2 +-
lisp/net/sasl-cram.el | 2 +-
lisp/net/sasl-digest.el | 2 +-
lisp/net/sasl.el | 2 +-
lisp/net/shr.el | 3 +-
lisp/net/tramp-adb.el | 17 +-
lisp/net/tramp-androidsu.el | 96 +-
lisp/net/tramp-cache.el | 14 +-
lisp/net/tramp-cmds.el | 59 +-
lisp/net/tramp-compat.el | 55 +-
lisp/net/tramp-container.el | 245 +++--
lisp/net/tramp-gvfs.el | 8 +-
lisp/net/tramp-message.el | 10 +
lisp/net/tramp-rclone.el | 11 +-
lisp/net/tramp-sh.el | 533 +++++----
lisp/net/tramp-smb.el | 8 +-
lisp/net/tramp-sshfs.el | 13 +-
lisp/net/tramp.el | 122 ++-
lisp/pixel-scroll.el | 10 +-
lisp/play/doctor.el | 24 +-
lisp/profiler.el | 5 +-
lisp/progmodes/bug-reference.el | 31 +-
lisp/progmodes/c-ts-common.el | 78 +-
lisp/progmodes/c-ts-mode.el | 18 +-
lisp/progmodes/cc-engine.el | 5 +-
lisp/progmodes/compile.el | 7 +
lisp/progmodes/cperl-mode.el | 10 +-
lisp/progmodes/csharp-mode.el | 4 +-
lisp/progmodes/eglot.el | 281 +++--
lisp/progmodes/elisp-mode.el | 17 +-
lisp/progmodes/etags-regen.el | 4 +-
lisp/progmodes/flymake.el | 156 ++-
lisp/progmodes/glasses.el | 3 +-
lisp/progmodes/go-ts-mode.el | 17 +-
lisp/progmodes/grep.el | 99 +-
lisp/progmodes/inf-lisp.el | 3 +-
lisp/progmodes/lua-ts-mode.el | 70 +-
lisp/progmodes/project.el | 85 +-
lisp/progmodes/python.el | 81 +-
lisp/progmodes/ruby-mode.el | 26 +-
lisp/progmodes/ruby-ts-mode.el | 17 +-
lisp/progmodes/rust-ts-mode.el | 24 +-
lisp/progmodes/sh-script.el | 3 +-
lisp/progmodes/sql.el | 2 +
lisp/progmodes/xref.el | 43 +-
lisp/repeat.el | 35 +-
lisp/ruler-mode.el | 130 +--
lisp/scroll-bar.el | 4 +-
lisp/shell.el | 3 +-
lisp/simple.el | 91 +-
lisp/subr.el | 76 +-
lisp/tab-bar.el | 31 +-
lisp/tab-line.el | 112 +-
lisp/tar-mode.el | 6 +
lisp/term/android-win.el | 4 +-
lisp/textmodes/ispell.el | 4 +
lisp/textmodes/mhtml-mode.el | 2 +-
lisp/textmodes/reftex-cite.el | 9 +-
lisp/textmodes/sgml-mode.el | 1 +
lisp/textmodes/tex-mode.el | 6 +-
lisp/thingatpt.el | 107 +-
lisp/tool-bar.el | 28 +-
lisp/tooltip.el | 2 +-
lisp/touch-screen.el | 63 +-
lisp/treesit.el | 171 +--
lisp/url/url-util.el | 89 +-
lisp/use-package/use-package-core.el | 60 +-
lisp/vc/log-edit.el | 10 +-
lisp/vc/vc-git.el | 2 +-
lisp/vc/vc.el | 2 +
lisp/whitespace.el | 2 +-
lisp/wid-edit.el | 21 +-
lisp/window-tool-bar.el | 510 +++++++++
lisp/window.el | 13 +-
m4/00gnulib.m4 | 3 +-
m4/__inline.m4 | 5 +-
m4/absolute-header.m4 | 3 +-
m4/acl.m4 | 11 +-
m4/alloca.m4 | 3 +-
m4/assert_h.m4 | 3 +-
m4/builtin-expect.m4 | 6 +-
m4/byteswap.m4 | 32 +-
m4/c-bool.m4 | 6 +-
m4/canonicalize.m4 | 3 +-
m4/clock_time.m4 | 3 +-
m4/codeset.m4 | 3 +-
m4/copy-file-range.m4 | 3 +-
m4/d-type.m4 | 12 +-
m4/dirent_h.m4 | 3 +-
m4/dirfd.m4 | 10 +-
m4/double-slash-root.m4 | 3 +-
m4/dup2.m4 | 3 +-
m4/eealloc.m4 | 3 +-
m4/environ.m4 | 3 +-
m4/errno_h.m4 | 3 +-
m4/euidaccess.m4 | 3 +-
m4/execinfo.m4 | 6 +-
m4/extensions.m4 | 24 +-
m4/extern-inline.m4 | 6 +-
m4/faccessat.m4 | 5 +-
m4/fchmodat.m4 | 3 +-
m4/fcntl.m4 | 5 +-
m4/fcntl_h.m4 | 4 +-
m4/fdopendir.m4 | 5 +-
m4/filemode.m4 | 3 +-
m4/flexmember.m4 | 11 +-
m4/fpending.m4 | 10 +-
m4/fpieee.m4 | 3 +-
m4/free.m4 | 11 +-
m4/fstatat.m4 | 3 +-
m4/fsusage.m4 | 12 +-
m4/fsync.m4 | 3 +-
m4/futimens.m4 | 5 +-
m4/getdelim.m4 | 3 +-
m4/getdtablesize.m4 | 3 +-
m4/getgroups.m4 | 11 +-
m4/getline.m4 | 3 +-
m4/getloadavg.m4 | 17 +-
m4/getopt.m4 | 3 +-
m4/getrandom.m4 | 3 +-
m4/gettime.m4 | 3 +-
m4/gettimeofday.m4 | 10 +-
m4/gnulib-common.m4 | 7 +-
m4/gnulib-comp.m4 | 49 +-
m4/group-member.m4 | 11 +-
m4/ieee754-h.m4 | 6 +-
m4/include_next.m4 | 3 +-
m4/inttypes.m4 | 3 +-
m4/largefile.m4 | 45 +-
m4/lchmod.m4 | 4 +-
m4/libgmp.m4 | 3 +-
m4/limits-h.m4 | 6 +-
m4/lstat.m4 | 11 +-
m4/malloc.m4 | 3 +-
m4/manywarnings.m4 | 5 +-
m4/mbstate_t.m4 | 3 +-
m4/md5.m4 | 3 +-
m4/memmem.m4 | 3 +-
m4/mempcpy.m4 | 3 +-
m4/memrchr.m4 | 3 +-
m4/memset_explicit.m4 | 5 +-
m4/minmax.m4 | 3 +-
m4/mkostemp.m4 | 3 +-
m4/mktime.m4 | 4 +-
m4/mode_t.m4 | 3 +-
m4/multiarch.m4 | 3 +-
m4/musl.m4 | 3 +-
m4/nanosleep.m4 | 12 +-
m4/ndk-build.m4 | 11 +
m4/nocrash.m4 | 3 +-
m4/nproc.m4 | 3 +-
m4/nstrftime.m4 | 11 +-
m4/off_t.m4 | 3 +-
m4/open-cloexec.m4 | 6 +-
m4/open-slash.m4 | 3 +-
m4/open.m4 | 3 +-
m4/pathmax.m4 | 3 +-
m4/pid_t.m4 | 3 +-
m4/pipe2.m4 | 3 +-
m4/pselect.m4 | 3 +-
m4/pthread_sigmask.m4 | 3 +-
m4/rawmemchr.m4 | 3 +-
m4/readlink.m4 | 3 +-
m4/readlinkat.m4 | 5 +-
m4/readutmp.m4 | 3 +-
m4/realloc.m4 | 3 +-
m4/regex.m4 | 11 +-
m4/sha1.m4 | 3 +-
m4/sha256.m4 | 3 +-
m4/sha512.m4 | 3 +-
m4/sig2str.m4 | 1 +
m4/sigdescr_np.m4 | 3 +-
m4/signal_h.m4 | 3 +-
m4/socklen.m4 | 3 +-
m4/ssize_t.m4 | 3 +-
m4/stat-time.m4 | 14 +-
m4/std-gnu11.m4 | 3 +
m4/stdalign.m4 | 8 +-
m4/stdbit_h.m4 | 37 +
m4/stddef_h.m4 | 35 +-
m4/stdint.m4 | 3 +-
m4/stdio_h.m4 | 3 +-
m4/stdlib_h.m4 | 8 +-
m4/stpcpy.m4 | 3 +-
m4/string_h.m4 | 14 +-
m4/strnlen.m4 | 3 +-
m4/strtoimax.m4 | 3 +-
m4/strtoll.m4 | 3 +-
m4/symlink.m4 | 5 +-
m4/sys_random_h.m4 | 3 +-
m4/sys_select_h.m4 | 3 +-
m4/sys_socket_h.m4 | 3 +-
m4/sys_stat_h.m4 | 3 +-
m4/sys_time_h.m4 | 11 +-
m4/sys_types_h.m4 | 6 +-
m4/tempname.m4 | 12 +-
m4/time_h.m4 | 13 +-
m4/time_r.m4 | 6 +-
m4/time_rz.m4 | 6 +-
m4/timegm.m4 | 3 +-
m4/timer_time.m4 | 3 +-
m4/timespec.m4 | 13 +-
m4/tm_gmtoff.m4 | 3 +-
m4/unistd_h.m4 | 3 +-
m4/unlocked-io.m4 | 13 +-
m4/utimens.m4 | 4 +-
m4/utimensat.m4 | 5 +-
m4/vararrays.m4 | 14 +-
m4/warnings.m4 | 3 +-
m4/wchar_t.m4 | 3 +-
m4/xattr.m4 | 11 +-
m4/zzgnulib.m4 | 3 +-
msdos/sedlibmk.inp | 8 +
oldXMenu/Activate.c | 2 +-
src/.gdbinit | 17 +-
src/Makefile.in | 8 +-
src/alloc.c | 54 +-
src/android.c | 1129 +++++++-------------
src/android.h | 32 +-
src/androidfns.c | 109 +-
src/androidfont.c | 16 +-
src/androidgui.h | 42 +-
src/androidmenu.c | 3 +-
src/androidselect.c | 340 ++++--
src/androidterm.c | 325 ++++--
src/androidterm.h | 9 +-
src/androidvfs.c | 320 +++---
src/buffer.c | 25 +-
src/bytecode.c | 26 +-
src/callint.c | 19 +-
src/callproc.c | 8 +-
src/charset.c | 3 +-
src/cmds.c | 3 +-
src/coding.c | 7 +-
src/comp.c | 14 +-
src/data.c | 215 ++--
src/dbusbind.c | 20 +-
src/dired.c | 7 +-
src/dispextern.h | 37 +-
src/dispnew.c | 2 +-
src/doc.c | 25 +-
src/dosfns.c | 3 +-
src/editfns.c | 9 +-
src/emacs.c | 35 +-
src/epaths.in | 5 +-
src/eval.c | 266 +++--
src/fileio.c | 18 +-
src/filelock.c | 7 +-
src/fns.c | 35 +-
src/fontset.c | 26 +-
src/frame.c | 10 +-
src/frame.h | 4 +
src/ftfont.c | 26 +-
src/gmalloc.c | 10 +-
src/gnutls.c | 183 ++--
src/gtkutil.c | 7 +-
src/haikuterm.c | 103 +-
src/hbfont.c | 2 +
src/image.c | 45 +-
src/intervals.c | 9 +-
src/intervals.h | 23 +-
src/keyboard.c | 55 +-
src/keyboard.h | 4 +-
src/keymap.c | 14 +-
src/lisp.h | 102 +-
src/lread.c | 151 ++-
src/marker.c | 2 +-
src/minibuf.c | 29 +-
src/msdos.c | 13 +-
src/nsfns.m | 58 +-
src/nsfont.m | 33 +-
src/nsmenu.m | 1 -
src/nsterm.h | 4 +
src/nsterm.m | 200 +++-
src/pdumper.c | 4 +-
src/pgtkfns.c | 11 +-
src/pgtkselect.c | 2 +-
src/pgtkterm.c | 109 +-
src/print.c | 7 +-
src/process.c | 4 +-
src/profiler.c | 12 +-
src/regex-emacs.c | 2 +-
src/sfnt.c | 74 +-
src/sfntfont-android.c | 4 +
src/sfntfont.c | 17 +-
src/sort.c | 30 +-
src/sysdep.c | 8 +-
src/term.c | 82 +-
src/termchar.h | 7 +
src/terminal.c | 9 +-
src/textconv.c | 300 +++++-
src/textconv.h | 1 +
src/textprop.c | 33 +-
src/thread.c | 2 +-
src/thread.h | 1 +
src/treesit.c | 49 +-
src/treesit.h | 3 +
src/unexelf.c | 2 +
src/w32.c | 2 +-
src/w32fns.c | 71 +-
src/w32font.c | 14 +-
src/w32term.c | 140 ++-
src/window.c | 86 +-
src/window.h | 9 +
src/xdisp.c | 65 +-
src/xfaces.c | 200 +++-
src/xfns.c | 15 +-
src/xmenu.c | 2 +-
src/xml.c | 4 +-
src/xselect.c | 4 +-
src/xterm.c | 250 +++--
src/xterm.h | 3 +
src/xwidget.c | 6 +-
test/README | 6 +
test/data/decompress/tzg.tar.gz | Bin 0 -> 255 bytes
test/data/decompress/ztg.zip | Bin 0 -> 316 bytes
test/infra/Dockerfile.emba | 56 +-
test/infra/Makefile.in | 11 +-
test/infra/gitlab-ci.yml | 26 +-
test/infra/test-jobs.yml | 72 +-
test/lisp/align-tests.el | 2 +-
test/lisp/arc-mode-tests.el | 16 +
test/lisp/color-tests.el | 33 +
test/lisp/completion-preview-tests.el | 147 ++-
test/lisp/emacs-lisp/bytecomp-tests.el | 2 +-
test/lisp/emacs-lisp/macroexp-resources/vk.el | 48 +-
test/lisp/emacs-lisp/oclosure-tests.el | 4 +-
.../package-resources/package-test-server.py | 24 +-
test/lisp/emacs-lisp/package-tests.el | 9 +-
test/lisp/emacs-lisp/rx-tests.el | 25 +-
test/lisp/emacs-lisp/vtable-tests.el | 30 +
test/lisp/erc/erc-button-tests.el | 8 +-
test/lisp/erc/erc-fill-tests.el | 88 +-
test/lisp/erc/erc-networks-tests.el | 4 +
.../erc/erc-scenarios-base-association-nick.el | 24 +-
test/lisp/erc/erc-scenarios-base-kill-on-part.el | 95 ++
test/lisp/erc/erc-scenarios-base-renick.el | 4 +-
test/lisp/erc/erc-scenarios-ignore.el | 4 +-
test/lisp/erc/erc-scenarios-match.el | 3 +-
test/lisp/erc/erc-scenarios-misc.el | 4 +-
test/lisp/erc/erc-scenarios-stamp.el | 8 +-
test/lisp/erc/erc-stamp-tests.el | 118 ++
test/lisp/erc/erc-tests.el | 87 +-
.../base/assoc/bouncer-history/barnet.eld | 2 +-
.../lisp/erc/resources/base/auth-source/foonet.eld | 2 +-
.../base/reuse-buffers/channel/barnet.eld | 2 +-
test/lisp/erc/resources/erc-d/erc-d-tests.el | 4 +-
test/lisp/erc/resources/erc-scenarios-common.el | 7 +
test/lisp/erc/resources/erc-tests-common.el | 34 +-
.../resources/fill/snapshots/merge-01-start.eld | 2 +-
.../resources/fill/snapshots/merge-02-right.eld | 2 +-
.../erc/resources/fill/snapshots/merge-wrap-01.eld | 2 +-
.../snapshots/merge-wrap-indicator-post-01.eld | 1 -
.../fill/snapshots/merge-wrap-indicator-pre-01.eld | 2 +-
.../resources/fill/snapshots/spacing-01-mono.eld | 2 +-
.../lisp/erc/resources/join/auth-source/foonet.eld | 2 +-
test/lisp/erc/resources/sasl/external.eld | 2 +-
test/lisp/erc/resources/sasl/plain.eld | 2 +-
test/lisp/eshell/em-glob-tests.el | 49 +-
test/lisp/eshell/em-hist-tests.el | 17 +
test/lisp/eshell/esh-cmd-tests.el | 12 +
test/lisp/eshell/esh-ext-tests.el | 2 +-
test/lisp/eshell/esh-var-tests.el | 37 +-
test/lisp/files-tests.el | 27 +-
test/lisp/help-fns-tests.el | 10 +-
test/lisp/image/gravatar-tests.el | 2 +-
test/lisp/jsonrpc-tests.el | 9 +
test/lisp/mwheel-tests.el | 10 +-
test/lisp/net/eww-tests.el | 5 +-
test/lisp/net/tramp-tests.el | 98 +-
test/lisp/progmodes/bug-reference-tests.el | 5 +-
.../progmodes/csharp-mode-resources/indent-ts.erts | 51 +
test/lisp/progmodes/csharp-mode-tests.el | 4 +
test/lisp/progmodes/eglot-tests.el | 64 +-
.../progmodes/lua-ts-mode-resources/indent.erts | 40 +
.../lua-ts-mode-resources/which-function.lua | 3 +
test/lisp/progmodes/lua-ts-mode-tests.el | 17 +-
test/lisp/progmodes/project-tests.el | 54 +
test/lisp/progmodes/python-tests.el | 163 ++-
.../progmodes/rust-ts-mode-resources/font-lock.rs | 25 +
...{csharp-mode-tests.el => rust-ts-mode-tests.el} | 18 +-
test/lisp/subr-tests.el | 57 +-
test/lisp/tar-mode-tests.el | 14 +
test/lisp/textmodes/reftex-tests.el | 20 +-
test/lisp/thingatpt-tests.el | 89 ++
test/lisp/url/url-util-tests.el | 6 +-
test/lisp/use-package/use-package-tests.el | 10 +-
test/lisp/vc/log-edit-tests.el | 18 +
test/lisp/wid-edit-tests.el | 8 +-
test/src/emacs-module-resources/mod-test.c | 1 +
test/src/fileio-tests.el | 6 +
test/src/fns-tests.el | 6 +
test/src/keymap-tests.el | 7 +
test/src/lread-tests.el | 11 +
test/src/textprop-tests.el | 51 +
648 files changed, 18394 insertions(+), 7068 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index b34949ae961..c74da88a811 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -14,11 +14,13 @@
("/[ \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)))
+ (vc-prepare-patches-separately . nil)
+ (vc-default-patch-addressee . "bug-gnu-emacs@gnu.org")))
(c-mode . ((c-file-style . "GNU")
(c-noise-macro-names . ("INLINE" "NO_INLINE"
"ATTRIBUTE_NO_SANITIZE_UNDEFINED"
"UNINIT" "CALLBACK" "ALIGN_STACK"
"ATTRIBUTE_MALLOC"
- "ATTRIBUTE_DEALLOC_FREE" "ANDROID_EXPORT"
"TEST_STATIC"))
+ "ATTRIBUTE_DEALLOC_FREE" "ANDROID_EXPORT"
"TEST_STATIC"
+ "INLINE_HEADER_BEGIN" "INLINE_HEADER_END"))
(electric-quote-comment . nil)
(electric-quote-string . nil)
(indent-tabs-mode . t)
diff --git a/.gitignore b/.gitignore
index a61ad5fc6c5..440a3acbfba 100644
--- a/.gitignore
+++ b/.gitignore
@@ -66,6 +66,10 @@ java/org/gnu/emacs/*.class
# Built by `aapt'.
java/org/gnu/emacs/R.java
+# Built by `make'.
+java/org/gnu/emacs/EmacsConfig.java
+java/cf-stamp
+
# Built by `config.status'.
java/AndroidManifest.xml
diff --git a/INSTALL.REPO b/INSTALL.REPO
index 77d8153a5a8..46ac4440aee 100644
--- a/INSTALL.REPO
+++ b/INSTALL.REPO
@@ -80,7 +80,7 @@ handle. The most thorough cleaning can be achieved by 'git
clean -fdx'
which will leave you with only files from the git repository. Here
are some faster methods for a couple of particular error cases:
- /usr/bin/m4:aclocal.m4:9: cannot open `m4/count-leading-zeros.m4': No such
file or directory
+ /usr/bin/m4:aclocal.m4:9: cannot open `m4/stdbit_h.m4': No such file or
directory
This can be fixed with 'rm aclocal.m4'.
diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS
index 4fa65a8df24..c15401ddeb2 100644
--- a/admin/MAINTAINERS
+++ b/admin/MAINTAINERS
@@ -9,6 +9,7 @@ The (co-)maintainers of Emacs are:
Eli Zaretskii <eliz@gnu.org>
Stefan Kangas <stefankangas@gmail.com>
+ Andrea Corallo <acorallo@gnu.org>
==============================================================================
1. Areas that someone wants to be maintaining (i.e. has a particularly
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index 41531d573b0..65e098c7123 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -29,7 +29,6 @@ GNULIB_MODULES='
alignasof alloca-opt binary-io boot-time byteswap c-ctype c-strcase
canonicalize-lgpl
careadlinkat close-stream copy-file-range
- count-leading-zeros count-one-bits count-trailing-zeros
crypto/md5 crypto/md5-buffer
crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer
d-type diffseq double-slash-root dtoastr dtotimespec dup2
@@ -44,7 +43,9 @@ GNULIB_MODULES='
nanosleep nproc nstrftime
pathmax pipe2 pselect pthread_sigmask
qcopy-acl readlink readlinkat regex
- sig2str sigdescr_np socklen stat-time std-gnu11 stdbool stdckdint stddef
stdio
+ sig2str sigdescr_np socklen stat-time std-gnu11 stdbool
+ stdc_bit_width stdc_count_ones stdc_trailing_zeros
+ stdckdint stddef stdio
stpcpy strnlen strnlen strtoimax symlink sys_stat sys_time
tempname time-h time_r time_rz timegm timer-time timespec-add timespec-sub
update-copyright unlocked-io utimensat
@@ -126,6 +127,7 @@ rm -- "$src"lib/gl_openssl.h \
"$src"m4/gnulib-cache.m4 "$src"m4/gnulib-tool.m4 \
"$src"m4/locale-fr.m4 \
"$src"m4/manywarnings-c++.m4 \
+ "$src"m4/off64_t.m4 \
"$src"m4/warn-on-use.m4 "$src"m4/wint_t.m4 &&
cp -- "$gnulib_srcdir"/build-aux/texinfo.tex "$src"doc/misc &&
cp -- "$gnulib_srcdir"/build-aux/config.guess \
diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el
index bfbbbc45aa4..7f6b7495d00 100644
--- a/admin/syncdoc-type-hierarchy.el
+++ b/admin/syncdoc-type-hierarchy.el
@@ -35,6 +35,7 @@
;;; Code:
(require 'cl-lib)
+(require 'org)
(defconst syncdoc-file (or (macroexp-file-name) buffer-file-name))
@@ -96,7 +97,7 @@
(lambda (x1 x2)
(< (length (memq (car x2) syncdoc-all-types))
(length (memq (car x1) syncdoc-all-types)))))
- (cl-loop for (type . children) in subtypes
+ (cl-loop for (type . children) in (reverse subtypes)
do (insert "|" (symbol-name type) " |")
do (cl-loop with x = 0
for child in children
@@ -109,7 +110,7 @@
do (cl-incf x (1+ child-len)) )
do (insert "\n")))
(require 'org-table)
- (declare-function 'org-table-align "org")
+ (declare-function org-table-align "org")
(org-table-align)))
(defun syncdoc-update-type-hierarchy0 ()
diff --git a/build-aux/make-info-dir b/build-aux/make-info-dir
index 703abc7bd0a..214757bb65b 100755
--- a/build-aux/make-info-dir
+++ b/build-aux/make-info-dir
@@ -33,7 +33,8 @@
## Header contains non-printing characters, so this is more
## reliable than using awk.
-cat <"${1?}" || exit
+test $# -ge 2 || exit 1
+cat <"$1"
shift
exec "${AWK-awk}" '
@@ -101,4 +102,4 @@ exec "${AWK-awk}" '
if (data[dircat])
printf "\n%s\n%s", topic[dircat], data[dircat]
}
-' "${@?}"
+' "$@"
diff --git a/build-aux/makecounter.sh b/build-aux/makecounter.sh
index a63fcbb7c61..4d572d5ab80 100755
--- a/build-aux/makecounter.sh
+++ b/build-aux/makecounter.sh
@@ -36,6 +36,7 @@ cat > $1 <<EOF
#define EXPORT __attribute__ ((visibility ("default")))
#endif /* HAVE_ANDROID */
+extern int emacs_shortlisp_counter;
#ifdef EXPORT
EXPORT
#endif /* EXPORT */
diff --git a/config.bat b/config.bat
index f63da88303c..20dbfda5548 100644
--- a/config.bat
+++ b/config.bat
@@ -303,6 +303,7 @@ If Exist sys_types.in.h update sys_types.in.h sys_types.in-h
If Exist time.in.h update time.in.h time.in-h
If Exist unistd.in.h update unistd.in.h unistd.in-h
If Exist stdckdint.in.h update stdckdint.in.h stdckdint.in-h
+If Exist stdbit.in.h update stdbit.in.h stdbit.in-h
If Exist gnulib.mk.in update gnulib.mk.in gnulib.mk-in
Rem Only repository has the msdos/autogen directory
If Exist Makefile.in sed -f ../msdos/sedlibcf.inp < Makefile.in > makefile.tmp
diff --git a/configure.ac b/configure.ac
index d76277a4d93..1b789f9a63e 100644
--- a/configure.ac
+++ b/configure.ac
@@ -40,7 +40,13 @@ if test "$XCONFIGURE" = "android"; then
CFLAGS="$ANDROID_CFLAGS -Werror=implicit-function-declaration"
# Don't explicitly enable support for large files unless Emacs is
# being built for API 21 or later. Otherwise, mmap does not work.
+ #
+ # Moreover, 64-bit variants of file IO functions in the C library are
+ # liable to fail with ENOSYS or EINVAL on earlier API versions, and as
+ # such their definitions must be explicitly disabled on NDK releases
+ # that enable them by default.
AS_IF([test "$ANDROID_SDK" -lt "21"], [
+ CFLAGS="$CFLAGS -D_FILE_OFFSET_BITS=32"
enable_largefile=no
enable_year2038=no])
fi
@@ -1488,7 +1494,11 @@ case "${canonical}" in
*-mingw* )
opsys=mingw32
# MinGW overrides and adds some system headers in nt/inc.
- GCC_TEST_OPTIONS="-I $srcdir/nt/inc"
+ # Also, GCC 14 turns on implicit-function-declaration
+ # error by default, which fails configure tests where our
+ # emulation of Posix headers defines only the minimal
+ # stuff we actually need.
+ GCC_TEST_OPTIONS="-I $srcdir/nt/inc
-Wno-error=implicit-function-declaration"
;;
*-sysv4.2uw* ) opsys=unixware ;;
*-sysv5uw* ) opsys=unixware ;;
@@ -1503,7 +1513,7 @@ case "${canonical}" in
*-mingw* )
opsys=mingw32
# MinGW overrides and adds some system headers in nt/inc.
- GCC_TEST_OPTIONS="-I $srcdir/nt/inc"
+ GCC_TEST_OPTIONS="-I $srcdir/nt/inc
-Wno-error=implicit-function-declaration"
;;
## Otherwise, we'll fall through to the generic opsys code at the bottom.
esac
@@ -1579,6 +1589,10 @@ AC_DEFUN([gt_TYPE_WINT_T],
AC_DEFUN_ONCE([gl_STDLIB_H],
[AC_REQUIRE([gl_STDLIB_H_DEFAULTS])
gl_NEXT_HEADERS([stdlib.h])])
+# Emacs does not need to check for off64_t.
+AC_DEFUN([gl_TYPE_OFF64_T],
+ [HAVE_OFF64_T=1
+ AC_SUBST([HAVE_OFF64_T])])
# Initialize gnulib right after choosing the compiler.
dnl Amongst other things, this sets AR and ARFLAGS.
@@ -2455,11 +2469,6 @@ AC_DEFINE_UNQUOTED([SYSTEM_TYPE], ["$SYSTEM_TYPE"],
[The type of system you are compiling for; sets 'system-type'.])
AC_SUBST([SYSTEM_TYPE])
-# Check for pw_gecos in struct passwd; this is known to be missing on
-# Android.
-
-AC_CHECK_MEMBERS([struct passwd.pw_gecos], [], [], [#include <pwd.h>])
-
pre_PKG_CONFIG_CFLAGS=$CFLAGS
pre_PKG_CONFIG_LIBS=$LIBS
@@ -2745,6 +2754,17 @@ AC_SUBST([ANDROID_BUILD_CFLAGS])
AC_SUBST([ANDROID_SHARED_USER_ID])
AC_SUBST([ANDROID_SHARED_USER_NAME])
+# Check for pw_gecos in struct passwd; this is known to be missing on
+# Android.
+
+AH_TEMPLATE([USER_FULL_NAME], [How to get a user's full name.])
+AC_CHECK_MEMBERS([struct passwd.pw_gecos], [], [], [#include <pwd.h>])
+AS_IF([test x"$REALLY_ANDROID" = "xyes"],
+ [AC_DEFINE([USER_FULL_NAME], [android_user_full_name (pw)])],
+ [AS_IF([test x"$ac_cv_member_struct_passwd_pw_gecos" = "xyes"],
+ [AC_DEFINE([USER_FULL_NAME], [pw->pw_gecos])],
+ [AC_DEFINE([USER_FULL_NAME], [NULL])])])
+
if test "${with_pgtk}" = "yes"; then
window_system=pgtk
fi
@@ -6474,9 +6494,6 @@ AC_SUBST([SEPCHAR])
dnl Everybody supports this, except MS-DOS.
AC_DEFINE([subprocesses], [1], [Define to enable asynchronous subprocesses.])
-AC_DEFINE([USER_FULL_NAME], [pw->pw_gecos], [How to get a user's full name.])
-
-
AC_DEFINE([DIRECTORY_SEP], ['/'],
[Character that separates directories in a file name.])
diff --git a/cross/Makefile.in b/cross/Makefile.in
index 1e8daea6f91..575c6c4cb29 100644
--- a/cross/Makefile.in
+++ b/cross/Makefile.in
@@ -140,7 +140,7 @@ src/Makefile: $(top_builddir)/src/Makefile.android
-e 's/\.\.\/admin\/charsets/..\/..\/admin\/charsets/g' \
-e 's/^libsrc =.*$$/libsrc = \.\.\/\.\.\/lib-src/g' \
-e 's/libsrc =.*$$/libsrc = \.\.\/\.\.\/lib-src/g' \
- -e 's/-I\$$(top_srcdir)\/lib/-I..\/$(subst /,\/,$(srcdir))\/lib/g' \
+ -e 's/-I\$$(top_srcdir)\/lib//g' \
< $(top_builddir)/src/Makefile.android > $@
src/epaths.h: $(top_builddir)/src/epaths.h
diff --git a/cross/ndk-build/ndk-build.mk.in b/cross/ndk-build/ndk-build.mk.in
index ea1be5af6f1..9948e019e3b 100644
--- a/cross/ndk-build/ndk-build.mk.in
+++ b/cross/ndk-build/ndk-build.mk.in
@@ -27,6 +27,7 @@ NDK_BUILD_CXX_LDFLAGS = @NDK_BUILD_CXX_LDFLAGS@
NDK_BUILD_ANY_CXX_MODULE = @NDK_BUILD_ANY_CXX_MODULE@
NDK_BUILD_SHARED =
NDK_BUILD_STATIC =
+NDK_BUILD_READELF = @NDK_BUILD_READELF@
define uniqify
$(if $1,$(firstword $1) $(call uniqify,$(filter-out $(firstword $1),$1)))
diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi
index 62f6382113e..c3d86bf3426 100644
--- a/doc/emacs/ack.texi
+++ b/doc/emacs/ack.texi
@@ -245,7 +245,8 @@ Theresa O'Connor wrote @file{json.el}, a file for parsing
and
generating JSON files.
@item
-Andrea Corallo wrote the native compilation support in @file{comp.c}
+Andrea Corallo was the Emacs (co-)maintainer from 29.3 onwards.
+He wrote the native compilation support in @file{comp.c} and
and @file{comp.el}, for compiling Emacs Lisp to native code using
@samp{libgccjit}.
diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi
index 15c5fbcce3a..09b7762ed03 100644
--- a/doc/emacs/android.texi
+++ b/doc/emacs/android.texi
@@ -148,7 +148,7 @@ attempts to open the file with the wrapper will fail.
system provides access to outside the normal filesystem APIs. Emacs
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
+any assumptions about the contents of these directories, or try to open
files in it yourself.
This feature is not provided on Android 4.3 and earlier, in which
@@ -827,7 +827,7 @@ example, the permission to access contacts may be useful
for EUDC.
applications as maximized or full-screen, and, in the general case, only
one window can be displayed at a time. On larger devices, the system
permits simultaneously tiling up to four windows on the screen, though
-in emulators or installations configured for ``desktop'' system stacks
+in emulators or installations configured for ``desktop'' systems stacks
freely resizable windows as other desktop window managers do.
Windows, or, in system nomenclature, activities, do not exist
@@ -904,9 +904,9 @@ devices.
@item
The @code{alpha}, @code{alpha-background}, @code{z-group},
@code{override-redirect}, @code{mouse-color}, @code{title},
-@code{wait-for-wm}, @code{sticky}, @code{undecorated} and
-@code{tool-bar-position} frame parameters (@pxref{Frame Parameters,,,
-elisp, the Emacs Lisp Reference Manual}) are unsupported.
+@code{wait-for-wm}, @code{sticky}, and @code{undecorated} frame
+parameters (@pxref{Frame Parameters,,, elisp, the Emacs Lisp Reference
+Manual}) are unsupported.
@item
On Android 4.0 and earlier, the @code{fullscreen} frame parameter is
@@ -948,13 +948,16 @@ application via cut-and-paste.
@vindex android-pass-multimedia-buttons-to-system
@cindex volume/multimedia buttons, Android
- The volume keys are normally reserved by Emacs and used to provide
-the ability to quit Emacs without a physical keyboard
-(@pxref{On-Screen Keyboards}.) However, if you want them to adjust
-the volume instead, you can set the variable
+ The volume keys are normally reserved by Emacs and used to provide the
+ability to quit Emacs without a physical keyboard (@pxref{On-Screen
+Keyboards}). However, if you want them to adjust the volume instead,
+you can set the variable
@code{android-pass-multimedia-buttons-to-system} to a non-@code{nil}
value; note that you will no longer be able to quit Emacs using the
-volume buttons in that case.
+volume buttons in that case, and that it is generally easier to activate
+the notification shade or another interface that momentarily deprives
+Emacs of the keyboard focus while the volume buttons are being
+depressed.
@cindex dialog boxes, android
Emacs is unable to display dialog boxes (@pxref{Dialog Boxes}) while
@@ -1002,12 +1005,31 @@ customized through altering the variable
@code{android-keyboard-bell-duration} to any value between @code{10}
and @code{1000}.
+@vindex android-display-planes
+@cindex visual class, Android
+@cindex display color space, Android
+ Color-related characteristics of the display are not automatically
+detectable on Android, so the variable @code{android-display-planes}
+should be configured to a suitable value if Emacs is to realize faces
+and images in a manner consistent with the true visual attributes of a
+grayscale or monochrome display: to @code{8} for the former class of
+display, and @code{1} for the latter, which will, respectively, force
+all colors to be rendered in 256 grays, or in monochrome. As this
+variable is processed at the time the display connection is established,
+customizations will not take effect unless they be performed from
+@code{early-init.el} (@pxref{Early Init File}).
+
+ The value of this variable does not affect anti-aliasing in the font
+driver, as monochrome displays nevertheless expect Emacs to provide
+antialiased text, which they receive after it is processed into bitmap
+data by the display driver.
+
@node Android Fonts
@section Font Backends and Selection under Android
@cindex fonts, android
- Emacs supports two font backends under Android: they are
-respectively named @code{sfnt-android} and @code{android}.
+ Emacs supports two font backends under Android: they are respectively
+named @code{sfnt-android} and @code{android}.
Upon startup, Emacs enumerates all the TrueType format fonts in the
directories @file{/system/fonts} and @file{/product/fonts}, and the
diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi
index 7312cfb34c9..10fe404099d 100644
--- a/doc/emacs/calendar.texi
+++ b/doc/emacs/calendar.texi
@@ -104,8 +104,11 @@ Move point one year backward
(@code{calendar-backward-year}).
The day and week commands are natural analogues of the usual Emacs
commands for moving by characters and by lines. Just as @kbd{C-n}
usually moves to the same column in the following line, in Calendar
-mode it moves to the same day in the following week. And @kbd{C-p}
-moves to the same day in the previous week.
+mode it is bound to @code{calendar-forward-week}, which moves to the
+same day in the following week. And @kbd{C-p}
+(@code{calendar-backward-week} moves to the same day in the previous
+week. @kbd{C-f} (@code{calendar-forward-day}) and @kbd{C-b}
+(@code{calendar-backward-day}) move forward and back by days.
The arrow keys are equivalent to @kbd{C-f}, @kbd{C-b}, @kbd{C-n} and
@kbd{C-p}, just as they normally are in other modes.
@@ -119,10 +122,12 @@ moves to the same day in the previous week.
@kindex C-x [ @r{(Calendar mode)}
@findex calendar-backward-year
The commands for motion by months and years work like those for
-weeks, but move a larger distance. The month commands @kbd{M-@}} and
-@kbd{M-@{} move forward or backward by an entire month. The year
-commands @kbd{C-x ]} and @w{@kbd{C-x [}} move forward or backward a
-whole year.
+weeks, but move a larger distance. The month commands @kbd{M-@}}
+(@code{calendar-forward-month}) and @kbd{M-@{}
+(@code{calendar-backward-month}) move forward or backward by an entire
+month. The year commands @w{@kbd{C-x ]}}
+(@code{calendar-forward-year}) and @w{@kbd{C-x [}}
+(@code{calendar-backward-year}) move forward or backward a whole year.
The easiest way to remember these commands is to consider months and
years analogous to paragraphs and pages of text, respectively. But
@@ -261,8 +266,9 @@ Scroll backward by three months
(@code{calendar-scroll-right-three-months}).
@findex calendar-scroll-right
The most basic calendar scroll commands scroll by one month at a
time. This means that there are two months of overlap between the
-display before the command and the display after. @kbd{>} scrolls the
-calendar contents one month forward in time. @kbd{<} scrolls the
+display before the command and the display after. @kbd{>}
+(@code{calendar-scroll-left}) scrolls the calendar contents one month
+forward in time. @kbd{<} (@code{calendar-scroll-right}) scrolls the
contents one month backwards in time.
@kindex C-v @r{(Calendar mode)}
@@ -273,13 +279,15 @@ contents one month backwards in time.
@kindex PageUp @r{(Calendar mode)}
@kindex prior @r{(Calendar mode)}
@findex calendar-scroll-right-three-months
- The commands @kbd{C-v} and @kbd{M-v} scroll the calendar by an entire
-screenful---three months---in analogy with the usual meaning of
-these commands. @kbd{C-v} makes later dates visible and @kbd{M-v} makes
-earlier dates visible. These commands take a numeric argument as a
-repeat count; in particular, since @kbd{C-u} multiplies the next command
-by four, typing @kbd{C-u C-v} scrolls the calendar forward by a year and
-typing @kbd{C-u M-v} scrolls the calendar backward by a year.
+ The commands @kbd{C-v} (@code{calendar-scroll-left-three-months})
+and @kbd{M-v} (@code{calendar-scroll-right-three-months}) scroll the
+calendar by an entire screenful---three months---in analogy with the
+usual meaning of these commands. @kbd{C-v} makes later dates visible
+and @kbd{M-v} makes earlier dates visible. These commands take a
+numeric argument as a repeat count; in particular, since @kbd{C-u}
+multiplies the next command by four, typing @kbd{C-u C-v} scrolls the
+calendar forward by a year and typing @kbd{C-u M-v} scrolls the
+calendar backward by a year.
The function keys @key{PageDown} (or @key{next}) and @key{PageUp}
(or @key{prior}) are equivalent to @kbd{C-v} and @kbd{M-v}, just as
@@ -358,6 +366,8 @@ calendar deletes or iconifies that frame depending on the
value of
You can write calendars and diary entries to HTML and @LaTeX{} files.
@cindex calendar and HTML
+@vindex cal-html-directory
+@vindex cal-html-holidays
The Calendar HTML commands produce files of HTML code that contain
calendar, holiday, and diary entries. Each file applies to one month,
and has a name of the format @file{@var{yyyy}-@var{mm}.html}, where
@@ -382,10 +392,13 @@ Generate a one-month calendar
(@code{cal-html-cursor-month}).
@item H y
Generate a calendar file for each month of a year, as well as an index
page (@code{cal-html-cursor-year}). By default, this command writes
-files to a @var{yyyy} subdirectory---if this is altered some hyperlinks
-between years will not work.
+files to a @var{year} subdirectory, where @var{year} is the year at
+cursor---if this is altered, some hyperlinks between years will not
+work.
@end table
+@vindex cal-html-print-day-number-flag
+@vindex cal-html-year-index-cols
If the variable @code{cal-html-print-day-number-flag} is
non-@code{nil}, then the monthly calendars show the day-of-the-year
number. The variable @code{cal-html-year-index-cols} specifies the
@@ -444,6 +457,9 @@ paper size (3.75in x 6.75in). All of these commands accept
a prefix
argument, which specifies how many days, weeks, months or years to print
(starting always with the selected one).
+@vindex cal-tex-holidays
+@vindex cal-tex-diary
+@vindex cal-tex-rules
If the variable @code{cal-tex-holidays} is non-@code{nil} (the default),
then the printed calendars show the holidays in @code{calendar-holidays}.
If the variable @code{cal-tex-diary} is non-@code{nil} (the default is
@@ -454,6 +470,7 @@ pages in styles that have sufficient room. Consult the
documentation of
the individual cal-tex functions to see which calendars support which
features.
+@vindex cal-tex-preamble-extra
You can use the variable @code{cal-tex-preamble-extra} to insert extra
@LaTeX{} commands in the preamble of the generated document if you need
to.
@@ -486,12 +503,12 @@ List holidays in another window for a specified range of
years.
@kindex h @r{(Calendar mode)}
@findex calendar-cursor-holidays
-@vindex calendar-view-holidays-initially-flag
To see if any holidays fall on a given date, position point on that
-date in the calendar window and use the @kbd{h} command. Alternatively,
-click on that date with @kbd{mouse-3} and then choose @kbd{Holidays}
-from the menu that appears. Either way, this displays the holidays for
-that date, in the echo area if they fit there, otherwise in a separate
+date in the calendar window and use the @kbd{h}
+(@code{calendar-cursor-holidays}) command. Alternatively, click on
+that date with @kbd{mouse-3} and then choose @kbd{Holidays} from the
+menu that appears. Either way, this displays the holidays for that
+date, in the echo area if they fit there, otherwise in a separate
window.
@kindex x @r{(Calendar mode)}
@@ -500,8 +517,8 @@ window.
@findex calendar-unmark
@vindex calendar-mark-holidays-flag
To view the distribution of holidays for all the dates shown in the
-calendar, use the @kbd{x} command. This displays the dates that are
-holidays in a different face.
+calendar, use the @kbd{x} (@code{calendar-mark-holidays}) command.
+This displays the dates that are holidays in a different face.
@iftex
@xref{Calendar Customizing,,, emacs-xtra, Specialized Emacs Features}.
@end iftex
@@ -510,19 +527,22 @@ holidays in a different face.
@end ifnottex
The command applies both to the currently visible months and to
other months that subsequently become visible by scrolling. To turn
-marking off and erase the current marks, type @kbd{u}, which also
-erases any diary marks (@pxref{Diary}). If the variable
-@code{calendar-mark-holidays-flag} is non-@code{nil}, creating or
-updating the calendar marks holidays automatically.
+marking off and erase the current marks, type @kbd{u}
+(@code{calendar-unmark}), which also erases any diary marks
+(@pxref{Diary}). If the variable @code{calendar-mark-holidays-flag}
+is non-@code{nil}, creating or updating the calendar marks holidays
+automatically.
@kindex a @r{(Calendar mode)}
@findex calendar-list-holidays
- To get even more detailed information, use the @kbd{a} command, which
-displays a separate buffer containing a list of all holidays in the
-current three-month range. You can use @key{SPC} and @key{DEL} in the
-calendar window to scroll that list up and down, respectively.
+ To get even more detailed information, use the @kbd{a}
+(@code{calendar-list-holidays}) command, which displays a separate
+buffer containing a list of all holidays in the current three-month
+range. You can use @key{SPC} and @key{DEL} in the calendar window to
+scroll that list up and down, respectively.
@findex holidays
+@vindex calendar-view-holidays-initially-flag
The command @kbd{M-x holidays} displays the list of holidays for the
current month and the preceding and succeeding months; this works even
if you don't have a calendar window. If the variable
@@ -536,6 +556,7 @@ major Bahá'í, Chinese, Christian, Islamic, and Jewish
holidays; also the solstices and equinoxes.
@findex list-holidays
+@findex holiday-list
The command @kbd{M-x holiday-list} displays the list of holidays for
a range of years. This function asks you for the starting and stopping
years, and allows you to choose all the holidays or one of several
@@ -569,14 +590,14 @@ Display times of sunrise and sunset for the selected
month.
@kindex S @r{(Calendar mode)}
@findex calendar-sunrise-sunset
@findex sunrise-sunset
- Within the calendar, to display the @emph{local times} of sunrise and
-sunset in the echo area, move point to the date you want, and type
-@kbd{S}. Alternatively, click @kbd{mouse-3} on the date, then choose
-@samp{Sunrise/sunset} from the menu that appears. The command @kbd{M-x
-sunrise-sunset} is available outside the calendar to display this
-information for today's date or a specified date. To specify a date
-other than today, use @kbd{C-u M-x sunrise-sunset}, which prompts for
-the year, month, and day.
+ Within the calendar, to display the @emph{local times} of sunrise
+and sunset in the echo area, move point to the date you want, and type
+@kbd{S} (@code{calendar-sunrise-sunset}). Alternatively, click
+@kbd{mouse-3} on the date, then choose @samp{Sunrise/sunset} from the
+menu that appears. The command @kbd{M-x sunrise-sunset} is available
+outside the calendar to display this information for today's date or a
+specified date. To specify a date other than today, use @kbd{C-u M-x
+sunrise-sunset}, which prompts for the year, month, and day.
You can display the times of sunrise and sunset for any location and
any date with @kbd{C-u C-u M-x sunrise-sunset}. This asks you for a
@@ -584,13 +605,13 @@ longitude, latitude, number of minutes difference from
Coordinated
Universal Time, and date, and then tells you the times of sunrise and
sunset for that location on that date.
+@vindex calendar-location-name
+@vindex calendar-longitude
+@vindex calendar-latitude
Because the times of sunrise and sunset depend on the location on
earth, you need to tell Emacs your latitude, longitude, and location
name before using these commands. Here is an example of what to set:
-@vindex calendar-location-name
-@vindex calendar-longitude
-@vindex calendar-latitude
@example
(setq calendar-latitude 40.1)
(setq calendar-longitude -88.2)
@@ -601,14 +622,14 @@ name before using these commands. Here is an example of
what to set:
Use one decimal place in the values of @code{calendar-latitude} and
@code{calendar-longitude}.
+@vindex calendar-time-zone
+@vindex calendar-standard-time-zone-name
+@vindex calendar-daylight-time-zone-name
Your time zone also affects the local time of sunrise and sunset.
Emacs usually gets time zone information from the operating system, but
if these values are not what you want (or if the operating system does
not supply them), you must set them yourself. Here is an example:
-@vindex calendar-time-zone
-@vindex calendar-standard-time-zone-name
-@vindex calendar-daylight-time-zone-name
@example
(setq calendar-time-zone -360)
(setq calendar-standard-time-zone-name "CST")
@@ -616,9 +637,9 @@ not supply them), you must set them yourself. Here is an
example:
@end example
@noindent
-The value of @code{calendar-time-zone} is the number of minutes
+The value of @code{calendar-time-zone} is the number of minutes of
difference between your local standard time and Coordinated Universal
-Time (Greenwich time). The values of
+Time (a.k.a.@: ``Greenwich time''). The values of
@code{calendar-standard-time-zone-name} and
@code{calendar-daylight-time-zone-name} are the abbreviations used in
your time zone. Emacs displays the times of sunrise and sunset
@@ -627,7 +648,8 @@ for how daylight saving time is determined.
@vindex calendar-time-zone-style
If you want to display numerical time zones (like @samp{"+0100"})
-instead of symbolic ones (like @samp{"CET"}), set this to @code{numeric}.
+instead of symbolic ones (like @samp{"CET"}), set the variable
+@code{calendar-time-zone-style} to @code{numeric}.
As a user, you might find it convenient to set the calendar location
variables for your usual physical location in your @file{.emacs} file.
@@ -639,10 +661,10 @@ for all users in a @file{default.el} file. @xref{Init
File}.
@cindex phases of the moon
@cindex moon, phases of
- These calendar commands display the dates and times of the phases of
-the moon (new moon, first quarter, full moon, last quarter). This
-feature is useful for debugging problems that depend on the phase of
-the moon.
+ The calendar commands described in this section display the dates
+and times of the phases of the moon (new moon, first quarter, full
+moon, last quarter). This feature is useful for debugging problems
+that depend on the phase of the moon.
@table @kbd
@item M
@@ -655,9 +677,10 @@ today's date.
@kindex M @r{(Calendar mode)}
@findex calendar-lunar-phases
- Within the calendar, use the @kbd{M} command to display a separate
-buffer of the phases of the moon for the current three-month range. The
-dates and times listed are accurate to within a few minutes.
+ Within the calendar, use the @kbd{M} (@code{calendar-lunar-phases})
+command to display a separate buffer of the phases of the moon for the
+current three-month range. The dates and times listed are accurate to
+within a few minutes.
@findex lunar-phases
Outside the calendar, use the command @kbd{M-x lunar-phases} to
@@ -668,21 +691,22 @@ year.
The dates and times given for the phases of the moon are given in
local time (corrected for daylight saving, when appropriate).
-See the discussion in the previous section. @xref{Sunrise/Sunset}.
+See the discussion in the previous section (@pxref{Sunrise/Sunset}).
@node Other Calendars
@section Conversion To and From Other Calendars
@cindex Gregorian calendar
- The Emacs calendar displayed is @emph{always} the Gregorian calendar,
-sometimes called the New Style calendar, which is used in most of
-the world today. However, this calendar did not exist before the
-sixteenth century and was not widely used before the eighteenth century;
-it did not fully displace the Julian calendar and gain universal
-acceptance until the early twentieth century. The Emacs calendar can
-display any month since January, year 1 of the current era, but the
-calendar displayed is always the Gregorian, even for a date at which
-the Gregorian calendar did not exist.
+@cindex New Style calendar
+ The Emacs calendar displayed is @emph{always} the @dfn{Gregorian
+calendar}, sometimes called the @dfn{New Style calendar}, which is
+used in most of the world today. However, this calendar did not exist
+before the sixteenth century and was not widely used before the
+eighteenth century; it did not fully displace the Julian calendar and
+gain universal acceptance until the early twentieth century. The
+Emacs calendar can display any month since January, year 1 of the
+current era, but the calendar displayed is always the Gregorian, even
+for a date at which the Gregorian calendar did not exist.
While Emacs cannot display other calendars, it can convert dates to
and from several other calendars.
@@ -711,7 +735,8 @@ century.
@cindex astronomical day numbers
Astronomers use a simple counting of days elapsed since noon, Monday,
January 1, 4713 BC on the Julian calendar. The number of days elapsed
-is called the @dfn{Julian day number} or the @dfn{Astronomical day number}.
+since then is called the @dfn{Julian day number} or the
+@dfn{Astronomical day number}.
@cindex Hebrew calendar
The Hebrew calendar is used by tradition in the Jewish religion. The
@@ -736,6 +761,10 @@ the metric system. The French government officially
abandoned this
calendar at the end of 1805.
@cindex Mayan calendars
+@cindex long count calendar system
+@cindex tzolkin calendar system
+@cindex haab calendar system
+@cindex Goodman-Martinez-Thompson correlation
The Maya of Central America used three separate, overlapping calendar
systems, the @emph{long count}, the @emph{tzolkin}, and the @emph{haab}.
Emacs knows about all three of these calendars. Experts dispute the
@@ -751,6 +780,7 @@ extra period to make it six days. The Ethiopic calendar is
identical in
structure, but has different year numbers and month names.
@cindex Persian calendar
+@cindex Birashk
The Persians use a solar calendar based on a design of Omar Khayyam.
Their calendar consists of twelve months of which the first six have 31
days, the next five have 30 days, and the last has 29 in ordinary years
@@ -840,13 +870,13 @@ Display Mayan date for selected day
(@code{calendar-mayan-print-date}).
Otherwise, move point to the date you want to convert, then type the
appropriate command starting with @kbd{p} from the table above. The
prefix @kbd{p} is a mnemonic for ``print'', since Emacs ``prints'' the
-equivalent date in the echo area. @kbd{p o} displays the
-date in all forms known to Emacs. You can also use @kbd{mouse-3} and
-then choose @kbd{Other calendars} from the menu that appears. This
-displays the equivalent forms of the date in all the calendars Emacs
-understands, in the form of a menu. (Choosing an alternative from
-this menu doesn't actually do anything---the menu is used only for
-display.)
+equivalent date in the echo area. @kbd{p o}
+(@code{calendar-print-other-dates}) displays the date in all forms
+known to Emacs. You can also use @kbd{mouse-3} and then choose
+@kbd{Other calendars} from the menu that appears. This displays the
+equivalent forms of the date in all the calendars Emacs understands,
+in the form of a menu. (Choosing an alternative from this menu
+doesn't actually do anything---the menu is used only for display.)
@node From Other Calendar
@subsection Converting From Other Calendars
@@ -1053,10 +1083,11 @@ Mail yourself email reminders about upcoming diary
entries.
@kindex d @r{(Calendar mode)}
@findex diary-view-entries
@vindex calendar-view-diary-initially-flag
- Displaying the diary entries with @kbd{d} shows in a separate buffer
-the diary entries for the selected date in the calendar. The mode line
-of the new buffer shows the date of the diary entries. Holidays are
-shown either in the buffer or in the mode line, depending on the display
+ Displaying the diary entries with @kbd{d}
+(@code{diary-view-entries}) shows in a separate buffer the diary
+entries for the selected date in the calendar. The mode line of the
+new buffer shows the date of the diary entries. Holidays are shown
+either in the buffer or in the mode line, depending on the display
method you choose
@iftex
(@pxref{Diary Display,,, emacs-xtra, Specialized Emacs Features}).
@@ -1079,8 +1110,8 @@ current date is visible).
@findex diary-mark-entries
@vindex calendar-mark-diary-entries-flag
To get a broader view of which days are mentioned in the diary, use
-the @kbd{m} command. This marks the dates that have diary entries in
-a different face.
+the @kbd{m} (@code{diary-mark-entries}) command. This marks the dates
+that have diary entries in a different face.
@iftex
@xref{Calendar Customizing,,, emacs-xtra, Specialized Emacs Features}.
@end iftex
@@ -1089,9 +1120,10 @@ a different face.
@end ifnottex
This command applies both to the months that are currently visible
-and to those that subsequently become visible after scrolling. To turn
-marking off and erase the current marks, type @kbd{u}, which also
-turns off holiday marks (@pxref{Holidays}). If the variable
+and to those that subsequently become visible after scrolling. To
+turn marking off and erase the current marks, type @kbd{u}
+(@code{calendar-unmark}), which also turns off holiday marks
+(@pxref{Holidays}). If the variable
@code{calendar-mark-diary-entries-flag} is non-@code{nil}, creating or
updating the calendar marks diary dates automatically.
@@ -1107,9 +1139,10 @@ otherwise mark many different dates.
@kindex s @r{(Calendar mode)}
@findex diary-show-all-entries
To see the full diary file, rather than just some of the entries, use
-the @kbd{s} command.
+the @kbd{s} (@code{diary-show-all-entries}) command.
@findex diary
+@vindex diary-number-of-entries
The command @kbd{M-x diary} displays the diary entries for the current
date, independently of the calendar display, and optionally for the next
few days as well; the variable @code{diary-number-of-entries} specifies
@@ -1161,6 +1194,9 @@ and @var{day} are numbers of one or two digits. The
optional @var{year}
is also a number, and may be abbreviated to the last two digits; that
is, you can use @samp{11/12/2012} or @samp{11/12/12}.
+@vindex calendar-abbrev-length
+@vindex calendar-month-abbrev-array
+@vindex calendar-day-abbrev-array
Dates can also have the form @samp{@var{monthname} @var{day}} or
@samp{@var{monthname} @var{day}, @var{year}}, where the month's name can
be spelled in full or abbreviated (with or without a period). The
@@ -1194,6 +1230,7 @@ significant.
@node Adding to Diary
@subsection Commands to Add to the Diary
+@cindex create diary entries
While in the calendar, there are several commands to create diary
entries. The basic commands are listed here; more sophisticated
@@ -1219,10 +1256,11 @@ Add a diary entry for the selected day of the year
(@code{diary-insert-yearly-en
@kindex i d @r{(Calendar mode)}
@findex diary-insert-entry
- You can make a diary entry for a specific date by selecting that date
-in the calendar window and typing the @kbd{i d} command. This command
-displays the end of your diary file in another window and inserts the
-date; you can then type the rest of the diary entry.
+ You can make a diary entry for a specific date by selecting that
+date in the calendar window and typing the @kbd{i d}
+(@code{diary-insert-entry}) command. This command displays the end of
+your diary file in another window and inserts the date; you can then
+type the rest of the diary entry.
@kindex i w @r{(Calendar mode)}
@findex diary-insert-weekly-entry
@@ -1231,12 +1269,14 @@ date; you can then type the rest of the diary entry.
@kindex i y @r{(Calendar mode)}
@findex diary-insert-yearly-entry
If you want to make a diary entry that applies to a specific day of
-the week, select that day of the week (any occurrence will do) and type
-@kbd{i w}. This inserts the day-of-week as a generic date; you can then
-type the rest of the diary entry. You can make a monthly diary entry in
-the same fashion: select the day of the month, use the @kbd{i m}
-command, and type the rest of the entry. Similarly, you can insert a
-yearly diary entry with the @kbd{i y} command.
+the week, select that day of the week (any occurrence will do) and
+type @kbd{i w} (@code{diary-insert-weekly-entry}). This inserts the
+day-of-week as a generic date; you can then type the rest of the diary
+entry. You can make a monthly diary entry in the same fashion: select
+the day of the month, use the @kbd{i m}
+(@code{diary-insert-monthly-entry}) command, and type the rest of the
+entry. Similarly, you can insert a yearly diary entry with the @kbd{i
+y} (@code{diary-insert-yearly-entry}) command.
All of the above commands make marking diary entries by default. To
make a nonmarking diary entry, give a prefix argument to the command.
@@ -1251,6 +1291,7 @@ calendar window, if appropriate. You can use the command
@node Special Diary Entries
@subsection Special Diary Entries
+@cindex sexp entries, in diary
In addition to entries based on calendar dates, the diary file can
contain @dfn{sexp entries} for regular events such as anniversaries.
These entries are based on Lisp expressions (sexps) that Emacs evaluates
@@ -1276,11 +1317,12 @@ Add a cyclic diary entry starting at the date
@kindex i a @r{(Calendar mode)}
@findex diary-insert-anniversary-entry
- If you want to make a diary entry that applies to the anniversary of a
-specific date, move point to that date and use the @kbd{i a} command.
-This displays the end of your diary file in another window and inserts
-the anniversary description; you can then type the rest of the diary
-entry. The entry looks like this:
+ If you want to make a diary entry that applies to the anniversary of
+a specific date, move point to that date and use the @kbd{i a}
+(@code{diary-insert-anniversary-entry}) command. This displays the
+end of your diary file in another window and inserts the anniversary
+description; you can then type the rest of the diary entry. The entry
+looks like this:
@findex diary-anniversary
@example
@@ -1294,6 +1336,7 @@ calendar style, the input order of month, day and year is
different.)
The reason this expression requires a beginning year is that advanced
diary functions can use it to calculate the number of elapsed years.
+@cindex block diary entry
A @dfn{block} diary entry applies to a specified range of consecutive
dates. Here is a block diary entry that applies to all dates from June
24, 2012 through July 10, 2012:
@@ -1310,17 +1353,19 @@ calendar style, the input order of month, day and year
is different.)
@kindex i b @r{(Calendar mode)}
@findex diary-insert-block-entry
- To insert a block entry, place point and the mark on the two
-dates that begin and end the range, and type @kbd{i b}. This command
-displays the end of your diary file in another window and inserts the
-block description; you can then type the diary entry.
+ To insert a block entry, place point and the mark on the two dates
+that begin and end the range, and type @kbd{i b}
+(@code{diary-insert-block-entry}). This command displays the end of
+your diary file in another window and inserts the block description;
+you can then type the diary entry.
@kindex i c @r{(Calendar mode)}
@findex diary-insert-cyclic-entry
- @dfn{Cyclic} diary entries repeat after a fixed interval of days. To
-create one, select the starting date and use the @kbd{i c} command. The
-command prompts for the length of interval, then inserts the entry,
-which looks like this:
+@cindex cyclic diary entry
+ @dfn{Cyclic} diary entries repeat after a fixed interval of days.
+To create one, select the starting date and use the @kbd{i c}
+(@code{diary-insert-cyclic-entry}) command. The command prompts for
+the length of interval, then inserts the entry, which looks like this:
@findex diary-cyclic
@example
@@ -1342,6 +1387,7 @@ since every date visible in the calendar window must be
individually
checked. So it's a good idea to make sexp diary entries nonmarking
(with @samp{&}) when possible.
+@cindex floating diary entry
Another sophisticated kind of sexp entry, a @dfn{floating} diary entry,
specifies a regularly occurring event by offsets specified in days,
weeks, and months. It is comparable to a crontab entry interpreted by
@@ -1477,6 +1523,7 @@ appointment list with @kbd{M-x appt-delete}.
@node Importing Diary
@subsection Importing and Exporting Diary Entries
+@cindex importing diary entries
You can transfer diary entries between Emacs diary files and a
variety of other formats.
@@ -1534,6 +1581,7 @@ to the main diary file, if these are different files.
@findex icalendar-export-file
@findex icalendar-export-region
+@cindex export diary
Use @code{icalendar-export-file} to interactively export an entire
Emacs diary file to iCalendar format. To export only a part of a diary
file, mark the relevant area, and call @code{icalendar-export-region}.
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index a3a740f9727..898c0bfaade 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -1167,11 +1167,20 @@ guessing off. The elements of
@code{dired-guess-shell-alist-user}
(defined by the user) will override these rules.
@end defvar
+@defvar dired-guess-shell-alist-optional
+This variable is like @code{dired-guess-shell-alist-default} but
+contains external viewers and players for various media formats.
+Setting this to @code{nil} turns guessing off. The variables
+@code{dired-guess-shell-alist-user} and
+@code{dired-guess-shell-alist-default} will override these rules.
+@end defvar
+
@defvar dired-guess-shell-alist-user
If non-@code{nil}, this variable specifies the user-defined alist of
file regexps and their suggested commands. These rules take
-precedence over the predefined rules in the variable
-@code{dired-guess-shell-alist-default} when
+precedence over the predefined rules in the variables
+@code{dired-guess-shell-alist-default} and
+@code{dired-guess-shell-alist-optional} when
@code{dired-do-shell-command} is run). The default is @code{nil}.
Each element of the alist looks like
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index bda57d2b30e..8f22e3c88da 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -175,6 +175,9 @@ scroll the current window by one line at a time. If you
intend to use
any of these commands, you might want to give them key bindings
(@pxref{Init Rebinding}).
+ On graphical displays, you can also scroll a window using the scroll
+bar; @pxref{Scroll Bars}.
+
@node Recentering
@section Recentering
@@ -405,6 +408,10 @@ than the amount you previously set by @code{scroll-left}.
When
other than the one showing the cursor will be scrolled by that minimal
amount.
+ On graphical displays, you can scroll a window horizontally using
+the horizontal scroll bar, if you turn on the optional
+@code{horizontal-scroll-bar-mode}; @pxref{Scroll Bars}.
+
@node Narrowing
@section Narrowing
@cindex widening
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 5ede7def2c0..dfacf501650 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -786,6 +786,14 @@ 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.
+@vindex file-precious-flag
+ Copying the old file for backup is also useful when editing precious
+files, because it makes sure the old file keeps its name if something
+fails between the backup and the saving of your edits. Alternatively,
+you can customize @code{file-precious-flag} to a non-@code{nil} value,
+which implies backups by copying and also protects against I/O errors
+while saving your edits.
+
@node Customize Save
@subsection Customizing Saving of Files
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index 8e6cbeed70b..6c62fde4ffb 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -1146,11 +1146,11 @@ text or moving point with a keyboard command will
usually bring it back
into view.
@findex horizontal-scroll-bar-mode
- To toggle the use of horizontal scroll bars, type @kbd{M-x
-horizontal-scroll-bar-mode}. This command applies to all frames,
+ To toggle the use of horizontal scroll bars, type @w{@kbd{M-x
+horizontal-scroll-bar-mode}}. This command applies to all frames,
including frames yet to be created. To toggle horizontal scroll bars
-for just the selected frame, use the command @kbd{M-x
-toggle-horizontal-scroll-bar}.
+for just the selected frame, use the command @w{@kbd{M-x
+toggle-horizontal-scroll-bar}}.
@vindex horizontal-scroll-bar-mode
To control the use of horizontal scroll bars at startup, customize the
diff --git a/doc/emacs/input.texi b/doc/emacs/input.texi
index 67679b00e89..b553c0895cd 100644
--- a/doc/emacs/input.texi
+++ b/doc/emacs/input.texi
@@ -126,27 +126,26 @@ minibuffer being brought into use (@pxref{Minibuffer}).
@vindex touch-screen-set-point-commands
When a ``tap'' gesture results in a command being executed, Emacs
-checks whether the command is meant to set the point by searching for
-it in the list @code{touch-screen-set-point-commands}. If it is and
-the text beneath the new point is not read-only, it activates the
-virtual keyboard, in anticipation that the user is about to enter text
-there.
+checks whether the command is meant to set the point by searching for it
+in the list @code{touch-screen-set-point-commands}. If it is, and the
+text beneath the new point is not read-only, the virtual keyboard is
+activated, in anticipation of the user input there.
- The default value of @code{touch-screen-set-point-commands} holds
-only the command @code{mouse-set-point} (@pxref{Mouse Commands}),
-which is the default binding of @code{mouse-1}, and thus of
-touchscreen tap gestures as well.
+ The default value of @code{touch-screen-set-point-commands} holds only
+the command @code{mouse-set-point} (@pxref{Mouse Commands}), which is
+the default binding of @code{mouse-1}, and therefore of touchscreen tap
+gestures as well.
@vindex touch-screen-display-keyboard
- The user option @code{touch-screen-display-keyboard} compels Emacs
-to display the virtual keyboard on such taps even if the text is read
-only; it may also be set buffer locally, in which case Emacs will
-always display the keyboard in response to a tap on a window
-displaying the buffer it is set in.
+ The user option @code{touch-screen-display-keyboard} compels Emacs to
+display the virtual keyboard on all tap gestures even if the text is
+read only; it may also be set buffer locally, in which case Emacs will
+always display the keyboard in response to a tap on a window displaying
+the buffer it is set in.
- There are moreover several functions to show or hide the on-screen
-keyboard. For more details, @xref{On-Screen Keyboards,,, elisp, The
-Emacs Lisp Reference Manual}.
+ There are moreover several functions that display or hide the
+on-screen keyboard. For more details, @xref{On-Screen Keyboards,,,
+elisp, The Emacs Lisp Reference Manual}.
@cindex quitting, without a keyboard
Since it may not be possible for Emacs to display the virtual
@@ -156,9 +155,11 @@ which two rapid clicks of a hardware button that is always
present on
the device induces a quit. @xref{Quitting}.
@vindex x-quit-keysym
- No such button is enabled on X, but one can be configured through
-the variable @code{x-quit-keysym}. On Android this button is always
-the volume down button.
+@vindex android-quit-keycode
+ No such button is enabled on X, but one can be configured through the
+variable @code{x-quit-keysym}, whereas the default key is the volume
+down button on Android, which is also configurable through a variable,
+@code{android-quit-keycode}.
@cindex text conversion, keyboards
Most input methods designed to work with virtual keyboards edit text
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 2b945a0c5bd..579098c81b1 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -2343,19 +2343,33 @@ documentation for details.
@vindex xref-auto-jump-to-first-definition
If any of the above commands finds more than one matching
definition, it by default pops up the @file{*xref*} buffer showing the
-matching candidates. (@kbd{C-M-.}@: @emph{always} pops up the
-@file{*xref*} buffer if it finds at least one match.) The candidates
-are normally shown in that buffer as the name of a file and the
-matching identifier(s) in that file. In that buffer, you can select
-any of the candidates for display, and you have several additional
-commands, described in @ref{Xref Commands}. However, if the value of
-the variable @code{xref-auto-jump-to-first-definition} is @code{move},
-the first of these candidates is automatically selected in the
-@file{*xref*} buffer, and if it's @code{t} or @code{show}, the first
-candidate is automatically shown in its own window; @code{t} also
-selects the window showing the first candidate. The default value is
-@code{nil}, which just shows the candidates in the @file{*xref*}
-buffer, but doesn't select any of them.
+matching candidates and selects that buffer's window. (@kbd{C-M-.}@:
+@emph{always} pops up the @file{*xref*} buffer if it finds at least
+one match.) Each candidate is normally shown in that buffer as the
+name of a file and the matching identifier(s) in that file. In that
+buffer, you can select any of the candidates for display, and you have
+several additional commands, described in @ref{Xref Commands}.
+However, if the value of the variable
+@code{xref-auto-jump-to-first-definition} is @code{move}, Emacs
+automatically moves point to the first of these candidates in the
+@file{*xref*} buffer, so just typing @key{RET} will display the
+definition of that candidate. If the value of the variable is
+@code{t} or @code{show}, the first candidate is automatically shown in
+its own window; @code{t} also selects the window showing the first
+candidate's definition, while @code{show} leaves the window of the
+@file{*xfer*} buffer selected. The default value is @code{nil}, which
+just shows the candidates in the @file{*xref*} buffer, but neither
+selects any of them nor shows their definition, until you select a
+candidate in the @file{*xref*} buffer.
+
+@findex next-error, in @file{*xref*} buffer
+@findex previous-error, in @file{*xref*} buffer
+@kindex M-g M-n, for navigation in @file{*xref*} buffer
+@kindex M-g M-p, for navigation in @file{*xref*} buffer
+ If you switch away of the window showing the @file{*xref*} buffer
+which displays several candidates, you can move from one candidate to
+another using the commands @w{@kbd{M-g M-n}} (@code{next-error}) and
+@w{@kbd{M-g M-p}} (@code{previous-error}). @xref{Compilation Mode}.
@kindex M-,
@findex xref-go-back
@@ -2518,12 +2532,17 @@ referenced. The XREF mode commands are available in
this buffer, see
@vindex xref-auto-jump-to-first-xref
If the value of the variable @code{xref-auto-jump-to-first-xref} is
@code{t}, @code{xref-find-references} automatically jumps to the first
-result and selects the window where it is displayed. If the value is
-@code{show}, the first result is shown, but the window showing the
+result in the @file{*xref*} buffer and selects the window where that
+reference is displayed; you can select the other results with
+@w{@kbd{M-g M-n}} (@code{next-error}) and @w{@kbd{M-g M-p}}
+(@code{previous-error}) (@pxref{Compilation Mode}). If the value is
+@code{show}, the first result is displayed, but the window showing the
@file{*xref*} buffer is left selected. If the value is @code{move},
the first result is selected in the @file{*xref*} buffer, but is not
-shown. The default value is @code{nil}, which just shows the results
-in the @file{*xref*} buffer, but doesn't select any of them.
+displayed; you can then use @key{RET} to actually display the
+reference. The default value is @code{nil}, which just shows the
+results in the @file{*xref*} buffer, but doesn't select any of them,
+and doesn't display the reference itself.
@findex xref-query-replace-in-results
@kbd{r} (@code{xref-query-replace-in-results}) reads a @var{replacement}
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 04e6138b692..3bee88bca86 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -590,7 +590,7 @@ even when @command{mutool} can be found on your system,
customize the
variable @code{doc-view-imenu-enabled} to the @code{nil} value. You
can further customize how @code{imenu} items are formatted and
displayed using the variables @code{doc-view-imenu-format} and
-@code{doc-view-flatten}.
+@code{doc-view-imenu-flatten}.
@node DocView Searching
@subsection DocView Searching
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index a16a9ea8f71..55dd74c48a3 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -1671,6 +1671,10 @@ used. Some examples are:
nil 'append)
@end example
+When modifying the fontset for the @code{symbol} script, the value of
+@code{use-default-font-for-symbols} will affect whether the fontset is
+actually used.
+
@noindent
@xref{Fontsets, , , elisp, GNU Emacs Lisp Reference Manual}, for more
details about using the @code{set-fontset-font} function.
@@ -1867,6 +1871,12 @@ they too are defined to compose with the following
character, once
@code{iso-transl} is loaded.
Use @kbd{C-x 8 C-h} to list all the available @kbd{C-x 8} translations.
+
+The set of translations available can be extended with certain
+language-specific characters using the @kbd{M-x iso-transl-set-language}
+command. Current supported languages are: @samp{French}, @samp{German},
+@samp{Portuguese}, @samp{Spanish}, and @samp{Esperanto}. See
+@code{iso-transl-language-alist} for details.
@end itemize
@node Charsets
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index c8f790bab47..fd445805068 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -490,8 +490,12 @@ startup if invoked with the @samp{-q} or
@samp{--no-init-file} options
To keep Emacs from automatically making packages available at
startup, change the variable @code{package-enable-at-startup} to
@code{nil}. You must do this in the early init file, as the variable
-is read before loading the regular init file. Currently this variable
-cannot be set via Customize.
+is read before loading the regular init file. Therefore, if you
+customize this variable via Customize, you should save your customized
+setting into your early init file. To do this, set or change the value
+of the variable @code{custom-file} (@pxref{Saving Customizations}) to
+point to your early init file before saving the customized value of
+@code{package-enable-at-startup}.
@findex package-quickstart-refresh
@vindex package-quickstart
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index de28a9f1dd4..8ab5033795d 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -338,10 +338,13 @@ where it treats each chapter, section, etc., as a
definition.
together.)
@findex imenu
+@vindex imenu-flatten
If you type @kbd{M-g i} (@code{imenu}), it reads the name of a
definition using the minibuffer, then moves point to that definition.
You can use completion to specify the name; the command always
-displays the whole list of valid names.
+displays the whole list of valid names. If you set @code{imenu-flatten}
+to a non-@code{nil} value, then instead of the nested menu
+you can select a completion candidate from the flat list.
@findex imenu-add-menubar-index
Alternatively, you can bind the command @code{imenu} to a mouse
@@ -375,6 +378,10 @@ they occur in the buffer; if you want alphabetic sorting,
use the
symbol @code{imenu--sort-by-name} as the value. You can also
define your own comparison function by writing Lisp code.
+ You can also customize how Imenu completions are sorted by changing
+the variable @code{completion-category-overrides} and setting its
+@code{display-sort-function} for the category @code{imenu}.
+
If Eglot is activated for the current buffer's project
(@pxref{Projects}) and the current buffer's major mode, Eglot provides
its own facility for producing the buffer's index based on the
diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi
index cac5b32c566..734d704a272 100644
--- a/doc/emacs/regs.texi
+++ b/doc/emacs/regs.texi
@@ -380,8 +380,19 @@ Save all the current bookmark values in the default
bookmark file.
@kbd{C-x r m}, which sets a bookmark using the visited file name as
the default for the bookmark name. If you name each bookmark after
the file it points to, then you can conveniently revisit any of those
-files with @kbd{C-x r b}, and move to the position of the bookmark at
-the same time.
+files with @kbd{C-x r b} (@code{bookmark-jump}), and move to the
+position of the bookmark at the same time.
+
+@vindex bookmark-fringe-mark
+ In addition to recording the current position, on graphical displays
+@kbd{C-x r m} places a special image on the left fringe
+(@pxref{Fringes}) of the screen line corresponding to the recorded
+position, to indicate that there's a bookmark there. This can be
+controlled by the user option @code{bookmark-fringe-mark}: customize
+it to @code{nil} to disable the fringe mark. The default value is
+@code{bookmark-mark}, which is the bitmap used for this purpose. When
+you later use @kbd{C-x r b} to jump back to the bookmark, the fringe
+mark will be again shown on the fringe.
@kindex C-x r M
@findex bookmark-set-no-overwrite
diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi
index f94708b08ac..9c20d30c442 100644
--- a/doc/emacs/rmail.texi
+++ b/doc/emacs/rmail.texi
@@ -1428,7 +1428,7 @@ encrypted/decrypted text.
your Rmail file (@pxref{Rmail Inbox}). When loaded for the first time,
Rmail attempts to locate the @command{movemail} program and determine its
version. There are two versions of the @command{movemail} program: the
-GNU Mailutils version (@pxref{movemail,,,mailutils,GNU mailutils}),
+GNU Mailutils version (@pxref{movemail,,,mailutils,GNU Mailutils Manual}),
and an Emacs-specific version that is built and installed unless Emacs
was configured @option{--with-mailutils} in effect.
The two @command{movemail} versions support the same
@@ -1446,8 +1446,7 @@ mailboxes, etc. It is able to access remote mailboxes
using the POP3
or IMAP4 protocol, and can retrieve mail from them using a TLS
encrypted channel. It also accepts mailbox arguments in @acronym{URL}
form. The detailed description of mailbox @acronym{URL}s can be found
-@c Note this node seems to be missing in some versions of mailutils.info?
-in @ref{URL,,,mailutils,Mailbox URL Formats}. In short, a
+in @ref{Mailbox,,,mailutils,GNU Mailutils Manual}. In short, a
@acronym{URL} is:
@smallexample
@@ -1458,6 +1457,8 @@ in @ref{URL,,,mailutils,Mailbox URL Formats}. In short, a
where square brackets denote optional elements.
@table @var
+@cindex mailbox protocol, @command{movemail}
+@cindex format, of @command{movemail} mailbox
@item proto
Specifies the @dfn{mailbox protocol}, or @dfn{format} to
use. The exact semantics of the rest of @acronym{URL} elements depends
@@ -1503,23 +1504,13 @@ automatically by @command{movemail}.
@item pop
@itemx pops
-A remote mailbox to be accessed via POP3 protocol. @var{user}
-specifies the remote user name to use, @var{pass} may be used to
-specify the user password, @var{host-or-file-name} is the name or IP
-address of the remote mail server to connect to, and @var{port} is the
-port number; e.g., @code{pop://smith:guessme@@remote.server.net:995}.
-If the server supports it, @command{movemail} tries to use an
-encrypted connection---use the @samp{pops} form to require one.
+A remote mailbox to be accessed via POP3 protocol. @xref{Remote
+Mailboxes}, for details.
@item imap
@itemx imaps
-A remote mailbox to be accessed via IMAP4 protocol. @var{user}
-specifies the remote user name to use, @var{pass} may be used to
-specify the user password, @var{host-or-file-name} is the name or IP
-address of the remote mail server to connect to, and @var{port} is the
-port number; e.g., @code{imap://smith:guessme@@remote.server.net:993}.
-If the server supports it, @command{movemail} tries to use an
-encrypted connection---use the @samp{imaps} form to require one.
+A remote mailbox to be accessed via IMAP4 protocol. @xref{Remote
+Mailboxes}, for details.
@end table
Alternatively, you can specify the file name of the mailbox to use.
@@ -1541,6 +1532,7 @@ listed in @code{rmail-movemail-search-path}, then in
@code{exec-path}
@node Remote Mailboxes
@section Retrieving Mail from Remote Mailboxes
@pindex movemail
+@cindex remote mailboxes, accessing by @command{movemail}
Some sites use a method called POP3 for accessing users' inbox data
instead of storing the data in inbox files. The Mailutils
@@ -1565,8 +1557,9 @@ Additionally, you may specify the password in the mailbox
@acronym{URL}:
case, @var{password} takes preference over the one set by
@code{rmail-remote-password} (see below). This is especially useful
if you have several remote mailboxes with different passwords.
-If using Mailutils @command{movemail}, you may wish to use
-@samp{pops} in place of @samp{pop}.
+If using Mailutils @command{movemail} and the server supports
+encrypted connections, @command{movemail} tries to use it; specify
+@samp{pops:} instead of @samp{pop:} to require such a connection.
For backward compatibility, Rmail also supports an alternative way of
specifying remote POP3 mailboxes. Specifying an inbox name in the form
@@ -1576,12 +1569,14 @@ specifying remote POP3 mailboxes. Specifying an inbox
name in the form
the machine on which to look for the POP3 server.
@cindex IMAP mailboxes
- Another method for accessing remote mailboxes is IMAP@. This method is
-supported only by the Mailutils @command{movemail}. To specify an IMAP
-mailbox in the inbox list, use the following mailbox @acronym{URL}:
-@samp{imap://@var{username}[:@var{password}]@@@var{hostname}:@var{port}}. The
-@var{password} part is optional, as described above. You may wish to
-use @samp{imaps} in place of @samp{imap}.
+ Another method for accessing remote mailboxes is IMAP@. This method
+is supported only by the Mailutils @command{movemail}, and uses the
+IMAP4 protocol. To specify an IMAP mailbox in the inbox list, use the
+following mailbox @acronym{URL}:
+@samp{imap://@var{username}[:@var{password}]@@@var{hostname}:@var{port}}.
+The @var{password} part is optional, as described above. If the
+server supports it, @command{movemail} tries to use an encrypted
+connection---use the @samp{imaps:} form to require one.
@vindex rmail-remote-password
@vindex rmail-remote-password-required
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index 9ba425f2d21..3b52385347b 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -784,6 +784,7 @@ matching}) has no effect on them.
@vindex eww-search-prefix
@cindex Internet search
@cindex search Internet for keywords
+@cindex web search
To search the Web for the text in region, type @kbd{M-s M-w}. This
command performs an Internet search for the words in region using the
search engine whose @acronym{URL} is specified by the variable
diff --git a/doc/emacs/sending.texi b/doc/emacs/sending.texi
index 7d9f4917929..937ee568a3a 100644
--- a/doc/emacs/sending.texi
+++ b/doc/emacs/sending.texi
@@ -676,9 +676,11 @@ using this.
In this chapter we have described the usual Emacs mode for editing
and sending mail---Message mode. This is only one of several
available modes. Prior to Emacs 23.2, the default mode was Mail mode,
-which is similar to Message mode in many respects but lacks features
-such as MIME support. Another available mode is MH-E
-(@pxref{Top,,MH-E,mh-e, The Emacs Interface to MH}).
+which is similar to Message mode in many respects but is less
+feature-rich; for example, it supports only basic MIME: it allows you
+to add attachments, but lacks more sophisticated MIME features.
+Another available mode is MH-E (@pxref{Top,,MH-E,mh-e, The Emacs
+Interface to MH}).
@vindex mail-user-agent
@findex define-mail-user-agent
diff --git a/doc/lispintro/emacs-lisp-intro.texi
b/doc/lispintro/emacs-lisp-intro.texi
index a06822ce539..4649cd59962 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -7193,7 +7193,7 @@ the @samp{@result{}} shows what is returned.
@smallexample
@group
(cdr '(pine fir oak maple))
- @result{}(fir oak maple)
+ @result{} (fir oak maple)
@end group
@group
@@ -7203,7 +7203,7 @@ the @samp{@result{}} shows what is returned.
@group
(cdr '(oak maple))
- @result{}(maple)
+ @result{} (maple)
@end group
@group
@@ -19428,7 +19428,7 @@ There is more, but that is the hardest part.
@appendixsec The @file{ring.el} File
@cindex @file{ring.el} file
-Interestingly, GNU Emacs posses a file called @file{ring.el} that
+Interestingly, GNU Emacs possesses a file called @file{ring.el} that
provides many of the features we just discussed. But functions such
as @code{kill-ring-yank-pointer} do not use this library, possibly
because they were written earlier.
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index ea6e84e3730..3425281febd 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -3738,8 +3738,11 @@ if you want to translate characters after input methods
operate.
@defun key-translate from to
This function modifies @code{keyboard-translate-table} to translate
-character code @var{from} into character code @var{to}. It creates
-the keyboard translate table if necessary.
+character code @var{from} into character code @var{to}. It creates the
+keyboard translate table if necessary. Both @var{from} and @var{to}
+should be strings that satisfy @code{key-valid-p} (@pxref{Key
+Sequences}). If @var{to} is @code{nil}, the function removes any
+existing translation for @var{from}.
@end defun
Here's an example of using the @code{keyboard-translate-table} to
@@ -3763,7 +3766,10 @@ character as far as keyboard translation is concerned,
but it has the
same usual meaning.
@xref{Translation Keymaps}, for mechanisms that translate event sequences
-at the level of @code{read-key-sequence}.
+at the level of @code{read-key-sequence}. If you need to translate
+input events that are not characters (i.e., @code{characterp} returns
+@code{nil} for them), you must use the event translation mechanism
+described there.
@node Invoking the Input Method
@subsection Invoking the Input Method
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index 00602198da5..9f93fb4a981 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -37,7 +37,7 @@ variable binding for @code{no-byte-compile} into it, like
this:
* Docs and Compilation:: Dynamic loading of documentation strings.
* 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.
+* Closure Objects:: The data type used for byte-compiled functions.
* Disassembly:: Disassembling byte-code; how to read byte-code.
@end menu
@@ -120,7 +120,7 @@ replacing the previous definition with the compiled one.
The function
definition of @var{symbol} must be the actual code for the function;
@code{byte-compile} does not handle function indirection. The return
value is the byte-code function object which is the compiled
-definition of @var{symbol} (@pxref{Byte-Code Objects}).
+definition of @var{symbol} (@pxref{Closure Objects}).
@example
@group
@@ -334,8 +334,8 @@ If you have a constant that needs some calculation to
produce,
@code{eval-when-compile} can do that at compile-time. For example,
@lisp
-(defvar my-regexp
- (eval-when-compile (regexp-opt '("aaa" "aba" "abb"))))
+(defvar gauss-schoolboy-problem
+ (eval-when-compile (apply #'+ (number-sequence 1 100))))
@end lisp
@cindex macros, at compile time
@@ -487,21 +487,22 @@ string for details.
using @code{error}. If so, set @code{byte-compile-error-on-warn} to a
non-@code{nil} value.
-@node Byte-Code Objects
-@section Byte-Code Function Objects
+@node Closure Objects
+@section Closure Function Objects
@cindex compiled function
@cindex byte-code function
@cindex byte-code object
- Byte-compiled functions have a special data type: they are
-@dfn{byte-code function objects}. Whenever such an object appears as
-a function to be called, Emacs uses the byte-code interpreter to
-execute the byte-code.
+ Byte-compiled functions use a special data type: they are closures.
+Closures are used both for byte-compiled Lisp functions as well as for
+interpreted Lisp functions. Whenever such an object appears as
+a function to be called, Emacs uses the appropriate interpreter to
+execute either the byte-code or the non-compiled Lisp code.
- Internally, a byte-code function object is much like a vector; its
+ Internally, a closure is much like a vector; its
elements can be accessed using @code{aref}. Its printed
representation is like that for a vector, with an additional @samp{#}
-before the opening @samp{[}. It must have at least four elements;
+before the opening @samp{[}. It must have at least three elements;
there is no maximum number, but only the first six elements have any
normal use. They are:
@@ -515,20 +516,28 @@ zero to 6, and the maximum number of arguments in bits 8
to 14. If
the argument list uses @code{&rest}, then bit 7 is set; otherwise it's
cleared.
-If @var{argdesc} is a list, the arguments will be dynamically bound
+When the closure is a byte-code function,
+if @var{argdesc} is a list, the arguments will be dynamically bound
before executing the byte code. If @var{argdesc} is an integer, the
arguments will be instead pushed onto the stack of the byte-code
interpreter, before executing the code.
-@item byte-code
-The string containing the byte-code instructions.
+@item code
+For interpreted functions, this element is the (non-empty) list of Lisp
+forms that make up the function's body. For byte-compiled functions, it
+is the string containing the byte-code instructions.
@item constants
-The vector of Lisp objects referenced by the byte code. These include
-symbols used as function names and variable names.
+For byte-compiled functions, this holds the vector of Lisp objects
+referenced by the byte code. These include symbols used as function
+names and variable names.
+For interpreted functions, this is @code{nil} if the function is using the old
+dynamically scoped dialect of Emacs Lisp, and otherwise it holds the
+function's lexical environment.
@item stacksize
-The maximum stack size this function needs.
+The maximum stack size this function needs. This element is left unused
+for interpreted functions.
@item docstring
The documentation string (if any); otherwise, @code{nil}. The value may
@@ -558,8 +567,8 @@ representation. It is the definition of the command
@code{make-byte-code}:
@defun make-byte-code &rest elements
-This function constructs and returns a byte-code function object
-with @var{elements} as its elements.
+This function constructs and returns a closure which represents the
+byte-code function object with @var{elements} as its elements.
@end defun
You should not try to come up with the elements for a byte-code
@@ -567,6 +576,20 @@ function yourself, because if they are inconsistent, Emacs
may crash
when you call the function. Always leave it to the byte compiler to
create these objects; it makes the elements consistent (we hope).
+The primitive way to create an interpreted function is with
+@code{make-interpreted-closure}:
+
+@defun make-interpreted-closure args body env &optional docstring iform
+This function constructs and returns a closure representing the
+interpreted function with arguments @var{args} and whose body is made of
+@var{body} which must be a non-@code{nil} list of Lisp forms. @var{env} is the
+lexical environment in the same form as used with @code{eval}
+(@pxref{Eval}). The documentation @var{docstring} if non-@code{nil} should be
+a string, and the interactive form @var{iform} if non-@code{nil} should be of
+the form @w{@code{(interactive @var{arg-descriptor})}} (@pxref{Using
+Interactive}).
+@end defun
+
@node Disassembly
@section Disassembled Byte-Code
@cindex disassembled byte-code
@@ -595,7 +618,7 @@ name of an existing buffer. Then the output goes there, at
point, and
point is left before the output.
The argument @var{object} can be a function name, a lambda expression
-(@pxref{Lambda Expressions}), or a byte-code object (@pxref{Byte-Code
+(@pxref{Lambda Expressions}), or a byte-code object (@pxref{Closure
Objects}). If it is a lambda expression, @code{disassemble} compiles
it and disassembles the resulting compiled code.
@end deffn
@@ -964,6 +987,26 @@ form, @pxref{Declare Form}.)
The default value is 2.
@end defopt
+@anchor{compilation-safety}
+@defopt compilation-safety
+This variable specifies the safety level to be used for the emitted
+native code. The value should be a number, either 0 or 1 with the
+following meanings:
+
+@table @asis
+@item 0
+Emitted code can misbehave (up to even crashing Emacs) if a function's
+declaration does not describe correctly what the function does or how it
+is called, and the function is natively compiled.
+@item 1
+Emitted code must be generated in a safe manner even if functions are
+mis-declared.
+@end table
+
+This can also be controlled at a function granularity, by using the
+@code{safety} @code{declare} form, @pxref{Declare Form}.
+@end defopt
+
@defopt native-comp-debug
This variable specifies the level of debugging information produced by
native-compilation. Its value should be a number between zero and 3,
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index f9f3389c398..58063ecf8db 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -350,7 +350,8 @@ kinds of multiple conditional constructs.
This function tests for the falsehood of @var{condition}. It returns
@code{t} if @var{condition} is @code{nil}, and @code{nil} otherwise.
The function @code{not} is identical to @code{null}, and we recommend
-using the name @code{null} if you are testing for an empty list.
+using the name @code{null} if you are testing for an empty list or
+@code{nil} value.
@end defun
@defspec and conditions@dots{}
@@ -1317,11 +1318,18 @@ example:
does the same as the previous example, except that it directly tries
to extract @code{x} and @code{y} from @code{my-list} without first
verifying if @code{my-list} is a list which has the right number of
-elements and has @code{add} as its first element. The precise
-behavior when the object does not actually match the pattern is
-undefined, although the body will not be silently skipped: either an
-error is signaled or the body is run with some of the variables
-potentially bound to arbitrary values like @code{nil}.
+elements and has @code{add} as its first element.
+
+The precise behavior when the object does not actually match the pattern
+depends on the types, although the body will not be silently skipped:
+either an error is signaled or the body is run with some of the
+variables bound to arbitrary values like @code{nil}.
+For example, the above pattern will result in @var{x} and @var{y}
+being extracted with operations like @code{car} or @code{nth}, so they
+will get value @code{nil} when @var{my-list} is too short. In contrast,
+with a pattern like @code{`[add ,x ,y]}, those same variables would
+be extracted using @code{aref} which would signal an error if
+@var{my-list} is not an array or is too short.
The pcase patterns that are useful for destructuring bindings are
generally those described in @ref{Backquote Patterns}, since they
@@ -2411,7 +2419,7 @@ point where we signaled the original error:
@group
Debugger entered--Lisp error: (error "Oops")
signal(error ("Oops"))
- (closure (t) (err) (signal 'error (cdr err)))((user-error "Oops"))
+ #f(lambda (err) [t] (signal 'error (cdr err)))((user-error "Oops"))
user-error("Oops")
@dots{}
eval((handler-bind ((user-error (lambda (err) @dots{}
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index fba15578f4f..16b43553bc8 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -148,7 +148,8 @@ boundary. @xref{Filling}.
On a graphical display, tiny arrow images in the window fringes
indicate truncated and continued lines (@pxref{Fringes}). On a text
-terminal, a @samp{$} in the rightmost column of the window indicates
+terminal, and on a graphical display when @code{fringe-mode} was
+turned off, a @samp{$} in the rightmost column of the window indicates
truncation; a @samp{\} on the rightmost column indicates a line that
wraps. (The display table can specify alternate characters to use
for this; @pxref{Display Tables}).
@@ -2685,12 +2686,17 @@ Underline in color @var{color}, a string specifying a
color.
@var{color} is either a string, or the symbol @code{foreground-color},
meaning the foreground color of the face. Omitting the attribute
@code{:color} means to use the foreground color of the face.
-@var{style} should be a symbol @code{line} or @code{wave}, meaning to
-use a straight or wavy line. Omitting the attribute @code{:style}
-means to use a straight line. @var{position}, if non-@code{nil}, means to
-display the underline at the descent of the text, instead of at the
-baseline level. If it is a number, then it specifies the amount of
-pixels above the descent to display the underline.
+@var{style} is a symbol which sets the line-style to of the underline.
+It should be one of @code{line}, @code{double-line}, @code{wave},
+@code{dots}, or @code{dashes}. GUI frames under most window systems
+support all the aforementioned underline styles, while on text terminals
+@code{double-line}, @code{wave} and @code{dots} are contingent on the
+availability of the @code{Smulx} or @code{Su} terminfo capabilities.
+Omitting the attribute @code{:style} means to use a straight line.
+@var{position}, if non-@code{nil}, means to display the underline at the
+descent of the text, instead of at the baseline level. If it is a
+number, then it specifies the amount of pixels above the descent to
+display the underline.
@end table
@cindex overlined text
@@ -2747,6 +2753,11 @@ being pressed. If it is @code{pressed-button}, the box
looks like a
@code{flat-button} or omitted, a plain 2D box is used.
@end table
+If you use the @code{:box} face attribute on strings displayed instead
+of buffer text via the @code{display} text property, special
+considerations might apply if the surrounding buffer text also has the
+@code{:box} face attribute. @xref{Replacing Specs}.
+
@item :inverse-video
Whether or not characters should be displayed in inverse video. The
value should be @code{t} (yes) or @code{nil} (no).
@@ -3978,7 +3989,9 @@ that case, use @var{font-spec} for all the characters in
the charset.
@var{characters} may be a script symbol (@pxref{Character Properties,
char-script-table}). In that case, use @var{font-spec} for all the
-characters belonging to the script.
+characters belonging to the script. See also
+@code{use-default-font-for-symbols}, which affects font selection
+when @var{fontset} is @code{symbol}.
@var{characters} may be @code{nil}, which means to use @var{font-spec}
for any character in @var{fontset} for which no font-spec is
@@ -4016,6 +4029,14 @@ the charset @code{japanese-jisx0208}:
(set-fontset-font t 'japanese-jisx0208
(font-spec :family "Kochi Gothic"))
@end smallexample
+
+Note that this function should generally be called from the user's
+init files, and more generally before any of @var{characters} were
+displayed in the current Emacs session. That's because for some
+scripts, Emacs caches the way they are displayed, and the cached
+information includes the font used for them -- once these characters
+are displayed once, the cached font will continue to be used
+regardless of changes in the fontsets.
@end defun
@defun char-displayable-p char
@@ -5265,6 +5286,34 @@ characters get a second string (@code{concat} creates a
new string
object), so they are replaced with one @samp{A}; and so on. Thus, the
ten characters appear as five A's.
+@cindex box face attribute, and @code{display} properties
+Note: Using @code{:box} face attribute (@pxref{Face Attributes}) on a
+replacing @code{display} string that is adjacent to normal text with
+the same @code{:box} style can lead to display artifacts when moving
+the cursor across the text with this face attribute. These can be
+avoided by applying the @code{:box} attribute directly to the text
+being replaced, rather than (or in addition to) the @code{display}
+string itself. Here's an example:
+
+@smallexample
+@group
+;; Causes display artifacts when moving the cursor across text
+(progn
+ (put-text-property 1 2 'display (propertize " [" 'face '(:box t)))
+ (put-text-property 2 3 'face '(:box t))
+ (put-text-property 3 4 'display (propertize "] " 'face '(:box t))))
+@end group
+
+@group
+;; No display artifacts due to `:box'
+(progn
+ (add-text-properties 1 2 '(face (:box t) display " ["))
+ (put-text-property 2 3 'face '(:box t))
+ (add-text-properties 3 4 '(face (:box t) display "] ")))
+@end group
+@end smallexample
+
+
@node Specified Space
@subsection Specified Spaces
@cindex spaces, specified height or width
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index ec93a0b9c8a..339272d1f05 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -323,7 +323,7 @@ Programming Types
* Macro Type:: A method of expanding an expression into another
expression, more fundamental but less pretty.
* Primitive Function Type:: A function written in C, callable from Lisp.
-* Byte-Code Type:: A function written in Lisp, then compiled.
+* Closure Type:: A function written in Lisp, then compiled.
* Record Type:: Compound objects with programmer-defined types.
* Type Descriptors:: Objects holding information about types.
* Autoload Type:: A type used for automatically loading seldom-used
@@ -657,7 +657,7 @@ Byte Compilation
* Docs and Compilation:: Dynamic loading of documentation strings.
* 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.
+* Closure Objects:: The data type used for byte-compiled functions.
* Disassembly:: Disassembling byte-code; how to read byte-code.
Native Compilation
diff --git a/doc/lispref/elisp_type_hierarchy.jpg
b/doc/lispref/elisp_type_hierarchy.jpg
index 386954e1007..6559ef8bf9b 100644
Binary files a/doc/lispref/elisp_type_hierarchy.jpg and
b/doc/lispref/elisp_type_hierarchy.jpg differ
diff --git a/doc/lispref/elisp_type_hierarchy.txt
b/doc/lispref/elisp_type_hierarchy.txt
index bb93cd831b9..08ce0603243 100644
--- a/doc/lispref/elisp_type_hierarchy.txt
+++ b/doc/lispref/elisp_type_hierarchy.txt
@@ -1,33 +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
|
+| accessor | oclosure-accessor
|
+| cl--class | cl-structure-class oclosure--class built-in-class
|
+| vector | timer
|
+| cons | ppss decoded-time
|
+| number | integer float
|
+| integer-or-marker | integer marker
|
+| number-or-marker | number integer-or-marker
|
+| array | vector string bool-vector char-table
|
+| oclosure | accessor advice cconv--interactive-helper
advice--forward |
+| | save-some-buffers-function cl--generic-nnm
|
+| cl-structure-object | cl--class xref-elisp-location org-cite-processor
|
+| | cl--generic-method cl--random-state
register-preview-info |
+| | cl--generic cl-slot-descriptor uniquify-item registerv
|
+| | isearch--state cl--generic-generalizer
lisp-indent-state |
+| record | cl-structure-object
|
+| symbol | boolean symbol-with-pos
|
+| subr | primitive-function subr-native-elisp special-form
|
+| compiled-function | primitive-function subr-native-elisp
byte-code-function |
+| function | oclosure compiled-function interpreted-function
|
+| | module-function
|
+| list | null cons
|
+| sequence | array list
|
+| atom | number-or-marker array record symbol subr function
mutex |
+| | font-spec frame tree-sitter-compiled-query
|
+| | tree-sitter-node font-entity finalizer
tree-sitter-parser |
+| | hash-table window-configuration user-ptr overlay
process |
+| | font-object obarray condvar buffer terminal thread
window |
+| | native-comp-unit
|
+| t | sequence atom
|
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index cf7fc7721c5..2686ae93a33 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -1944,10 +1944,16 @@ integer). @xref{Line Height}, for more information.
@vindex no-special-glyphs@r{, a frame parameter}
@item no-special-glyphs
If this is non-@code{nil}, it suppresses the display of any truncation
-and continuation glyphs (@pxref{Truncation}) for all buffers displayed
-by this frame. This is useful to eliminate such glyphs when fitting a
-frame to its buffer via @code{fit-frame-to-buffer} (@pxref{Resizing
-Windows}).
+(@pxref{Truncation}) and continuation glyphs for all the buffers
+displayed by this frame. This is useful to eliminate such glyphs when
+fitting a frame to its buffer via @code{fit-frame-to-buffer}
+(@pxref{Resizing Windows}). This frame parameter has effect only for
+GUI frames shown on graphical displays, and only if the fringes are
+disabled. This parameter is intended as a purely-presentation
+feature, and in particular should not be used for frames where the
+user can interactively insert text, or more generally where the cursor
+is shown. A notable example of frames where this is used is tooltip
+frames (@pxref{Tooltips}).
@end table
@@ -2341,9 +2347,9 @@ Display a horizontal bar @var{height} pixels high.
@end table
@vindex cursor-type
-The @code{cursor-type} frame parameter may be overridden by the
-variables @code{cursor-type} and
-@code{cursor-in-non-selected-windows}:
+The @code{cursor-type} frame parameter may be overridden by
+@code{set-window-cursor-type} (@pxref{Window Point}), and by the
+variables @code{cursor-type} and @code{cursor-in-non-selected-windows}:
@defopt cursor-type
This buffer-local variable controls how the cursor looks in a selected
@@ -2823,6 +2829,18 @@ direction.
See also @code{next-window} and @code{previous-window}, in @ref{Cyclic
Window Ordering}.
+ Some Lisp programs need to find one or more frames that satisfy a
+given criteria. The function @code{filtered-frame-list} is provided for
+this purpose.
+
+@defun filtered-frame-list predicate
+This function returns the list of all the live frames which satisfy the
+specified @var{predicate}. The argument @var{predicate} must be a
+function of one argument, a frame to be tested against the filtering
+criteria, and should return non-@code{nil} if the frame satisfies the
+criteria.
+@end defun
+
@node Minibuffers and Frames
@section Minibuffers and Frames
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index ff635fc54b2..dcce4043064 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -130,7 +130,7 @@ it also encloses an environment of lexical variable
bindings.
@item byte-code function
A function that has been compiled by the byte compiler.
-@xref{Byte-Code Type}.
+@xref{Closure Type}.
@item autoload object
@cindex autoload object
@@ -227,6 +227,16 @@ Compilation}), or natively-compiled (@pxref{Native
Compilation}), or
a function loaded from a dynamic module (@pxref{Dynamic Modules}).
@end defun
+@defun interpreted-function-p object
+This function returns @code{t} if @var{object} is an interpreted function.
+@end defun
+
+@defun closurep object
+This function returns @code{t} if @var{object} is a closure, which is
+a particular kind of function object. Currently closures are used
+for all byte-code functions and all interpreted functions.
+@end defun
+
@defun subr-arity subr
This works like @code{func-arity}, but only for built-in functions and
without symbol indirection. It signals an error for non-built-in
@@ -1136,8 +1146,7 @@ Functions}). @xref{describe-symbols example}, for a
realistic example
of this.
When defining a lambda expression that is to be used as an anonymous
-function, you can in principle use any method to construct the list.
-But typically you should use the @code{lambda} macro, or the
+function, you should use the @code{lambda} macro, or the
@code{function} special form, or the @code{#'} read syntax:
@defmac lambda args [doc] [interactive] body@dots{}
@@ -1145,17 +1154,18 @@ This macro returns an anonymous function with argument
list
@var{args}, documentation string @var{doc} (if any), interactive spec
@var{interactive} (if any), and body forms given by @var{body}.
-Under dynamic binding, this macro effectively makes @code{lambda}
-forms self-quoting: evaluating a form whose @sc{car} is @code{lambda}
-yields the form itself:
+For example, this macro makes @code{lambda} forms almost self-quoting:
+evaluating a form whose @sc{car} is @code{lambda} yields a value that is
+almost like the form itself:
@example
(lambda (x) (* x x))
- @result{} (lambda (x) (* x x))
+ @result{} #f(lambda (x) :dynbind (* x x))
@end example
-Note that when evaluating under lexical binding the result is a
-closure object (@pxref{Closures}).
+When evaluating under lexical binding the result is a similar
+closure object, where the @code{:dynbind} marker is replaced by the
+captured variables (@pxref{Closures}).
The @code{lambda} form has one other effect: it tells the Emacs
evaluator and byte-compiler that its argument is a function, by using
@@ -1164,8 +1174,8 @@ evaluator and byte-compiler that its argument is a
function, by using
@defspec function function-object
@cindex function quoting
-This special form returns @var{function-object} without evaluating it.
-In this, it is similar to @code{quote} (@pxref{Quoting}). But unlike
+This special form returns the function value of the @var{function-object}.
+In many ways, it is similar to @code{quote} (@pxref{Quoting}). But unlike
@code{quote}, it also serves as a note to the Emacs evaluator and
byte-compiler that @var{function-object} is intended to be used as a
function. Assuming @var{function-object} is a valid lambda
@@ -1495,7 +1505,7 @@ distinguish between a function cell that is void and one
set to
@group
(defun bar (n) (+ n 2))
(symbol-function 'bar)
- @result{} (lambda (n) (+ n 2))
+ @result{} #f(lambda (n) [t] (+ n 2))
@end group
@group
(fset 'baz 'bar)
@@ -1608,7 +1618,7 @@ argument list and body forms as the remaining elements:
@example
;; @r{lexical binding is enabled.}
(lambda (x) (* x x))
- @result{} (closure (t) (x) (* x x))
+ @result{} #f(lambda (x) [t] (* x x))
@end example
@noindent
@@ -2699,6 +2709,67 @@ native code emitted for the function. In particular, if
@var{n} is
@minus{}1, native compilation of the function will emit bytecode
instead of native code for the function.
+@item (safety @var{n})
+Specify the value of @code{compilation-safety} in effect for this
+function. This allows function-level control of the safety level used
+for the code emitted for the function (@pxref{Native-Compilation
+Variables}).
+
+@item (ftype @var{type} &optional @var{function})
+Declare @var{type} to be the type of this function. This is used for
+documentation by @code{describe-function}. Also it can be used by the
+native compiler (@pxref{Native Compilation}) for improving code
+generation and for deriving more precisely the type of other functions
+without type declaration.
+
+@var{type} is a type specifier in the form @w{@code{(function
+(ARG-1-TYPE ... ARG-N-TYPE) RETURN-TYPE)}}. Argument types can be
+interleaved with symbols @code{&optional} and @code{&rest} to match the
+function's arguments (@pxref{Argument List}).
+
+@var{function} if present should be the name of function being defined.
+
+Here's an example of using @code{ftype} inside @code{declare} to declare
+a function @code{positive-p} that takes an argument of type @var{number}
+and return a @var{boolean}:
+
+@lisp
+@group
+(defun positive-p (x)
+ (declare (ftype (function (number) boolean)))
+ (when (> x 0)
+ t))
+@end group
+@end lisp
+
+Similarly this declares a function @code{cons-or-number} that: expects a
+first argument being a @var{cons} or a @var{number}, a second optional
+argument of type @var{string} and return one of the symbols
+@code{is-cons} or @code{is-number}:
+
+@lisp
+@group
+(defun cons-or-number (x &optional err-msg)
+ (declare (ftype (function ((or cons number) &optional string)
+ (member is-cons is-number))))
+ (if (consp x)
+ 'is-cons
+ (if (numberp x)
+ 'is-number
+ (error (or err-msg "Unexpected input")))))
+@end group
+@end lisp
+
+For description of additional types, see @ref{Lisp Data Types}).
+
+Declaring a function with an incorrect type produces undefined behavior
+and could lead to unexpected results or might even crash Emacs when
+natively-compiled code is loaded, if it was compiled with
+@code{compilation-safety} level of zero (@pxref{compilation-safety}).
+Note also that when redefining (or advising) a type-declared function,
+the replacement should respect the original signature to avoid such
+undefined behavior.
+
@item no-font-lock-keyword
This is valid for macros only. Macros with this declaration are
highlighted by font-lock (@pxref{Font Lock Mode}) as normal functions,
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 1521b3815f4..32aa98d31cb 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -480,7 +480,7 @@ following values are available:
This means all the commands in the keymap are repeatable, and is the
most common usage.
-@item (:enter (commands ...) :exit (commands ...))
+@item (:enter (commands ...) :exit (commands ...) :hints ((command . "hint")
...))
This specifies that the commands in the @code{:enter} list enter
@code{repeat-mode}, and the commands in the @code{:exit} list exit
repeat mode.
@@ -494,6 +494,10 @@ If the @code{:exit} list is empty then no commands in the
map exit
@code{repeat-mode}. Specifying one or more commands in this list is
useful if the keymap being defined contains a command that should not
have the @code{repeat-map} property.
+
+The @code{:hints} list can contain cons pairs where the @sc{car} is
+a command and the @sc{cdr} is a string that is displayed alongside of
+the repeatable key in the echo area.
@end table
In order to make e.g.@: @kbd{u} repeat the @code{undo} command, the
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 1409e51c0d4..dce9115c61b 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -143,9 +143,9 @@ This function is the opposite of @code{listp}: it returns
@code{t} if
@defun null object
This function returns @code{t} if @var{object} is @code{nil}, and
returns @code{nil} otherwise. This function is identical to @code{not},
-but as a matter of clarity we use @code{null} when @var{object} is
-considered a list and @code{not} when it is considered a truth value
-(see @code{not} in @ref{Combining Conditions}).
+but as a matter of clarity we use @code{not} when @var{object} is
+considered a truth value (see @code{not} in @ref{Combining
+Conditions}) and @code{null} otherwise.
@example
@group
@@ -317,6 +317,7 @@ For historical reasons, it takes its arguments in the
opposite order.
@xref{Sequence Functions}.
@end defun
+@findex drop
@defun nthcdr n list
This function returns the @var{n}th @sc{cdr} of @var{list}. In other
words, it skips past the first @var{n} links of @var{list} and returns
@@ -327,6 +328,8 @@ If @var{n} is zero, @code{nthcdr} returns all of
@var{list}. If the length of @var{list} is @var{n} or less,
@code{nthcdr} returns @code{nil}.
+An alias for @code{nthcdr} is @code{drop}.
+
@example
@group
(nthcdr 1 '(1 2 3 4))
@@ -350,6 +353,9 @@ it returns the part of @var{list} that @code{nthcdr} skips.
@code{take} returns @var{list} if shorter than @var{n} elements;
it returns @code{nil} if @var{n} is zero or negative.
+In general, @code{(append (take @var{n} @var{list}) (drop @var{n} @var{list}))}
+will return a list equal to @var{list}.
+
@example
@group
(take 3 '(a b c d))
@@ -1249,7 +1255,7 @@ this is not guaranteed to happen):
@group
(symbol-function 'add-foo)
- @result{} (lambda (x) (nconc '(foo) x))
+ @result{} #f(lambda (x) [t] (nconc '(foo) x))
@end group
@group
@@ -1267,7 +1273,7 @@ this is not guaranteed to happen):
@group
(symbol-function 'add-foo)
- @result{} (lambda (x) (nconc '(foo 1 2 3 4) x))
+ @result{} #f(lambda (x) [t] (nconc '(foo 1 2 3 4) x))
@end group
@end smallexample
@end defun
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index ffede9e86f5..cf67b319924 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -5185,10 +5185,12 @@ It is more convenient to use the simple indentation
engine described
below: then the major mode needs only write some indentation rules,
and the engine takes care of the rest.
-To enable the parser-based indentation engine, either set
-@code{treesit-simple-indent-rules} and call
-@code{treesit-major-mode-setup}, or equivalently, set the value of
-@code{indent-line-function} to @code{treesit-indent}.
+To enable the parser-based indentation engine, set either
+@code{treesit-simple-indent-rules} or @code{treesit-indent-function},
+then call @code{treesit-major-mode-setup}. (All that
+@code{treesit-major-mode-setup} does is set the value of
+@code{indent-line-function} to @code{treesit-indent}, and
+@code{indent-region-function} to @code{treesit-indent-region}.)
@defvar treesit-indent-function
This variable stores the actual function called by
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index aa1e073042f..ec6ab8204d6 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -244,7 +244,7 @@ latter are unique to Emacs Lisp.
* Macro Type:: A method of expanding an expression into another
expression, more fundamental but less pretty.
* Primitive Function Type:: A function written in C, callable from Lisp.
-* Byte-Code Type:: A function written in Lisp, then compiled.
+* Closure Type:: A function written in Lisp.
* Record Type:: Compound objects with programmer-defined types.
* Type Descriptors:: Objects holding information about types.
* Autoload Type:: A type used for automatically loading seldom-used
@@ -1458,18 +1458,24 @@ with the name of the subroutine.
@end group
@end example
-@node Byte-Code Type
-@subsection Byte-Code Function Type
+@node Closure Type
+@subsection Closure Function Type
-@dfn{Byte-code function objects} are produced by byte-compiling Lisp
-code (@pxref{Byte Compilation}). Internally, a byte-code function
-object is much like a vector; however, the evaluator handles this data
-type specially when it appears in a function call. @xref{Byte-Code
-Objects}.
+@dfn{Closures} are function objects produced when turning a function
+definition into a function value. Closures are used both for
+byte-compiled Lisp functions as well as for interpreted Lisp functions.
+Closures can be produced by byte-compiling Lisp code (@pxref{Byte
+Compilation}) or simply by evaluating a lambda expression without
+compiling it, resulting in an interpreted function. Internally,
+a closure is much like a vector; however, the evaluator
+handles this data type specially when it appears in a function call.
+@xref{Closure Objects}.
The printed representation and read syntax for a byte-code function
object is like that for a vector, with an additional @samp{#} before the
-opening @samp{[}.
+opening @samp{[}. When printed for human consumption, it is printed as
+a special kind of list with an additional @samp{#f} before the opening
+@samp{(}.
@node Record Type
@subsection Record Type
@@ -2030,7 +2036,7 @@ with references to further information.
@xref{Array Functions, arrayp}.
@item bignump
-@xref{Predicates on Numbers, floatp}.
+@xref{Predicates on Numbers, bignump}.
@item bool-vector-p
@xref{Bool-Vectors, bool-vector-p}.
@@ -2042,10 +2048,7 @@ with references to further information.
@xref{Buffer Basics, bufferp}.
@item byte-code-function-p
-@xref{Byte-Code Type, byte-code-function-p}.
-
-@item compiled-function-p
-@xref{Byte-Code Type, compiled-function-p}.
+@xref{Closure Type, byte-code-function-p}.
@item case-table-p
@xref{Case Tables, case-table-p}.
@@ -2056,9 +2059,15 @@ with references to further information.
@item char-table-p
@xref{Char-Tables, char-table-p}.
+@item closurep
+@xref{What Is a Function, closurep}.
+
@item commandp
@xref{Interactive Call, commandp}.
+@item compiled-function-p
+@xref{Closure Type, compiled-function-p}.
+
@item condition-variable-p
@xref{Condition Variables, condition-variable-p}.
@@ -2069,7 +2078,7 @@ with references to further information.
@xref{Variable Definitions, custom-variable-p}.
@item fixnump
-@xref{Predicates on Numbers, floatp}.
+@xref{Predicates on Numbers, fixnump}.
@item floatp
@xref{Predicates on Numbers, floatp}.
@@ -2098,6 +2107,9 @@ with references to further information.
@item integerp
@xref{Predicates on Numbers, integerp}.
+@item interpreted-function-p
+@xref{What Is a Function, interpreted-function-p}.
+
@item keymapp
@xref{Creating Keymaps, keymapp}.
diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi
index 55ba10bb41b..35ee5cc648d 100644
--- a/doc/lispref/parsing.texi
+++ b/doc/lispref/parsing.texi
@@ -4,6 +4,7 @@
@c See the file elisp.texi for copying conditions.
@node Parsing Program Source
@chapter Parsing Program Source
+@cindex parsing program source
@cindex syntax tree, from parsing program source
Emacs provides various ways to parse program source text and produce a
@@ -539,6 +540,26 @@ symbol, rather than a lambda function.
This function returns the list of @var{parser}'s notifier functions.
@end defun
+Sometimes a Lisp program might need to synchronously get the changed
+ranges of the last reparse. The function
+@code{treesit-parser-changed-ranges} exists for this purpose. It
+returns the ranges which were passed to the notifier functions.
+
+@defun treesit-parser-changed-ranges parser &optional quiet
+This function returns the ranges that has been changed since last
+reparse. It returns a list of cons cells of the form
+@w{@code{(@var{start} . @var{end})}}, where @var{start} and @var{end}
+mark the start and the end positions of a range.
+
+This function should almost always be called immediately after
+reparsing. If it's called when there are new buffer edits that hasn't
+been reparsed, Emacs signals the @code{treesit-unparsed-edits} error,
+unless the optional argument @var{quiet} is non-nil.
+
+Calling this function multiple times consecutively doesn't change its
+return value; it always returns the ranges affected by the last reparse.
+@end defun
+
@node Retrieving Nodes
@section Retrieving Nodes
@cindex retrieve node, tree-sitter
@@ -753,7 +774,7 @@ symbol or thing definition (@pxref{User-defined Things}).
Using an
undefined thing doesn't raise an error, the function simply returns
@code{nil}.
-This function returns the first node that matches, or @code{nil} if node
+This function returns the first node that matches, or @code{nil} if none
matches @var{predicate}.
By default, this function only traverses named nodes, but if @var{all}
@@ -1662,11 +1683,11 @@ thing, @code{treesit-end-of-thing} moves to the end of
a thing, and
@code{treesit-thing-at-point} returns the thing at point.
There are also defun commands that specifically use the @code{defun}
-definition, like @code{treesit-beginning-of-defun},
-@code{treesit-end-of-defun}, and @code{treesit-defun-at-point}. In
-addition, these functions use @var{treesit-defun-tactic} as the
-navigation tactic. They are described in more detail in other sections
-(@pxref{Tree-sitter Major Modes}).
+definition (as a fallback of @var{treesit-defun-type-regexp}), like
+@code{treesit-beginning-of-defun}, @code{treesit-end-of-defun}, and
+@code{treesit-defun-at-point}. In addition, these functions use
+@var{treesit-defun-tactic} as the navigation tactic. They are described
+in more detail in other sections (@pxref{Tree-sitter Major Modes}).
@node Multiple Languages
@section Parsing Text in Multiple Languages
@@ -1873,12 +1894,30 @@ directly translate into operations shown above.
:host 'html
'((script_element (raw_text) @@capture))
@end group
-
@group
:embed 'css
:host 'html
'((style_element (raw_text) @@capture))))
@end group
+
+@group
+;; Major modes with multiple languages should always set
+;; `treesit-language-at-point-function' (which see).
+(setq treesit-language-at-point-function
+ (lambda (pos)
+ (let* ((node (treesit-node-at pos 'html))
+ (parent (treesit-node-parent node)))
+ (cond
+ ((and node parent
+ (equal (treesit-node-type node) "raw_text")
+ (equal (treesit-node-type parent) "script_element"))
+ 'javascript)
+ ((and node parent
+ (equal (treesit-node-type node) "raw_text")
+ (equal (treesit-node-type parent) "style_element"))
+ 'css)
+ (t 'html)))))
+@end group
@end example
@defun treesit-range-rules &rest query-specs
@@ -2042,8 +2081,9 @@ If @code{treesit-font-lock-settings} (@pxref{Parser-based
Font Lock})
is non-@code{nil}, it sets up fontification.
@item
-If @code{treesit-simple-indent-rules} (@pxref{Parser-based Indentation})
-is non-@code{nil}, it sets up indentation.
+If either @code{treesit-simple-indent-rules} or
+@code{treesit-indent-function} (@pxref{Parser-based Indentation}) is
+non-@code{nil}, it sets up indentation.
@item
If @code{treesit-defun-type-regexp} is non-@code{nil}, it sets up
diff --git a/doc/lispref/peg.texi b/doc/lispref/peg.texi
index 72a7cacac20..b85d0de048d 100644
--- a/doc/lispref/peg.texi
+++ b/doc/lispref/peg.texi
@@ -78,12 +78,13 @@ of a larger grammar.
At the end of parsing, one of @var{failure-function} or
@var{success-function} is called, depending on whether the parsing
-succeeded or not. If @var{success-function} is called, it is passed a
-lambda form that runs all the actions collected on the stack during
-parsing -- by default this lambda form is simply executed. If parsing
-fails, the @var{failure-function} is called with a list of @acronym{PEG}
-expressions that failed during parsing; by default this list is
-discarded.
+succeeded or not. If @var{success-function} is provided, it should be a
+function that receives as its only argument an anonymous function that
+runs all the actions collected on the stack during parsing. By default
+this anonymous function is simply executed. If parsing fails, a
+function provided as @var{failure-function} will be called with a list
+of @acronym{PEG} expressions that failed during parsing. By default
+this list is discarded.
@end defun
The @var{peg-matcher} passed to @code{peg-run} is produced by a call to
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index c356c905dee..c5fbb0fb818 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -616,11 +616,24 @@ is similar than @code{call-process-region}, with process
being a shell.
The arguments @code{delete}, @code{destination} and the return value
are like in @code{call-process-region}.
Note that this function doesn't accept additional arguments.
+
+If @var{command} names a shell (e.g., via @code{shell-file-name}), keep
+in mind that behavior of various shells when commands are piped to their
+standard input is shell- and system-dependent, and thus non-portable.
+The differences are especially prominent when the region includes more
+than one line, i.e.@: when piping to a shell commands with embedded
+newlines. Lisp programs using this technique will therefore need to
+format the text in the region differently, according to the expectations
+of the shell.
@end defun
@defun shell-command-to-string command
This function executes @var{command} (a string) as a shell command,
-then returns the command's output as a string.
+then returns the command's output as a string. If @var{command}
+actually includes more than one command, the behavior depends on the
+shell to be invoked (determined by @code{shell-file-name} for local
+commands). In particular, the separator between the commands cannot be
+a newline on MS-Windows; use @samp{&&} instead.
@end defun
@c There is also shell-command-on-region, but that is more of a user
@@ -944,6 +957,7 @@ example the function @code{ange-ftp-hook-function}). In
such cases,
this function does nothing and returns @code{nil}.
@end defun
+@vindex shell-file-name
@defun start-process-shell-command name buffer-or-name command
This function is like @code{start-process}, except that it uses a
shell to execute the specified @var{command}. The argument
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index c9e47624878..4c5525f10c5 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -1583,7 +1583,7 @@ nonempty vector that is not @code{eq} to any existing
vector.
The @code{vconcat} function also allows byte-code function objects as
arguments. This is a special feature to make it easy to access the entire
-contents of a byte-code function object. @xref{Byte-Code Objects}.
+contents of a byte-code function object. @xref{Closure Objects}.
For other concatenation functions, see @code{mapconcat} in @ref{Mapping
Functions}, @code{concat} in @ref{Creating Strings}, and @code{append}
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 7f640255a7a..6e5c3521135 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -473,28 +473,12 @@ needed, but we recommend to always make sure @var{string}
is multibyte
Representations}), if @var{char} is a non-@acronym{ASCII} character, not
a raw byte.
- A more powerful function is @code{store-substring}:
-
-@defun store-substring string idx obj
-This function alters part of the contents of the specified @var{string},
-by storing @var{obj} starting at character index @var{idx}. The
-argument @var{obj} may be either a character (in which case the function
-behaves exactly as @code{aset}) or a (smaller) string. If @var{obj}
-is a multibyte string, we recommend to make sure @var{string} is also
-multibyte, even if it's pure-@acronym{ASCII}.
-
-Since it is impossible to change the number of characters in an
-existing string, it is an error if @var{obj} consists of more
-characters than would fit in @var{string} starting at character index
-@var{idx}.
-@end defun
-
To clear out a string that contained a password, use
@code{clear-string}:
@defun clear-string string
This makes @var{string} a unibyte string and clears its contents to
-zeros. It may also change @var{string}'s length.
+null characters. It may also change @var{string}'s length.
@end defun
@need 2000
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 4d61d461deb..e05d3bb0f81 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -1079,7 +1079,7 @@ Here is an example:
(let ((x 0)) ; @r{@code{x} is lexically bound.}
(setq my-ticker (lambda ()
(setq x (1+ x)))))
- @result{} (closure ((x . 0)) ()
+ @result{} #f(lambda () [(x 0)]
(setq x (1+ x)))
(funcall my-ticker)
@@ -1523,7 +1523,7 @@ buffer-local binding of buffer @samp{b}.
values when you visit the file. @xref{File Variables,,, emacs, The
GNU Emacs Manual}.
- A buffer-local variable cannot be made terminal-local
+ A terminal-local variable cannot be made buffer-local
(@pxref{Multiple Terminals}).
@node Creating Buffer-Local
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index 104420235df..61e72eae680 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -2809,7 +2809,7 @@ Windows}).
@defun display-buffer-use-least-recent-window buffer alist
This function is similar to @code{display-buffer-use-some-window}, but
-will try harder to not use the a recently used window. In particular,
+will try harder to not use a recently used window. In particular,
it does not use the selected window. In addition, it will first try to
reuse a window that shows @var{buffer} already, base the decision
whether it should use a window showing another buffer on that window's
@@ -5142,6 +5142,24 @@ Insertion Types}) of @code{window-point}. The default
is @code{nil},
so @code{window-point} will stay behind text inserted there.
@end defvar
+@defun set-window-cursor-type window type
+This function sets the cursor shape for @var{window}. This setting
+takes precedence over the @code{cursor-type} variable, and @var{type}
+has the same format as the value of that variable. @xref{Cursor
+Parameters}. If @var{window} is @code{nil}, it means to set the cursor
+type for the selected window.
+
+The initial value for new windows is @code{t}, which says to respect the
+buffer-local value of @code{cursor-type}. The value set by this
+function persists across buffers shown in @var{window}, so
+@code{set-window-buffer} does not reset it. @xref{Buffers and Windows}.
+@end defun
+
+@defun window-cursor-type &optional window
+This function returns the cursor type of @var{window}, defaulting to the
+selected window.
+@end defun
+
@node Window Start and End
@section The Window Start and End Positions
@cindex window start position
diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi
index f51a1446170..8d802be535c 100644
--- a/doc/misc/auth.texi
+++ b/doc/misc/auth.texi
@@ -527,7 +527,7 @@ while searching for an entry matching the @code{rms} user
on host
@code{gnu.org} and port @code{22}, then the entry
@file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}.
However, such processing is not applied when the option
-@code{auth-source-pass-extra-parameters} is set to @code{t}.
+@code{auth-source-pass-extra-query-keywords} is set to @code{t}.
Users of @code{pass} may also be interested in functionality provided
by other Emacs packages:
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index ac2ac5a0f91..bcedee8a946 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -31468,6 +31468,7 @@ newline so that mode annotations will appear on lines
by themselves.
@node Programming
@chapter Programming
+@cindex Programming Calc
@noindent
There are several ways to ``program'' the Emacs Calculator, depending
on the nature of the problem you need to solve.
@@ -31596,7 +31597,7 @@ following sections.
@noindent
@kindex X
-@cindex Programming with keyboard macros
+@cindex Programming Calc, with keyboard macros
@cindex Keyboard macros
The easiest way to ``program'' the Emacs Calculator is to use standard
keyboard macros. Press @w{@kbd{C-x (}} to begin recording a macro. From
@@ -31997,7 +31998,7 @@ The @kbd{m m} command saves the last invocation macro
defined by
@noindent
@kindex Z F
@pindex calc-user-define-formula
-@cindex Programming with algebraic formulas
+@cindex Programming Calc, with algebraic formulas
Another way to create a new Calculator command uses algebraic formulas.
The @kbd{Z F} (@code{calc-user-define-formula}) command stores the
formula at the top of the stack as the definition for a key. This
@@ -32106,6 +32107,7 @@ in symbolic form without ever activating the
@code{deriv} function. Press
@node Lisp Definitions
@section Programming with Lisp
+@section Programming Calc, with Lisp
@noindent
The Calculator can be programmed quite extensively in Lisp. All you
do is write a normal Lisp function definition, but with @code{defmath}
@@ -32499,9 +32501,9 @@ decreases the precision.
(put 'calc-define 'inc-prec '(progn
(define-key calc-mode-map (format "Y%sI" inc-prec-base-key)
- 'increase-precision)
+ 'calc-increase-precision)
(define-key calc-mode-map (format "Y%sD" inc-prec-base-key)
- 'decrease-precision)
+ 'calc-decrease-precision)
(setq calc-Y-help-msgs
(cons (format "%s + Inc-prec, Dec-prec" inc-prec-base-key)
@@ -32851,6 +32853,7 @@ a large argument, a simpler program like the first one
shown is fine.
@node Calling Calc from Your Programs
@subsection Calling Calc from Your Lisp Programs
+@cindex Calling Calc from Lisp
@noindent
A later section (@pxref{Internals}) gives a full description of
Calc's internal Lisp functions. It's not hard to call Calc from
diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi
index 15f7a329803..ae179832753 100644
--- a/doc/misc/ede.texi
+++ b/doc/misc/ede.texi
@@ -1027,13 +1027,13 @@ superclasses, specifically the PROJECT and TARGET@.
All commands in
target.
All specific projects in @ede{} derive subclasses of the @ede{}
-superclasses. In this way, specific behaviors such as how a project
-is saved, or how a target is compiled can be customized by a project
-author in detail. @ede{} communicates to these project objects via an
-API using methods. The commands you use in @ede{} mode are high-level
+superclasses. In this way, specific behaviors such as how a project is
+saved, or how a target is compiled can be customized by a project author
+in detail. @ede{} communicates to these project objects via an API
+using methods. The commands you use in @ede{} mode are high-level
functional wrappers over these methods. @xref{Top,,, eieio, EIEIO
-manual} for details on using @eieio{} to extending classes, and
-writing methods.
+manual}, for details on using @eieio{} to extending classes, and writing
+methods.
If you intend to extend @ede{}, it is most likely that a new target type is
needed in one of the existing project types. The rest of this chapter
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index 96a6328cd47..ef7ea614f8b 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -787,6 +787,10 @@ Parameters for @samp{sign=smime}:
@item keyfile
File containing key and certificate for signer.
+@item chainfile
+File containing an additional certificate to be included with the
+message.
+
@end table
Parameters for @samp{encrypt=smime}:
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index c7ab7e7bf21..0c7e3b09f41 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -2123,11 +2123,20 @@ to IRC, and don't forget that you can roll back to the
previous
version by running @kbd{M-x package-delete @key{RET}}.
@xref{Packages,,,emacs, The Emacs Editor}, for more information.
+Note that a bug affecting Emacs' packaging machinery may prevent the
+above method from working on Emacs versions 29 and below. Users on 29
+can try running @kbd{C-u M-x package-install @key{RET}} instead.
+Users on 28 and below can click on the @emph{installed} @samp{erc}
+line item in the @file{*Packages*} buffer instead of the newest one,
+and then, in the resulting @code{help-mode} buffer, find and activate
+the button for the newest version, which should appear in the summary
+item @samp{Other versions}.
+
In the rare instance you need an emergency fix or have volunteered to
test an edge feature between ERC releases, you can try adding
@samp{("devel" . "https://elpa.gnu.org/devel/";)} to
@code{package-archives} prior to performing the steps above. For
-this, you'll want to instead select a ``snapshot'' version from the
+this, you'll want to instead select a @dfn{snapshot} version from the
menu. Please be aware that when going this route, the latest changes
may not yet be available and you run the risk of incurring other bugs
and encountering unstable features.
diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
index 8767de71496..cecde5f3232 100644
--- a/doc/misc/ert.texi
+++ b/doc/misc/ert.texi
@@ -786,7 +786,6 @@ Here's a more complicated test:
@end lisp
@findex make-ert-test
-@findex ert-equal-including-properties
This test creates a test object using @code{make-ert-test} whose body
will immediately signal failure. It then runs that test and asserts
that it fails. Then, it creates a temporary buffer and invokes
@@ -795,7 +794,7 @@ to the current buffer. Finally, it extracts the first line
from the
buffer and asserts that it matches what we expect. It uses
@code{buffer-substring-no-properties} and @code{equal} to ignore text
properties; for a test that takes properties into account,
-@code{buffer-substring} and @code{ert-equal-including-properties}
+@code{buffer-substring} and @code{equal-including-properties}
could be used instead.
The reason why this test only checks the first line of the backtrace
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index 30c85da795b..57ee3bf3e9f 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -782,6 +782,14 @@ the buffer is merely buried instead.
Set environment variables using input like Bash's @command{export}, as
in @samp{export @var{var1}=@var{val1} @var{var2}=@var{val2} @dots{}}.
+@cmindex funcall
+@item funcall @var{function} [@var{arg}]@dots{}
+Call @var{function} with the specified arguments (@var{function} may be
+a symbol or a string naming a Lisp function). This command is useful
+when you want to call an ordinary Lisp function using Eshell's command
+form (@pxref{Invocation}), even if there may be an external program of
+the same name.
+
@cmindex grep
@item grep [@var{arg}]@dots{}
@cmindex agrep
@@ -1535,13 +1543,18 @@ slash module (@pxref{Electric forward slash}).
When running commands, you can also make them explicitly remote by
prefixing the command name with a remote identifier, e.g.@:
@samp{/ssh:user@@remote:whoami}. This runs the command @code{whoami}
-over the SSH connection for @code{user@@remote}, no matter your
-current directory. If you want to explicitly run a @emph{local}
-command even when in a remote directory, you can prefix the command
-name with @kbd{/:}, like @samp{/:whoami}. In either case, you can
+over the SSH connection for @code{user@@remote}, no matter your current
+directory. If you want to explicitly run a command on your @emph{local}
+machine even when in a remote directory, you can prefix the command name
+with @kbd{/local:}, like @samp{/local:whoami}. In either case, you can
also specify the absolute path to the program, e.g.@:
-@samp{/ssh:user@@remote:/usr/bin/whoami}. To disable this syntax, set
-the option @code{eshell-explicit-remote-commands} to @code{nil}.
+@samp{/ssh:user@@remote:/usr/bin/whoami}. If you need to refer to a
+program whose file name would be interpreted as an explicitly-remote
+command, you can use @kbd{/:} to quote the name, e.g.@:
+@samp{/:/ssh:user@@remote:whoami} (@pxref{Quoted File Names,,, emacs,
+The GNU Emacs Manual}). To disable explicity-remote commands entirely,
+you can set the option @code{eshell-explicit-remote-commands} to
+@code{nil}.
@node History
@section History
diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi
index 84a74a9d6ab..6b605a6c095 100644
--- a/doc/misc/flymake.texi
+++ b/doc/misc/flymake.texi
@@ -59,11 +59,10 @@ types of diagnostics.
To learn about using Flymake, @pxref{Using Flymake}.
-When the Emacs LSP support mode Eglot is enabled, Flymake will use
-that as an additional back-end. @xref{Eglot Features,,, eglot, Eglot:
-The Emacs LSP Client} Flymake is also designed to be easily extended
-to support new backends via an Elisp interface. @xref{Extending
-Flymake}.
+When the Emacs LSP support mode Eglot is enabled, Flymake will use that
+as an additional back-end. @xref{Eglot Features,,, eglot, Eglot: The
+Emacs LSP Client}. Flymake is also designed to be easily extended to
+support new backends via an Elisp interface. @xref{Extending Flymake}.
@ifnottex
@insertcopying
@@ -94,7 +93,7 @@ write your own Flymake backend functions. @xref{Backend
functions}.
When the Emacs LSP support mode Eglot is enabled, Flymake will use
that as an additional back-end automatically. @xref{Eglot Features,,,
-eglot, Eglot: The Emacs LSP Client}
+eglot, Eglot: The Emacs LSP Client}.
@menu
* Starting Flymake::
@@ -309,6 +308,12 @@ reported.
A custom face for highlighting regions for which a note has been
reported.
+@item flymake-indicator-type
+The indicator type which Flymake should use to indicate lines with
+errors or warnings.
+Depending on your preference, this can either use @code{fringes} or
+@code{margins} for indicating errors.
+
@item flymake-error-bitmap
A bitmap used in the fringe to mark lines for which an error has
been reported.
@@ -320,6 +325,18 @@ been reported.
@item flymake-fringe-indicator-position
Which fringe (if any) should show the warning/error bitmaps.
+@item flymake-margin-indicators-string
+Specifies the string and face to use for the margin indicators, for
+each error type.
+
+@item flymake-margin-indicator-position
+Which margin (if any) should show the warning/error strings.
+
+@item flymake-autoresize-margins
+If non-@code{nil}, Flymake will resize the margins when
+@code{flymake-mode} is turned on or off.
+Only relevant if @code{flymake-indicator-type} is set to @code{margins}.
+
@item flymake-wrap-around
If non-@code{nil}, moving to errors with @code{flymake-goto-next-error} and
@code{flymake-goto-prev-error} wraps around buffer boundaries.
@@ -387,6 +404,14 @@ the syntax of @code{flymake-error-bitmap}
(@pxref{Customizable
variables}). It is overridden by any @code{before-string} overlay
property.
+@item
+@cindex margin of diagnostic
+@code{flymake-margin-string}, a string displayed in the margin
+according to @code{flymake-margin-indicator-position}.
+The value actually follows the syntax of
@code{flymake-margin-indicators-string}
+(@pxref{Customizable variables}). It is overridden by any
+@code{before-string} overlay property.
+
@item
@code{flymake-overlay-control}, an alist ((@var{OVPROP} . @var{VALUE})
@var{...}) of further properties used to affect the appearance of
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 419a5390374..c5e4c885ccf 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -715,6 +715,7 @@ Browsing the Web
* Web Searches:: Creating groups from articles that match a
string.
* RSS:: Reading RDF site summary.
+* Atom:: Reading Atom Syndication Format feeds.
Other Sources
@@ -975,6 +976,7 @@ Back End Interface
* Writing New Back Ends:: Extending old back ends.
* Hooking New Back Ends Into Gnus:: What has to be done on the Gnus end.
* Mail-like Back Ends:: Some tips on mail back ends.
+* Web Feed Back Ends:: Easily defining back ends for web feeds.
Various File Formats
@@ -7421,6 +7423,22 @@ meaningful. Here's one example:
header))))
@end lisp
+And another example: the protonmail bridge adds fake message-ids to
+@code{References} in message headers, which can confuse threading. To
+remove these spurious ids
+
+@lisp
+(setq gnus-alter-header-function 'fix-protonmail-references)
+
+(defun fix-protonmail-references (header)
+ (setf (mail-header-references header)
+ (mapconcat
+ #'(lambda (x) (if (string-search "protonmail.internalid" x) "" x))
+ (gnus-split-references (mail-header-references header)) " "))
+ header)
+
+ @end lisp
+
@end table
@@ -17252,6 +17270,7 @@ interfaces to these sources.
@menu
* Web Searches:: Creating groups from articles that match a
string.
* RSS:: Reading RDF site summary.
+* Atom:: Reading Atom Syndication Format feeds.
@end menu
The main caveat with all these web sources is that they probably won't
@@ -17496,6 +17515,42 @@ Parameters}) in order to display @samp{text/html}
parts only in
@end lisp
+@node Atom
+@subsection Atom
+@cindex nnatom
+@cindex Atom
+
+Some web sites provide an Atom Syndication Format feed. Atom is a web
+feed format similar in function to RDF Site Summary (@pxref{RSS}).
+
+The @code{nnatom} back end allows you to add HTTP or local Atom feeds as
+Gnus servers, by adding them to @code{gnus-secondary-select-methods} or
+as foreign servers by pressing "B" in the @file{*Group*} buffer, for
+example (@pxref{Finding the News}). The address of each server is its
+feed's location (though the address shouldn't be prefixed with <http://> or
+<https://>) and each server contains a single group which holds the
+feed's entries.
+
+Features of @code{nnatom} include:
+
+@itemize @bullet
+
+@item
+Server data is saved per-server in the @file{atom} sub-directory of
+@file{gnus-directory}.
+
+@item
+An article part is generated for both the summary and the content for
+each entry in the feed. Content of all MIME types should be displayed
+correctly through Gnus (as long as they are supported and the feed
+specifies a MIME type).
+
+@item
+Article modification and publish dates are tracked, and articles are
+updated if changed.
+
+@end itemize
+
@node Other Sources
@section Other Sources
@@ -29997,6 +30052,7 @@ In the examples and definitions I will refer to the
imaginary back end
* Writing New Back Ends:: Extending old back ends.
* Hooking New Back Ends Into Gnus:: What has to be done on the Gnus end.
* Mail-like Back Ends:: Some tips on mail back ends.
+* Web Feed Back Ends:: Easily defining back ends for web feeds.
@end menu
@@ -30770,6 +30826,43 @@ this:
@end example
+@node Web Feed Back Ends
+@subsubsection Web Feed Back Ends
+
+If you want to write a back end for a new type of web feed (RSS,
+Atom), or some other type of feed, an ``abstract'' back end
+(@code{nnfeed}) exists to enable the creation of such back ends with
+minimal knowledge of Gnus.
+
+@code{nnfeed} defines a generic parser, which uses functions stored in
+server variables to parse information from a feed (@code{nnfeed}
+itself doesn't actually define any such functions though).
+
+The data parsed from the feed is stored in server variables (and
+stored per-feed in a sub-directory of @option{gnus-directory} whose name
+corresponds to the name of the back end).
+
+A Gnus back end interface is also defined, which uses the data parsed
+from the feed.
+
+Therefore, a new back end only needs to inherit from @code{nnfeed},
+define (fairly) generic parsing functions for the feed type and setup
+the required server variables.
+
+@code{nnfeed} was originally created to support Atom Syndication
+Format feeds (@pxref{Atom}), but is very generic (as of writing this,
+no standard web feed exists which can meaningfully use all the
+features supported): it supports multiple groups contained in a single
+feed, it allows for situations when the entire feed can't (or
+shouldn't) be read ahead of time and it allows for very advanced
+customization of the actual printing of articles from parsed data
+(while providing a reasonably powerful default method).
+
+Further implementation details are available in the documentation
+strings of the various @code{nnfeed-*} server variables and
+the commentary and other comments of @file{nnfeed.el}.
+
+
@node Score File Syntax
@subsection Score File Syntax
diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi
index 5adc616e798..623e10e095f 100644
--- a/doc/misc/reftex.texi
+++ b/doc/misc/reftex.texi
@@ -4507,7 +4507,7 @@ In order to configure this variable, you can either set
@code{reftex-cite-format} directly yourself or set it to the
@emph{symbol} of one of the predefined styles. The predefined symbols
are those which have an association in the constant
-@code{reftex-cite-format-builtin}) E.g.: @code{(setq reftex-cite-format
+@code{reftex-cite-format-builtin}, e.g.: @code{(setq reftex-cite-format
'natbib)}.
@end defopt
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 131a23b7423..ca6703998c4 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -119,6 +119,7 @@ Installing @value{tramp} with your Emacs
Configuring @value{tramp} for use
+* Optional methods:: Optional methods which must be enabled first.
* Connection types:: Types of connections to remote hosts.
* Inline methods:: Inline methods.
* External methods:: External methods.
@@ -453,7 +454,7 @@ optional, in case of a missing part a default value is
assumed. The
default value for an empty local file name part is the remote user's
home directory. The shortest remote file name is thus
@file{@trampfn{-,,}}. The @samp{-} notation for the default method is
-used for syntactical reasons, @ref{Default Method}.
+used for syntactical reasons, @pxref{Default Method}.
The @code{method} part describes the connection method used to reach
the remote host, see below.
@@ -464,7 +465,7 @@ which case it is written as @code{user%domain}.
The @code{host} part must be a host name which can be resolved on
your local host. It could be a short host name, a fully qualified
-domain name, an IPv4 or IPv6 address, @ref{File name syntax}. Some
+domain name, an IPv4 or IPv6 address, @pxref{File name syntax}. Some
connection methods also support a notation for the port to be used, in
which case it is written as @code{host#port}.
@@ -488,14 +489,16 @@ an @command{ssh} server:
@file{@trampfn{plink,user@@host,/path/to/file}}.
-@anchor{Quick Start Guide su, sudo, doas, androidsu and sg methods}
-@section Using @option{su}, @option{sudo}, @option{doas}, @option{androidsu}
and @option{sg}
+@anchor{Quick Start Guide su, sudo, doas, run0, androidsu and sg methods}
+@section Using @option{su}, @option{sudo}, @option{doas}, @option{run0},
@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{run0}
+@cindex @option{run0} method
@cindex method @option{androidsu}
@cindex @option{androidsu} method
@cindex method @option{sg}
@@ -503,9 +506,11 @@ an @command{ssh} server:
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. If your local system is
-Android, use the method @option{androidsu} instead of @option{su}.
+connection method. If your system is @code{systemd}-based, there is
+the @option{run0} connection method. On OpenBSD systems, the
+@option{doas} connection 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
@@ -515,8 +520,8 @@ 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.
-@anchor{Quick Start Guide Combining ssh, plink, su, sudo and doas methods}
-@section Combining @option{ssh} or @option{plink} with @option{su},
@option{sudo} or @option{doas}
+@anchor{Quick Start Guide Combining ssh, plink, su, sudo, doas and run0
methods}
+@section Combining @option{ssh} or @option{plink} with @option{su},
@option{sudo}, @option{doas} or @option{run0}
@cindex method @option{ssh}
@cindex @option{ssh} method
@cindex method @option{plink}
@@ -527,13 +532,15 @@ is used as the group to change to. The default host name
is the same.
@cindex @option{sudo} method
@cindex method @option{doas}
@cindex @option{doas} method
-
-If the @option{su}, @option{sudo} or @option{doas} option should be
-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
-a simple case, the syntax looks like
+@cindex method @option{run0}
+@cindex @option{run0} method
+
+If the @option{su}, @option{sudo}, @option{doas} or @option{run0}
+method should be performed on another host, it can be combined with a
+leading @option{ssh} or @option{plink} method. 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 a simple case, the syntax looks like
@file{@trampfn{ssh@value{postfixhop}user@@host|sudo,,/path/to/file}}.
@xref{Ad-hoc multi-hops}.
@@ -685,6 +692,7 @@ to non-@code{nil}, @xref{Directory Variables, , , emacs}.
@menu
+* Optional methods:: Optional methods which must be enabled first.
* Connection types:: Types of connections to remote hosts.
* Inline methods:: Inline methods.
* External methods:: External methods.
@@ -718,6 +726,30 @@ on the remote host.
@end menu
+@node Optional methods
+@section Optional methods which must be enabled first
+@cindex optional methods
+
+Not all methods are enabled by default after loading @value{tramp}.
+Some of them don't work on the local host. Some of them are optional,
+and must be enabled if it is intended to use them. For all methods
+described in this manual, it is indicated when the method is optional.
+
+@deffn Command tramp-enable-method method
+This command enables the optional method @var{method}, a string. The
+command can be invoked interactively like @kbd{M-x tramp-enable-method
+@key{RET} toolbox @key{RET}}, with @option{toolbox} being an optional
+method.
+@end deffn
+
+If you want to enable an optional method permanently, add something
+like this to your @file{.emacs} file:
+
+@lisp
+(with-eval-after-load 'tramp (tramp-enable-method "toolbox"))
+@end lisp
+
+
@node Connection types
@section Types of connections to remote hosts
@cindex connection types, overview
@@ -770,7 +802,7 @@ files between different @emph{user identities} on the same
host.
usability of one of the commands defined in
@code{tramp-remote-coding-commands}. @value{tramp} uses the first
reliable command it finds. @value{tramp}'s search path can be
-customized, see @ref{Remote programs}.
+customized, @pxref{Remote programs}.
In case none of the commands are available, @value{tramp} first
transfers a small Perl program to the remote host, and then tries to
@@ -834,6 +866,9 @@ equivalent @option{androidsu} method is provided for that
system with
workarounds for its many idiosyncrasies, with the exception that
multi-hops are unsupported.
+This is an optional method, @pxref{Optional methods}. It is enabled by
+default on @code{android} systems only.
+
@item @option{sudo}
@cindex method @option{sudo}
@cindex @option{sudo} method
@@ -842,8 +877,8 @@ Similar to @option{su} method, @option{sudo} uses
@command{sudo}.
@command{sudo} must have sufficient rights to start a shell.
For security reasons, a @option{sudo} connection is disabled after a
-predefined timeout (5 minutes by default). This can be changed, see
-@ref{Predefined connection information}.
+predefined timeout (5 minutes by default). This can be changed,
+@pxref{Predefined connection information}.
@item @option{doas}
@cindex method @option{doas}
@@ -853,6 +888,16 @@ This method is used on OpenBSD like the @command{sudo}
command. Like
the @option{sudo} method, a @option{doas} connection is disabled after
a predefined timeout.
+@item @option{run0}
+@cindex method @option{run0}
+@cindex @option{run0} method
+
+This method is used on @code{systemd}-based hosts. Internally, it
+uses the @code{systemd-run} command. A @option{run0} connection is
+disabled after a predefined timeout as well.
+
+This is an optional method, @pxref{Optional methods}.
+
@item @option{sg}
@cindex method @option{sg}
@cindex @option{sg} method
@@ -894,12 +939,15 @@ missing shell prompts that confuses @value{tramp}.
This method is also similar to @option{ssh}. It uses the
@command{krlogin -x} command only for remote host login.
+This method is an optional method, @pxref{Optional methods}.
+
@item @option{ksu}
@cindex method @option{ksu}
@cindex @option{ksu} method
@cindex kerberos (with @option{ksu} method)
-This is another method from the Kerberos suite. It behaves like @option{su}.
+This is another method from the Kerberos suite. It behaves like
+@option{su}. It is an optional method, @pxref{Optional methods}.
@item @option{plink}
@cindex method @option{plink}
@@ -925,7 +973,12 @@ supports changing the remote login shell @command{/bin/sh}.
Check the @samp{Share SSH connections if possible} control for that
session.
+@end table
+
+@noindent
+The following methods allow to access containers in different ways:
+@table @asis
@item @option{docker}
@cindex method @option{docker}
@cindex @option{docker} method
@@ -960,7 +1013,8 @@ a container's name or ID, as returned by @samp{toolbox
list -c}.
Without a host name, the default Toolbox container for the host will
be used.
-This method does not support user names.
+This is an optional method, @pxref{Optional methods}. It does not
+support user names.
@item @option{flatpak}
@cindex method @option{flatpak}
@@ -970,8 +1024,27 @@ Integration of Flatpak sandboxes. The host name may be
either an
application ID, a sandbox instance ID, or a PID, as returned by
@samp{flatpak ps}.
-This method does not support user names.
+This is an optional method, @pxref{Optional methods}. It does not
+support user names.
+
+@item @option{apptainer}
+@cindex method @option{apptainer}
+@cindex @option{apptainer} method
+
+Integration of Apptainer instances. The host name is the instance
+name, as returned by @samp{apptainer instance list}.
+
+This is an optional method, @pxref{Optional methods}. It does not
+support user names.
+
+@item @option{nspawn}
+@cindex method @option{nspawn}
+@cindex @option{nspawn} method
+
+Integration of @code{systemd-nspawn} instances. The host name is the
+instance name, as returned by @samp{machinectl list --all}.
+This is an optional method, @pxref{Optional methods}.
@end table
@@ -1110,6 +1183,8 @@ The command used for this connection is: @samp{fsh
@var{host} -l
not useful for @value{tramp}. @command{fsh} connects to remote host
and @value{tramp} keeps that one connection open.
+This is an optional method, @pxref{Optional methods}.
+
@item @option{nc}
@cindex method @option{nc}
@cindex @option{nc} method
@@ -1121,6 +1196,8 @@ NAS hosts. These dumb devices have severely restricted
local shells,
such as the @command{busybox} and do not host any other encode or
decode programs.
+This is an optional method, @pxref{Optional methods}.
+
@item @option{sudoedit}
@cindex method @option{sudoedit}
@cindex @option{sudoedit} method
@@ -1192,9 +1269,9 @@ domain name). An example:
@trampfn{smb,daniel%BIZARRE@@melancholia,/daniel$$/.emacs}
@end example
-where user @code{daniel} connects as a domain user to the SMB host
-@code{melancholia} in the MS Windows domain @code{BIZARRE} to edit
-@file{.emacs} located in the home directory (share @code{daniel$}).
+where user @samp{daniel} connects as a domain user to the SMB host
+@samp{melancholia} in the MS Windows domain @samp{BIZARRE} to edit
+@file{.emacs} located in the home directory (share @samp{daniel$}).
Alternatively, for local WINS users (as opposed to domain users),
substitute the domain name with the name of the local host in
@@ -1204,9 +1281,9 @@ UPPERCASE as shown here:
@trampfn{smb,daniel%MELANCHOLIA@@melancholia,/daniel$$/.emacs}
@end example
-where user @code{daniel} connects as local user to the SMB host
-@code{melancholia} in the local domain @code{MELANCHOLIA} to edit
-@file{.emacs} located in the home directory (share @code{daniel$}).
+where user @samp{daniel} connects as local user to the SMB host
+@samp{melancholia} in the local domain @samp{MELANCHOLIA} to edit
+@file{.emacs} located in the home directory (share @samp{daniel$}).
The domain name and user name are optional for @command{smbclient}
authentication. When user name is not specified, @command{smbclient}
@@ -1337,7 +1414,7 @@ Media devices, like cell phones, tablets, cameras, can be
accessed via
the @option{mtp} method. Just the device name is needed in order to
specify the host in the file name. However, the device must already
be connected via USB, before accessing it. Possible device names are
-visible via host name completion, @ref{File name completion}.
+visible via host name completion, @pxref{File name completion}.
Depending on the device type, the access could be read-only. Some
devices are accessible under different names in parallel, offering
@@ -1474,7 +1551,7 @@ properties, @xref{Setup of sshfs method}.
@cindex default method
In a remote file name, the use of a default method is indicated by the
-pseudo method @option{-}, @ref{File name syntax}.
+pseudo method @option{-}, @pxref{File name syntax}.
@defopt tramp-default-method
Default method is for transferring files. The user option
@@ -1638,8 +1715,8 @@ follows:
@end group
@end lisp
-With all defaults set, @samp{@trampfn{-,,}} will connect @value{tramp}
-to John's home directory on @code{target} via @code{ssh}.
+With all defaults set, @file{@trampfn{-,,}} will connect @value{tramp}
+to John's home directory on @samp{target} via method @option{ssh}.
@end defopt
@defopt tramp-default-host-alist
@@ -1648,6 +1725,10 @@ allows multiple default host values based on access
method or user
name combinations. The alist can hold multiple values. While
@code{tramp-default-host} is sufficient in most cases, some methods,
like @option{adb}, require defaults overwritten.
+
+The default host name for @option{nspawn} is @samp{.host}. Therefore,
+@file{@trampfn{nspawn,,}} and @file{@trampfn{sudo,,}} have the same
+effect.
@end defopt
@@ -1874,17 +1955,6 @@ Access of a hadoop/hdfs file system. A file is accessed
via
the user that you want to use, and @samp{node} is the name of the
hadoop server.
-@item tramp-nspawn
-@cindex method @option{nspawn}
-@cindex @option{nspawn} method
-Access to environments provided by systemd-nspawn. A file is accessed
-via @file{@trampfn{nspawn,user@@container,/path/to/file}}, where
-@samp{user} is the (optional) user that you want to use, and
-@samp{container} is the container to connect to. systemd-nspawn and
-its container utilities often require super user access to run, use
-multi-hop file names with @option{doas} or @option{sudo} to raise your
-privileges.
-
@item vagrant-tramp
@cindex method @option{vagrant}
@cindex @option{vagrant} method
@@ -2054,10 +2124,12 @@ file name syntax, must be appended to the machine and
login items:
machine melancholia#4711 port davs login daniel%BIZARRE password geheim
@end example
-For the methods @option{doas}, @option{sudo} and @option{sudoedit} the
-password of the user requesting the connection is needed, and not the
-password of the target user. If these connections happen on the local
-host, an entry with the local user and local host is used:
+For the methods @option{doas}, @option{sudo}, @option{sudoedit} and
+@option{nspawn} the password of the user requesting the connection is
+needed, and not the password of the target user@footnote{On the local
+host, @code{run0} uses a graphical password agent.}. If these
+connections happen on the local host, an entry with the local user and
+local host is used:
@example
machine @var{host} port sudo login @var{user} password secret
@@ -2230,8 +2302,8 @@ All @file{tramp-sh.el} based methods accept the property
@t{"session-timeout"}. This is the time (in seconds) after a
connection is disabled for security reasons, and must be
reestablished. A value of @code{nil} disables this feature. Most of
-the methods do not set this property except the @option{sudo} and
-@option{doas} methods, which use predefined values.
+the methods do not set this property except the @option{sudo},
+@option{doas} and @option{run0} methods, which use predefined values.
@item @t{"~"}@*
@t{"~user"}
@@ -2248,15 +2320,6 @@ default value is @t{"/data/local/tmp"} for the
@option{adb} method,
@t{"/C$/Temp"} for the @option{smb} method, and @t{"/tmp"} otherwise.
@ref{Temporary directory}.
-@item @t{"direct-async-process"}
-
-When this property is non-@code{nil}, an alternative, more performant
-implementation of @code{make-process} and @code{start-file-process} is
-applied. The connection method must also be marked with a
-non-@code{nil} @code{tramp-direct-async} parameter in
-@code{tramp-methods}. @ref{Improving performance of asynchronous
-remote processes} for a discussion of constraints.
-
@item @t{"posix"}
Connections using the @option{smb} method check, whether the remote
@@ -2385,7 +2448,7 @@ be recomputed. To force @value{tramp} to recompute
afresh, call
By default, @value{tramp} uses the command @command{/bin/sh} for
starting a shell on the remote host. This can be changed by setting
-the connection property @t{"remote-shell"}; see @ref{Predefined
+the connection property @t{"remote-shell"}; @pxref{Predefined
connection information}. If you want, for example, use
@command{/usr/bin/zsh} on a remote host, you might apply
@@ -2636,8 +2699,8 @@ its execution of @command{/bin/sh} on the remote host
because Bourne
shell does not recognize the export command as entered in
@file{.profile}.
-Likewise, (@code{~}) character in paths will cause errors because
-Bourne shell does not do (@code{~}) character expansions.
+Likewise, (@samp{~}) character in paths will cause errors because
+Bourne shell does not do (@samp{~}) character expansions.
One approach to avoiding these incompatibilities is to make all
commands in @file{~/.shrc} and @file{~/.profile} Bourne shell
@@ -2992,7 +3055,7 @@ mounted, it will be used as it is. If the mount point
does not exist
yet, @value{tramp} creates this directory.
The mount point can be overwritten by the connection property
-@t{"mount-point"}, @ref{Predefined connection information}.
+@t{"mount-point"}, @pxref{Predefined connection information}.
Example:
@lisp
@@ -3352,7 +3415,7 @@ configuration option will be selected, it can be
@t{"--standard"}
or @t{"--paranoia"}. See the @samp{encfs(1)} man page for details.
However, @value{tramp} must adapt these configuration sets. The
-@code{chainedNameIV} configuration option must be disabled; otherwise
+@option{chainedNameIV} configuration option must be disabled; otherwise
@value{tramp} couldn't handle file name encryption transparently.
@end defopt
@@ -3381,7 +3444,7 @@ users.
The command @command{encfsctl}, the workhorse for encryption /
decryption, needs the configuration file password every call.
Therefore, it is recommend to cache this password in Emacs. This can
-be done using @code{auth-sources}, @ref{Using an authentication file}.
+be done using @code{auth-sources}, @pxref{Using an authentication file}.
An entry needs the url-encoded directory name as machine, your local
user name as user, and the password. The port is optional, if given
it must be the string @t{"crypt"}. The example above would require
@@ -3471,7 +3534,7 @@ on the remote host @var{host}, using the method
@var{method}.
@table @file
@item @value{prefix}ssh@value{postfixhop}melancholia@value{postfix}.emacs
For the file @file{.emacs} located in the home directory, on the host
-@code{melancholia}, using method @code{ssh}.
+@samp{melancholia}, using method @option{ssh}.
@item
@value{prefix}ssh@value{postfixhop}melancholia.danann.net@value{postfix}.emacs
For the file @file{.emacs} specified using the fully qualified domain name of
@@ -3481,12 +3544,12 @@ the host.
For the file @file{.emacs} specified using the @file{~}, which is expanded.
@item
@value{prefix}ssh@value{postfixhop}melancholia@value{postfix}~daniel/.emacs
-For the file @file{.emacs} located in @code{daniel}'s home directory
-on the host, @code{melancholia}. The @file{~<user>} construct is
+For the file @file{.emacs} located in @samp{daniel}'s home directory
+on the host, @samp{melancholia}. The @file{~<user>} construct is
expanded to the home directory of that user on the remote host.
@item
@value{prefix}ssh@value{postfixhop}melancholia@value{postfix}/etc/squid.conf
-For the file @file{/etc/squid.conf} on the host @code{melancholia}.
+For the file @file{/etc/squid.conf} on the host @samp{melancholia}.
@end table
@@ -3504,8 +3567,8 @@ different name using the proper syntax will override this
default
behavior: @file{@trampfn{method,user@@host,path/to/file}}.
@file{@trampfn{ssh,daniel@@melancholia,.emacs}} is for file
-@file{.emacs} in @code{daniel}'s home directory on the host,
-@code{melancholia}, accessing via method @code{ssh}.
+@file{.emacs} in @samp{daniel}'s home directory on the host,
+@samp{melancholia}, accessing via method @option{ssh}.
For specifying port numbers, affix @file{#<port>} to the host
name. For example: @file{@trampfn{ssh,daniel@@melancholia#42,.emacs}}.
@@ -3538,8 +3601,8 @@ names. Beside the @code{default} value, @var{syntax} can
be
This remote file name syntax is similar to the syntax used by Ange FTP@.
A remote file name has the form
-@code{@value{prefix}user@@host@value{postfix}path/to/file}. The
-@code{user@@} part is optional, and the method is determined by
+@file{@value{prefix}user@@host@value{postfix}path/to/file}. The
+@samp{user@@} part is optional, and the method is determined by
@ref{Default Method}.
@item @code{separate}
@@ -3550,8 +3613,8 @@ A remote file name has the form
@include trampver.texi
This remote file name syntax originated in the XEmacs text editor.
A remote file name has the form
-@code{@trampfn{method,user@@host,path/to/file}}. The @code{method}
-and @code{user@@} parts are optional.
+@file{@trampfn{method,user@@host,path/to/file}}. The @samp{method}
+and @samp{user@@} parts are optional.
@clear separate
@set unified
@include trampver.texi
@@ -3734,12 +3797,12 @@ Ad-hoc proxies can take patterns @code{%h} or @code{%u}
like in
@code{tramp-default-proxies-alist}. The following file name expands
to user @samp{root} on host @samp{remotehost}, starting with an
@option{ssh} session on host @samp{remotehost}:
-@samp{@trampfn{ssh@value{postfixhop}%h|su,remotehost,}}.
+@file{@trampfn{ssh@value{postfixhop}%h|su,remotehost,}}.
On the other hand, if a trailing hop does not specify a host name, the
host name of the previous hop is reused. Therefore, the following
file name is equivalent to the previous example:
-@samp{@trampfn{ssh@value{postfixhop}remotehost|su,,}}.
+@file{@trampfn{ssh@value{postfixhop}remotehost|su,,}}.
@defopt tramp-completion-multi-hop-methods
When this list includes the last method in a multi-hop connection, the
@@ -3766,8 +3829,8 @@ The buffer must either visit a file, or a directory
@defopt tramp-file-name-with-method
The method @code{tramp-revert-buffer-with-sudo} shows an alternate
-buffer. It defaults to @code{sudo}, other valid methods are
-@code{su}, @code{doas}, and @code{ksu}.
+buffer. It defaults to @option{sudo}, other valid methods are
+@option{su}, @option{doas}, @option{run0}, and @option{ksu}.
@lisp
(customize-set-variable 'tramp-file-name-with-method "doas")
@@ -4001,14 +4064,16 @@ follows in the local @file{.emacs} file:
local host that the remote host can redirect X11 window
interactions. If querying for a recognizable name is not possible for
whatever reason, then replace @code{(getenv "DISPLAY")} with a
-hard-coded, fixed name. Note that using @code{:0} for X11 display name
+hard-coded, fixed name. Note that using @samp{:0} for X11 display name
here will not work as expected.
@vindex ForwardX11@r{, ssh option}
@vindex ForwardX11Trusted@r{, ssh option}
An alternate approach is specify @option{ForwardX11 yes} or
@option{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local
-host.
+host. Furthermore, set @code{tramp-use-connection-share} to
+@code{nil} (@pxref{Using ssh connection sharing}), in order to avoid
+unwanted side effects.
@subsection Running @code{shell} on a remote host
@@ -4394,15 +4459,24 @@ Sometimes, this is not needed. Instead of starting a
remote shell and
running the command afterwards, it is sufficient to run the command
directly. @value{tramp} supports this by an alternative
implementation of @code{make-process} and @code{start-file-process}.
-This is triggered by the connection property
-@t{"direct-async-process"}, @xref{Predefined connection information},
+This is triggered by the connection-local variable
+@code{tramp-direct-async-process},
+@ifinfo
+@xref{Connection Variables, , , emacs},
+@end ifinfo
which must be set to a non-@code{nil} value. Example:
@lisp
@group
-(add-to-list 'tramp-connection-properties
- (list (regexp-quote "@trampfn{ssh,user@@host,}")
- "direct-async-process" t))
+(connection-local-set-profile-variables
+ 'remote-direct-async-process
+ '((tramp-direct-async-process . t)))
+@end group
+
+@group
+(connection-local-set-profiles
+ '(:application tramp :machine "remotehost")
+ 'remote-direct-async-process)
@end group
@end lisp
@@ -4444,9 +4518,15 @@ In order to gain even more performance, it is
recommended to bind
@code{start-file-process}. Furthermore, you might set
@code{tramp-use-connection-share} to @code{nil} in order to bypass
@value{tramp}'s handling of the @option{ControlMaster} options, and
-use your own settings in @file{~/.ssh/config}, @ref{Using ssh
+use your own settings in @file{~/.ssh/config}, @pxref{Using ssh
connection sharing}.
+@c Since Emacs 30.
+@strong{Note}: In previous @value{tramp} versions this was triggered
+by the connection property @t{"direct-async-process"}. This is still
+supported but deprecated, and it will be removed in a future
+@value{tramp} version.
+
@node Cleanup remote connections
@section Cleanup remote connections
@@ -4571,7 +4651,7 @@ specifies the target to be applied for renaming buffer
file names from
source via @code{tramp-rename-files}. @code{source} is a regular
expressions, which matches a remote file name. @code{target} must be
a directory name, which could be remote (including remote directories
-@value{tramp} infers by default, such as @samp{@trampfn{method,user@@host,}}).
+@value{tramp} infers by default, such as @file{@trampfn{method,user@@host,}}).
@code{target} can contain the patterns @code{%m}, @code{%u} or
@code{%h}, which are replaced by the method name, user name or host
@@ -4600,7 +4680,7 @@ ssh@value{postfixhop}%h@value{postfix}")
@end lisp
routes all connections to a host in @samp{company.org} via
-@samp{@trampfn{ssh,multi.hop,}}, which might be useful when using
+@file{@trampfn{ssh,multi.hop,}}, which might be useful when using
Emacs outside the company network.
@lisp
@@ -4626,7 +4706,7 @@ Whether renaming a buffer file name by
@code{tramp-rename-files} or
@value{tramp} offers also transparent access to files inside file
archives. This is possible only on hosts which have installed
-@acronym{GVFS, the GNOME Virtual File System}, @ref{GVFS-based
+@acronym{GVFS, the GNOME Virtual File System}, @pxref{GVFS-based
methods}. Internally, file archives are mounted via the
@acronym{GVFS} @option{archive} method.
@@ -4922,7 +5002,7 @@ help the development team find the best solution and
avoid unrelated
detours.
To exclude cache-related problems, flush all caches before running the
-test, @ref{Cleanup remote connections}. Alternatively, and often
+test, @pxref{Cleanup remote connections}. Alternatively, and often
better for analysis, reproduce the problem in a clean Emacs session
started with @command{emacs -Q}. Then, @value{tramp} does not load
the persistency file (@pxref{Connection caching}), and it does not use
@@ -5444,9 +5524,9 @@ HISTFILE=/dev/null
Where are remote files trashed to?
@vindex remote-file-name-inhibit-delete-by-moving-to-trash
-Emacs can trash file instead of deleting
+Emacs can trash files instead of deleting
@ifinfo
-them, @ref{Misc File Ops, Trashing , , emacs}.
+them, @pxref{Misc File Ops, Trashing , , emacs}.
@end ifinfo
@ifnotinfo
them.
@@ -5456,6 +5536,29 @@ option
@code{remote-file-name-inhibit-delete-by-moving-to-trash} is
non-@code{nil}, or it is a remote encrypted file (@pxref{Keeping files
encrypted}), which are deleted anyway.
+@c Since Emacs 30.
+@vindex trash-directory
+If you want to trash a remote file into a remote trash directory, you
+could configure the user option @code{trash-directory} to a
+connection-local value.
+@ifinfo
+@xref{Connection Variables, , , emacs}.
+@end ifinfo
+
+@lisp
+@group
+(connection-local-set-profile-variables
+ 'remote-trash-directory
+ '((trash-directory . "/sudo::~/.local/share/Trash")))
+@end group
+
+@group
+(connection-local-set-profiles
+ `(:application tramp :protocol "sudo" :machine ,system-name)
+ 'remote-trash-directory)
+@end group
+@end lisp
+
If Emacs is configured to use the XDG conventions for the trash
directory, remote files cannot be restored with the respective tools,
because those conventions don't specify remote paths. Such files must
@@ -5887,6 +5990,28 @@ as above in your @file{~/.emacs}:
@end lisp
+@item
+How to ignore errors when changing file attributes?
+
+@vindex tramp-inhibit-errors-if-setting-file-attributes-fail
+Sometimes, for example while saving remote files, errors appear when
+changing file attributes like permissions, time stamps, or ownership.
+If these errors can be ignored, set user option
+@code{tramp-inhibit-errors-if-setting-file-attributes-fail} to a
+non-@code{nil} value. This transforms the error into a warning.
+
+
+@item
+How to ignore errors when changing file attributes?
+
+@vindex tramp-inhibit-errors-if-setting-file-attributes-fail
+Sometimes, for example while saving remote files, errors appear when
+changing file attributes like permissions, time stamps, or ownership.
+If these errors can be ignored, set user option
+@code{tramp-inhibit-errors-if-setting-file-attributes-fail} to a
+non-@code{nil} value. This transforms the error into a warning.
+
+
@item
How to disable other packages from calling @value{tramp}?
@@ -5970,7 +6095,7 @@ can use the @code{without-remote-files} macro.
@end lisp
This improves performance, because many primitive file name operations
-don't check any longer for Tramp file name regexps then.
+don't check any longer for @value{tramp} file name regexps then.
@item
@findex tramp-unload-tramp
diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi
index dd5b70cf32f..822b1097cd9 100644
--- a/doc/misc/vtable.texi
+++ b/doc/misc/vtable.texi
@@ -548,10 +548,20 @@ Remove @var{object} from @var{table}. This also updates
the displayed
table.
@end defun
-@defun vtable-insert-object table object &optional after-object
-Insert @var{object} into @var{table}. If @var{after-object}, insert
-the object after this object; otherwise append to @var{table}. This
-also updates the displayed table.
+@defun vtable-insert-object table object &optional location before
+Insert @var{object} into @var{table}. @var{location} should be an
+object in the table, the new object is inserted after this object, or
+before it if @var{before} is non-nil. If @var{location} is @code{nil},
+@var{object} is appended to @var{table}, or prepended if @var{before} is
+non-@code{nil}.
+
+@var{location} can also be an integer, a zero-based index into the
+table. In this case, @var{object} is inserted at that index. If the
+index is out of range, @var{object} is prepended to @var{table} if the
+index is too small, or appended if it is too large. In this case,
+@var{before} is ignored.
+
+This also updates the displayed table.
@end defun
@defun vtable-update-object table object &optional old-object
diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi
index f74605c92c0..2e378e86fc7 100644
--- a/doc/misc/widget.texi
+++ b/doc/misc/widget.texi
@@ -760,14 +760,14 @@ This chapter describes commands that are specific to
buffers that
contain widgets.
@cindex widget keybindings
-@defvr Const widget-keymap
+@defvar widget-keymap
Keymap containing useful bindings for buffers containing widgets.
-Binds @key{TAB} and @kbd{C-@key{TAB}} to @code{widget-forward} and
-@code{widget-backward}, respectively. It also binds @key{RET} to
-@code{widget-button-press} and @kbd{down-mouse-1} and
+Binds @key{TAB} to @code{widget-forward} and both @kbd{S-@key{TAB}} and
+@kbd{M-@key{TAB}} to @code{widget-backward}. It also binds @key{RET} to
+@code{widget-button-press} and both @kbd{down-mouse-1} and
@kbd{down-mouse-2} to @code{widget-button-click}.
-@end defvr
+@end defvar
There's also a keymap for events that the Widget library doesn't need
to handle.
@@ -788,8 +788,8 @@ The following navigation commands are available:
@deffn Command widget-forward &optional count
Move point @var{count} buttons or editing fields forward.
@end deffn
-@item @kbd{M-@key{TAB}}
-@itemx @kbd{S-@key{TAB}}
+@item M-@key{TAB}
+@itemx S-@key{TAB}
@deffn Command widget-backward &optional count
Move point @var{count} buttons or editing fields backward.
@end deffn
@@ -805,30 +805,35 @@ When editing an @code{editable-field} widget, the
following commands
are available:
@table @kbd
-@item @key{C-e}
+@item C-e
@deffn Command widget-end-of-line
Move point to the end of field or end of line, whichever is first.
@end deffn
-@item @kbd{C-k}
+@item C-k
@deffn Command widget-kill-line
Kill to end of field or end of line, whichever is first.
@end deffn
-@item @kbd{M-TAB}
+@item M-@key{TAB}
+@itemx C-M-i
@deffn Command widget-complete
Complete the content of the editable field at point.
@end deffn
-@item @kbd{C-m}
+@item C-m
+@itemx @key{RET}
@deffn Command widget-field-activate
Invoke the editable field at point.
@end deffn
@end table
-The following two are commands that can execute widget actions.
+The following two commands can execute the action associated with a
+button widget (e.g., a radio button or checkbox):
+
@table @kbd
@item @key{RET}
+@itemx C-m
@findex widget-button-press
@deffn Command widget-button-press @var{pos} &optional @var{event}
Invoke the button at @var{pos}, defaulting to point.
@@ -3262,14 +3267,26 @@ to get a string. Otherwise, it @code{eval}s it.
This chapter is about the customization options for the Widget
library, for the end user.
-@deffn Face widget-field-face
-Face used for other editing fields.
+@deffn Face widget-documentation
+Face used for documentation text.
+@end deffn
+
+@deffn Face widget-field
+Face used for editable fields.
@end deffn
-@deffn Face widget-button-face
+@deffn Face widget-button
Face used for buttons.
@end deffn
+@deffn Face widget-button-pressed
+Face used for pressed buttons.
+@end deffn
+
+@deffn Face widget-inactive
+Face used for inactive widgets.
+@end deffn
+
@defopt widget-mouse-face
Face used for highlighting a button when the mouse pointer moves
across it.
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index d7f513addfb..62970f52396 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -339,6 +339,13 @@ 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.
+** New face 'erc-information' for local administrative messages.
+Messages not originating from a server have historically been shown in
+'erc-notice-face', sometimes in combination with 'erc-error-face'.
+Neither are well suited for local messages of moderate importance.
+From now on, such messages will appear in a more muted color but
+retain the familiar 'erc-notice-prefix' stars.
+
** 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
@@ -486,16 +493,14 @@ these areas without inflicting collateral damage.
Despite the rationale, this move admittedly ushers in a heightened
potential for disruption because third-party members of ERC's
modification hooks may not take kindly to encountering stamp-only
-messages. They may also expect members of 'erc-insert-pre-hook' and
-'erc-insert-done-hook' to run unconditionally, even though ERC
-suppresses those hooks when inserting date stamps. Third parties may
-also not appreciate that 'erc-timestamp-last-inserted-left' no longer
-records the final trailing newline in 'erc-timestamp-format-left'. If
-these inconveniences prove too encumbering to deal with right away,
-see the escape hatch 'erc-stamp-prepend-date-stamps-p', which should
-help ease the transition. As for detecting these new stamp-only
-messages from members of 'erc-insert-modify-hook' and friends, see the
-function 'erc-stamp-inserting-date-stamp-p'.
+messages or the new behavior of 'erc-timestamp-last-inserted-left',
+which no longer records the final trailing newline in the variable
+'erc-timestamp-format-left'. If these inconveniences prove too
+encumbering to deal with right away, see the escape hatch
+'erc-stamp-prepend-date-stamps-p', which should help ease the
+transition. As for detecting these new stamp-only messages from
+members of 'erc-insert-modify-hook' and friends, see the function
+'erc-stamp-inserting-date-stamp-p'.
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and "provided" library
@@ -650,6 +655,14 @@ release lacks a similar solution for detecting
"joinedness" directly,
but users can turn to 'xor'-ing 'erc-default-target' and 'erc-target'
as a makeshift kludge.
+*** Function 'erc-kill-channel' renamed to 'erc-part-channel-on-kill'.
+This function, which normally emits a 'PART' when ERC kills a channel
+buffer, has been renamed for clarity. Moreover, this and all other
+members of 'erc-kill-channel-hook' can now take comfort in knowing
+that the killing of buffers done on behalf of the option
+'erc-kill-buffer-on-part' has been made more detectable by the flag
+'erc-killing-buffer-on-part-p'.
+
*** Channel-mode handling has become stricter and more predictable.
ERC has always processed channel modes using "standardized" letters
and popular status prefixes. Starting with this release, ERC will
diff --git a/etc/NEWS b/etc/NEWS
index 2f90a3067f7..d058acc3572 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -171,7 +171,7 @@ This user option controls outline visibility in the output
buffer of
*** 'C-h m' ('describe-mode') uses outlining by default.
Set 'describe-mode-outline' to nil to get back the old behavior.
-** Outline Mode
+** Outline mode
+++
*** 'outline-minor-mode' is supported in tree-sitter major modes.
@@ -228,7 +228,7 @@ This is used for displaying the time and date components of
---
** New icon images for general use.
Several symbolic icons are added to "etc/images/symbols", including
-plus, minus, check-mark, start, etc.
+plus, minus, check-mark, star, etc.
+++
** Tool bars can now be placed on the bottom on more systems.
@@ -340,6 +340,13 @@ and 'window-state-get'. Then later another new variable
'window-state-put' to restore positions of window points
according to the context stored in a window parameter.
++++
+*** New functions 'set-window-cursor-type' and 'window-cursor-type'.
+'set-window-cursor-type' sets a per-window cursor type, and
+'window-cursor-type' queries this setting for a given window. Windows
+are always created with a 'window-cursor-type' of t, which means to
+consult the variable 'cursor-type' as before.
+
** Tab Bars and Tab Lines
---
@@ -351,70 +358,57 @@ points after switching back to that tab.
---
*** 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.
+It defines what to do with windows whose buffer was killed since the tab
+was last selected. By default it displays a placeholder buffer
+with the name " *Old buffer <name>*" 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.
+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 keymap 'tab-bar-mode-map'.
-By default it contains a keybinding 'C-TAB' to switch tabs,
-but only when 'C-TAB' is not bound globally. You can unbind it
-if it conflicts with 'C-TAB' in other modes.
+By default it contains a keybinding 'C-TAB' to switch tabs, but only
+when 'C-TAB' is not bound globally. You can unbind it if it conflicts
+with 'C-TAB' in other modes.
---
*** New keymap 'tab-line-mode-map'.
-By default it contains keybindings for switching tabs:
-'C-x <left>', 'C-x <right>', 'C-x C-<left>', 'C-x C-<right>'.
-You can unbind them if you want to use these keys for the
-commands 'previous-buffer' and 'next-buffer'.
+By default it contains keybindings for switching tabs: 'C-x <left>',
+'C-x <right>', 'C-x C-<left>', 'C-x C-<right>'. You can unbind them if
+you want to use these keys for the commands 'previous-buffer' and
+'next-buffer'.
---
*** Default list of tabs is changed to support a fixed order.
-This means that the new default tabs function
-'tab-line-tabs-fixed-window-buffers' is like the previous
-'tab-line-tabs-window-buffers' where both of them show
-only buffers that were previously displayed in the window.
-But the difference is that the new function always keeps
-the original order of buffers on the tab line, even after
-switching between these buffers.
+This means that 'tab-line-tabs-fixed-window-buffers', the new default
+tabs function, is like the previous 'tab-line-tabs-window-buffers' where
+both of them show only buffers that were previously displayed in the
+window. But the difference is that the new function always keeps the
+original order of buffers on the tab line, even after switching between
+these buffers. You can drag the tabs and release at a new position
+to manually reorder the buffers on the tab line.
---
*** New user option 'tab-line-tabs-buffer-group-function'.
-It provides two choices to group tab buffers by major mode
-and by project name.
+It provides two choices to group tab buffers by major mode and by
+project name.
---
-*** Now buffers on group tabs are sorted alphabetically.
-This will keep the fixed order of tabs, even after
-switching between them.
+*** Buffers on group tabs are now sorted alphabetically.
+This will keep the fixed order of tabs, even after switching between
+them.
+++
** New optional argument for modifying directory-local variables.
The commands 'add-dir-local-variable', 'delete-dir-local-variable' and
'copy-file-locals-to-dir-locals' now take an optional prefix argument,
-to enter the file you want to modify.
-
-** Miscellaneous
-
----
-*** New face 'appt-notification' for 'appt-display-mode-line'.
-It can be used to customize the look of the appointment notification
-displayed on the mode line when 'appt-display-mode-line' is non-nil.
-
----
-*** Emacs now recognizes shebang lines that pass '-S'/'--split-string' to
'env'.
-When visiting a script that invokes 'env -S INTERPRETER ARGS...' in
-its shebang line, Emacs will now skip over 'env -S' and deduce the
-major mode based on the interpreter after 'env -S'.
+to enter the file name you want to modify.
** Emacs Server and Client
@@ -446,6 +440,33 @@ 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'.
++++
+** Support for styled underline face attributes.
+These are implemented as new values of the 'style' attribute in a face
+underline specification, 'double-line', 'dots', and 'dashes', and are
+available on GUI systems. If your terminal's termcap or terminfo
+database entry defines the 'Su' or 'Smulx' capability, Emacs will also
+emit the prescribed escape sequence to render faces with such styles on
+TTY frames.
+
+---
+** Support for underline colors on TTY frames.
+Colors specified in face underlines will now also be displayed in TTY
+frames with the previously mentioned capabilities.
+
+** Miscellaneous
+
+---
+*** New face 'appt-notification' for 'appt-display-mode-line'.
+It can be used to customize the look of the appointment notification
+displayed on the mode line when 'appt-display-mode-line' is non-nil.
+
+---
+*** Emacs now recognizes shebang lines that pass '-S'/'--split-string' to
'env'.
+When visiting a script that invokes 'env -S INTERPRETER ARGS...' in
+its shebang line, Emacs will now skip over 'env -S' and deduce the
+major mode based on the interpreter after 'env -S'.
+
* Editing Changes in Emacs 30.1
@@ -682,6 +703,12 @@ you can add this to your init script:
(setopt project-switch-commands #'project-prefix-or-any-command)
+---
+*** New variable 'project-files-relative-names'.
+If it's non-nil, 'project-files' can return file names relative to the
+project root. Project backends can use this to improve the performance
+of their 'project-files' implementation.
+
** VC
---
@@ -785,10 +812,14 @@ and a universal command such as "open" or "start"
that delegates to the OS.
*** New command 'dired-do-open'.
-This command is bound to "Open" in the context menu; it "opens" the
-marked or clicked on files according to the OS conventions. For
-example, on systems supporting XDG, this runs 'xdg-open' on the
-files.
+This command is bound to 'E' (mnemonics "External"). Also it can be
+used by clicking "Open" in the context menu; it "opens" the marked or
+clicked on files according to the OS conventions. For example, on
+systems supporting XDG, this runs 'xdg-open' on the files.
+
+*** New variable 'dired-guess-shell-alist-optional'.
+It contains commands for external viewers and players for various media
+formats, moved to this list from 'dired-guess-shell-alist-default'.
*** The default value of 'dired-omit-size-limit' was increased.
After performance improvements to omitting in large directories, the new
@@ -895,7 +926,7 @@ By prefixing a command name in Eshell with a remote
identifier, like
"/ssh:user@remote:whoami", you can now run commands on a particular
host no matter your current directory. Likewise, you can run a
command on your local system no matter your current directory via
-"/:whoami". For more information, see the "(eshell) Remote Access"
+"/local:whoami". For more information, see the "(eshell) Remote Access"
node in the Eshell manual.
+++
@@ -1019,6 +1050,18 @@ docstring, or a comment, or (re)indents the surrounding
defun if
point is not in a comment or a string. It is by default bound to
'M-q' in 'prog-mode' and all its descendants.
+** Imenu
+
++++
+*** New user option 'imenu-flatten'.
+It defines whether to flatten the list of sections in an imenu
+or show it nested.
+
++++
+*** The sort order of Imenu completions can now be customized.
+You can customize the option 'completion-category-overrides'
+and set 'display-sort-function' for the category 'imenu'.
+
** Which Function mode
+++
@@ -1031,19 +1074,32 @@ mode line. 'header' will display in the header line;
** Tramp
+++
-*** New connection method "androidsu".
+*** Tramp methods can be optional.
+An optional connection method is not enabled by default. The user must
+enable it explicitly by the 'tramp-enable-method' command. The existing
+methods "fcp", "krlogin", " ksu" and "nc" are optional now.
+
++++
+*** New optional 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 optional connection method "run0".
+This connection method is similar to "sudo", but it uses the
+'systemd-run' program internally.
+
+++
*** 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.
+*** New optional connection methods for containers.
+Tere are new optional connection methods "toolbox", "flatpak",
+"apptainer" and "nspawn". They allow accessing system containers
+provided by Toolbox, sandboxes provided by Flatpak, instances managed by
+Apptainer, or accessing systemd-based light-weight containers..
+++
*** Connection method "kubernetes" supports now optional container name.
@@ -1094,6 +1150,14 @@ buffer must either visit a file, or it must run
'dired-mode'. Another
method but "sudo" can be configured with user option
'tramp-file-name-with-method'.
++++
+*** Direct asynchronous processes are indicated by a connection-local variable.
+If direct asynchronous processes shall be used, set the connection-local
+variable 'tramp-direct-async-process' to a non-nil value. This has been
+changed, in previous Emacs versions this was indicated by the now
+deprecated connection property "direct-async-process". See the Tramp
+manual "(tramp) Improving performance of asynchronous remote processes".
+
---
*** Direct asynchronous processes use 'tramp-remote-path'.
When a direct asynchronous process is invoked, it uses 'tramp-remote-path'
@@ -1106,6 +1170,20 @@ for setting the remote PATH environment variable.
** EWW
+---
+*** New mouse bindings in EWW buffers.
+Certain form elements that were displayed as buttons, yet could only be
+activated by keyboard input, are now operable using 'mouse-2'. With
+"Submit" buttons, this triggers submission of the form, while clicks on
+other classes of buttons either toggle their values or prompt for user
+input, as the case may be.
+
+---
+*** EWW text input fields and areas are now fields.
+In consequence, movement commands and OS input method features now
+recognize and confine their activities to the text input field around
+point. See also the Info node "(elisp) Fields".
+
+++
*** 'eww-open-file' can now display the file in a new buffer.
By default, the command reuses the "*eww*" buffer, but if called with
@@ -1139,7 +1217,7 @@ 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.
+*** History navigation in EWW now behaves as in 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.
@@ -1249,6 +1327,28 @@ in a clean environment.
** Flymake
++++
+*** New user option 'flymake-indicator-type'.
+This user option controls which error indicator type Flymake should use
+in current buffer. Depending on your preference, this can either use
+fringes or margins for indicating errors.
+
++++
+*** New user option 'flymake-margin-indicators-string'.
+It controls, for each error type, the string and its face to display as
+the margin indicator.
+
++++
+*** New user option 'flymake-autoresize-margins'.
+If non-nil, Flymake will resize the margins when 'flymake-mode' is
+turned on or off.
+Only relevant if 'flymake-indicator-type' is set to 'margins'.
+
++++
+*** New user option 'flymake-margin-indicator-position'.
+It controls which margin (left or right) is used for margin
+indicators.
+
+++
*** New user option 'flymake-show-diagnostics-at-end-of-line'.
When non-nil, Flymake shows summarized descriptions of diagnostics at
@@ -1297,6 +1397,18 @@ instead of:
This allows the user to specify command line arguments to the non
interactive Python interpreter specified by 'python-interpreter'.
+*** New function 'python-shell-send-block'.
+It sends the python block delimited by 'python-nav-beginning-of-block'
+and 'python-nav-end-of-block' to the inferior Python process.
+
+** Inferior Python mode
+
+---
+*** Default value of 'python-shell-compilation-regexp-alist' is changed.
+Support for Python's ExceptionGroup has been added, so in the Python
+shell, the line indicating the source of error in the error messages
+from ExceptionGroup will be recognized as well.
+
** Scheme mode
Scheme mode now handles regular expression literal '#/regexp/' that is
available in some Scheme implementations.
@@ -1315,6 +1427,16 @@ when using the ':vc' keyword.
** Gnus
++++
+*** New backend 'nnfeed'.
+This allows backend developers to easily create new backends for web
+feeds, as inheriting backends of 'nnfeed'.
+
++++
+*** New backend 'nnatom'.
+This allow users to add Atom Syndication Format feeds to Gnus as
+servers.
+
*** The 'nnweb-type' option 'gmane' has been removed.
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
@@ -1380,6 +1502,13 @@ name as a string. The new function
'dictionary-completing-read-dictionary' can be used to prompt with
completion based on dictionaries that the server supports.
+---
+*** The default value of 'dictionary-tooltip-dictionary' has changed.
+The new default value is t, which means use the same dictionary as the
+value of 'dictionary-default-dictionary'. The previous default value
+was nil, which effectively disabled 'dictionary-tooltip-mode', even if
+the mode was turned on.
+
** Pp
*** New 'pp-default-function' user option replaces 'pp-use-max-width'.
@@ -1532,7 +1661,8 @@ macros with many lines, such as from
'kmacro-edit-lossage'.
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.
-** Kmacro Menu Mode
+
+** Kmacro Menu mode
+++
*** New mode 'kmacro-menu-mode' and new command 'list-keyboard-macros'.
@@ -1543,36 +1673,6 @@ of the currently existing keyboards macros using the new
mode
duplicating them, deleting them, and editing their counters, formats,
and keys.
-** Miscellaneous
-
----
-*** Webjump now assumes URIs are HTTPS instead of HTTP.
-For links in 'webjump-sites' without an explicit URI scheme, it was
-previously assumed that they should be prefixed with "http://";. Such
-URIs are now prefixed with "https://"; instead.
-
----
-*** 'bug-reference-mode' now supports 'thing-at-point'.
-Now, calling '(thing-at-point 'url)' when point is on a bug reference
-will return the URL for that bug.
-
-+++
-*** New user option 'rcirc-log-time-format'
-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
+++
@@ -1630,7 +1730,72 @@ options of GNU 'ls'.
+++
*** New user option 'widget-skip-inactive'.
If non-nil, moving point forward or backward between widgets by typing
-TAB or S-TAB skips over inactive widgets. The default value is nil.
+'TAB' or 'S-TAB' skips over inactive widgets. The default value is nil.
+
+** Ruby mode
+
+*** New user option 'ruby-rubocop-use-bundler'.
+By default it retains the previous behavior: read the contents of
+Gemfile and act accordingly. But you can also set it to t or nil to
+skip the check.
+
+** Thingatpt
+
+---
+*** New variables for providing custom thingatpt implementations.
+The new variables 'bounds-of-thing-at-point-provider-alist' and
+'forward-thing-provider-alist' now allow defining custom implementations
+of 'bounds-of-thing-at-point' and 'forward-thing', respectively.
+
+---
+*** New helper functions for text property-based thingatpt providers.
+The new helper functions 'thing-at-point-for-char-property',
+'bounds-of-thing-at-point-for-char-property', and
+'forward-thing-for-char-property' can help to help implement custom
+thingatpt providers for "things" that are defined by a text property.
+
+---
+*** 'bug-reference-mode' now supports 'thing-at-point'.
+Now, calling '(thing-at-point 'url)' when point is on a bug reference
+will return the URL for that bug.
+
+** Miscellaneous
+
+---
+*** Webjump now assumes URIs are HTTPS instead of HTTP.
+For links in 'webjump-sites' without an explicit URI scheme, it was
+previously assumed that they should be prefixed with "http://";. Such
+URIs are now prefixed with "https://"; instead.
+
++++
+*** New user option 'rcirc-log-time-format'.
+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.
+
+---
+*** nXML Mode now comes with schemas for Mono/.NET development.
+The following new XML schemas are now supported:
+- MSBuild project files
+- Dotnet package properties files
+- Dotnet resource extension files
+- Dotnet Application config files
+- Nuget config file
+- Nuget package specification file
+- Nuget packages config file
+
+** color.el now supports the Oklab color representation.
* New Modes and Packages in Emacs 30.1
@@ -1719,13 +1884,30 @@ documentation and examples.
* Incompatible Lisp Changes in Emacs 30.1
++++
+** Evaluating a 'lambda' returns an object of type 'interpreted-function'.
+Instead of representing interpreted functions as lists that start with
+either 'lambda' or 'closure', Emacs now represents them as objects
+of their own 'interpreted-function' type, which is very similar
+to 'byte-code-function' objects (the argument list, docstring, and
+interactive forms are placed in the same slots).
+Lists that start with 'lambda' are now used only for non-evaluated
+functions (in other words, for source code), but for backward compatibility
+reasons, 'functionp' still recognizes them as functions and you can
+still call them as before.
+Thus code that attempts to "dig" into the internal structure of an
+interpreted function's object with the likes of 'car' or 'cdr' will
+no longer work and will need to use 'aref' instead to extract its
+various subparts (when 'interactive-form', 'documentation', and
+'help-function-arglist' aren't adequate).
+
+++
** 'define-globalized-minor-mode' requires that modes use 'run-mode-hooks'.
Minor modes defined with 'define-globalized-minor-mode', such as
'global-font-lock-mode', will not be enabled any more in those buffers
-whose major modes fails to use 'run-mode-hooks'. Major modes defined
-with 'define-derived-mode' are not affected. `run-mode-hooks` has been the
-recommended way to run major mode hooks since Emacs-22.
+whose major modes fail to use 'run-mode-hooks'. Major modes defined
+with 'define-derived-mode' are not affected. 'run-mode-hooks' has been the
+recommended way to run major mode hooks since Emacs 22.
---
** Old derived.el functions removed.
@@ -1858,6 +2040,22 @@ unibyte string.
* Lisp Changes in Emacs 30.1
++++
+** New user option 'compilation-safety' to control safety of native code.
+It's now possible to control how safe is the code generated by native
+compilation, by customizing this user option. It is also possible to
+control this at function granularity by using the new 'safety' parameter
+in the function's 'declare' form.
+
+** New types 'closure' and 'interpreted-function'.
+'interpreted-function' is the new type used for interpreted functions,
+and 'closure' is the common parent type of 'interpreted-function'
+and 'byte-code-function'.
+
+Those new types come with the associated new predicates 'closurep' and
+`interpreted-function-p' as well as a new constructor
+'make-interpreted-closure'.
+
** 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.
@@ -1915,9 +2113,9 @@ the Info node "(elisp) Handling Errors".
+++
** Tooltips on fringes.
It is now possible to provide tooltips on fringes by adding special text
-properties 'left-fringe-help' and 'right-fringe-help'. See the "Special
-Properties" Info node in the Emacs Lisp Reference Manual for more
-details.
+properties 'left-fringe-help' and 'right-fringe-help'. See the "(elisp)
+Special Properties" Info node in the Emacs Lisp Reference Manual for
+more details.
+++
** New 'pop-up-frames' action alist entry for 'display-buffer'.
@@ -1928,6 +2126,9 @@ precedence over the variable when present.
Mostly used internally to do a kind of topological sort of
inheritance hierarchies.
++++
+** 'drop' is now an alias for the function 'nthcdr'.
+
+++
** New polymorphic comparison function 'value<'.
This function returns non-nil if the first argument is less than the
@@ -2036,6 +2237,11 @@ rather than signaling an error.
It is bound to the key sequence that caused a call to a function bound
within 'function-key-map' or 'input-decode-map' around those calls.
++++
+** The function 'key-translate' can now remove translations.
+If the second argument TO is nil, the existing key translation is
+removed.
+
+++
** New variables describing the names of built in programs.
The new variables 'ctags-program-name', 'ebrowse-program-name',
@@ -2334,8 +2540,26 @@ 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.
+** Function 'declare' forms
+
++++
+*** New 'ftype' function declaration.
+The declaration '(ftype TYPE)' specifies the type of a function.
+Example:
+
+ (defun hello (x y)
+ (declare (ftype (function (integer boolean) string)))
+ ...)
+
+specifies that the function takes two arguments, an integer and a
+boolean, and returns a string. If the compilation happens with
+'compilation-safety' set to zero, this information can be used by the
+native compiler to produce better code, but specifying an incorrect type
+may lead to Emacs crashing. See the Info node "(elisp) Declare Form"
+for further information.
+
+++
-** New function declaration and property 'important-return-value'.
+*** New 'important-return-value' function declaration and property.
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.
@@ -2466,6 +2690,18 @@ 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.
+** 'vtable-insert-object' can insert "before" or at an index.
+The signature of 'vtable-insert-object' has changed and is now:
+
+ (vtable-insert-object TABLE OBJECT &optional LOCATION BEFORE)
+
+LOCATION corresponds to the old AFTER-OBJECT argument; if BEFORE is
+non-nil, the new object is inserted before the LOCATION object, making
+it possible to insert a new object at the top of the table. (Before,
+this was not possible.) In addition, LOCATION can be an integer, a
+(zero-based) index into the table at which the new object is inserted
+(BEFORE is ignored in this case).
+
** JSON
---
@@ -2483,7 +2719,7 @@ correctly UTF-8 encoded.
*** The parser and encoder now accept arbitrarily large integers.
Previously, they were limited to the range of signed 64-bit integers.
-** New tree-sitter functions and variables for defining and using "things".
+** New tree-sitter functions and variables for defining and using "things"
+++
*** New variable 'treesit-thing-settings'.
@@ -2507,7 +2743,7 @@ accept more kinds of predicates. Lisp programs can now
use thing
symbols (defined in 'treesit-thing-settings') and any thing definitions
for the predicate argument.
-** Other tree-sitter function and variable changes.
+** Other tree-sitter function and variable changes
+++
*** 'treesit-parser-list' now takes additional optional arguments.
@@ -2516,6 +2752,24 @@ only return parsers for that language. If TAG is given,
only return
parsers with that tag. Note that passing nil as tag doesn't mean return
all parsers, but rather "all parsers with no tags".
++++
+*** New function 'treesit-parser-changed-ranges'.
+This function returns buffer regions that are affected by the last
+buffer edits.
+
+*** New function 'treesit-add-font-lock-rules'.
+This function helps users to add custom font-lock rules to a tree-sitter
+major mode.
+
+---
+** The variable 'rx-constituents' is now obsolete.
+Use 'rx-define', 'rx-let' and 'rx-let-eval' instead.
+
+---
+** 'defvar-keymap' can specify hints for 'repeat-mode'.
+Using ':repeat (:hints ((command . "hint") ...))' will show
+the hint string in the echo area together with repeatable keys.
+
* Changes in Emacs 30.1 on Non-Free Operating Systems
diff --git a/etc/NEWS.unknown b/etc/NEWS.unknown
new file mode 100644
index 00000000000..eafdc953cac
--- /dev/null
+++ b/etc/NEWS.unknown
@@ -0,0 +1,31 @@
+This file contains mentions of functions and variables whose
+version of introduction would otherwise be guessed incorrectly
+by 'M-x describe-function'.
+
+Since much of early Emacs source history is lost, these versions are
+conservative estimates: the actual version of first appearance may very
+well be much earlier.
+
+* Changes in Emacs 19.7
+** 'defsubst'
+
+* Changes in Emacs 18.59
+** 'mark'
+
+* Changes in Emacs 13.8
+This may be the earliest surviving version with source code, although
+damaged. See
+https://github.com/larsbrinkhoff/emacs-history/decuslib.com/decus/vax85b/gnuemax
+
+** 'nthcdr'
+** 'nreverse
+** 'let*'
+** 'rassq'
+** '>='
+** 'transpose-sexps'
+** 'buffer-modified-p'
+** 'current-column'
+** 'downcase'
+** 'previous-line'
+** 'catch', 'throw'
+** 'count-lines'
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index b17a10bd4ee..da861ebe6e7 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -216,6 +216,28 @@ arguments you intend to pass to Emacs):
$ SNAP=1 SNAP_NAME=1 SNAP_REVISION=1 emacs ...
+** Emacs built with tree-sitter crashes when some *-ts-mode is turned on.
+
+The crash is in many cases an abort due to run-time detection of stack
+smashing, and it happens when one of the *-ts-mode modes is turned on
+in a buffer.
+
+The reason is that the tree-sitter library changed its Application
+Binary Interface (ABI) between version 0.22.2 and 0.22.4, but did not
+increment the ABI version number. Therefore, Emacs compiled with
+tree-sitter versions before the change will try to use the shared
+library after the change, and crash due to incompatibilities in the
+ABI.
+
+Until and unless the tree-sitter developers release a library with an
+updated ABI version, the solution is to rebuild Emacs with the actual
+library with which it will be used. If you cannot rebuild Emacs,
+downgrade your tree-sitter library to version 0.22.2 or older.
+
+The relevant tree-sitter issue is here:
+
+ https://github.com/tree-sitter/tree-sitter/issues/3296
+
** Emacs crashes when you try to view a file with complex characters.
One possible reason for this could be a bug in the libotf or the
@@ -3380,7 +3402,7 @@ for further discussion.
* Runtime problems specific to macOS
-** Error message when opening Emacs on macOS
+** Error message about malicious software when opening Emacs on macOS
When opening Emacs, you may see an error message saying something like
this:
@@ -3397,6 +3419,22 @@ the Emacs app icon, and then choose Open. This adds a
security
exception for Emacs and from now on you should be able to open it by
double-clicking on its icon, like any other app.
+** Error message about color list unarchiver when starting Emacs on macOS
+
+The error message looks like this:
+
+ Failed to initialize color list unarchiver:
+ Error Domain=NSCocoaErrorDomain Code=4864 "*** -[NSKeyedUnarchiver
+ _initForReadingFromData:error:throwLegacyExceptions:]: non-keyed archive
cannot be decoded by NSKeyedUnarchiver"
+ UserInfo={NSDebugDescription=*** -[NSKeyedUnarchiver
+ _initForReadingFromData:error:throwLegacyExceptions:]: non-keyed archive
cannot be decoded by NSKeyedUnarchiver}
+
+After showing this message, Emacs usually works normally.
+
+The usual reason for this is that the color file,
+~/Library/Colors/Emacs.clr, is stale or corrupted. The solution is to
+delete that file and restart Emacs.
+
** macOS doesn't come with libxpm, so only XPM3 is supported.
Libxpm is available for macOS as part of the XQuartz project.
@@ -3601,6 +3639,31 @@ The organization of the Settings app might disagree with
that
illustrated above, which if true you should consult the documentation
or any search mechanism for it.
+** Emacs is not compatible with the "Microsoft SwiftKey" input method.
+
+When enabled, windows are repeatedly recentered around earlier buffer
+positions as they are scrolled. The underlying cause is that Microsoft
+SwiftKey aggressively forces point towards word boundaries, which motion
+is sometimes received and duly processed by Emacs after the window in
+question has already been scrolled past its target position, with the
+result that the next redisplay recenters the window around this outdated
+position. There is no solution but installing a more
+cooperative--and preferably free--input method.
+
+** The default input method sometimes performs edits out of place in large
buffers.
+
+When first reactivated in a window after having been dismissed, certain
+heuristics applied by the "Android Keyboard (AOSP)" input method to
+detect unresponsive text editors, which are ill-adapted to buffers
+greater than a few thousand characters in length, conclude that Emacs is
+misbehaving, so that the input method ignores updates to the position of
+point reported around the time of its activation, and edits suggested by
+the input method are inserted in a previously reported location that
+might be wildly removed from the current insertion point. This is a bug
+in the input method that can be easily reproduced by inserting lengthy
+documents into any text editor, with no real solution except avoiding
+edit suggestions from recently-reactivated input methods.
+
* Build-time problems
** Configuration
diff --git a/etc/compilation.txt b/etc/compilation.txt
index 05f0829864c..44388e1f197 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -523,6 +523,45 @@ NoMethodError: undefined method `not_exists' for
nil:NilClass
4 tests, 3 assertions, 3 failures, 1 errors
+* Rust
+
+symbol: cargo
+
+The [] part is optional, and the file names are always relative to
+project's root.
+
+error[E0425]: cannot find function `ruun` in module `broot::cli`
+ --> src/main.rs:6:23
+ |
+6 | match broot::cli::ruun() {
+ | ^^^^ help: a function with a similar name exists:
`run`
+ |
+ ::: /tmp/broot/src/cli/mod.rs:49:1
+ |
+49 | pub fn run() -> Result<Option<Launchable>, ProgramError> {
+ | -------------------------------------------------------- similarly
+ named function `run` defined here
+
+error: cannot find macro `deebug` in this scope
+ --> src/main.rs:5:5
+ |
+5 | deebug!("env::args(): {:#?}",
std::env::args().collect::<Vec<String>>());
+ | ^^^^^^ help: a macro with a similar name exists: `debug`
+ |
+ :::
/home/ergo/.cargo/registry/src/index.crates.io-6f17d22bba15001f/log-0.4.21/src/macros.rs:154:1
+ |
+154 | macro_rules! debug {
+ | ------------------ similarly named macro `debug` defined here
+
+warning: crate-level attribute should be an inner attribute: add an
exclamation mark: `#![foo]`
+ --> src/main.rs:3:1
+ |
+3 | #[feature(proc_macro_diagnostic)]
+ | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ |
+ = note: `#[warn(unused_attributes)]` on by default
+
+
* RXP
symbol: rxp
diff --git a/etc/schema/README b/etc/schema/README
index 08dfe45dfbb..7611652762c 100644
--- a/etc/schema/README
+++ b/etc/schema/README
@@ -113,3 +113,23 @@ Software License:
specific, written prior permission. Title to copyright in this
software and any associated documentation will at all times remain
with copyright holders.
+
+
+The following files are related to .NET development:
+
+ dotnet-appconfig.rnc dotnet-packages-config.rnc
+ dotnet-packages.props dotnet-resx.rnc msbuild.rnc nuget.rnc
+ nuspec.rnc
+
+These files are derived/inferred from files from numerous .NET projects,
+whose contents have been created based on public documentation provided
+by Microsoft, or created using the documentation as is.
+
+Links to various related resources:
+- app.config:
https://learn.microsoft.com/en-us/dotnet/framework/configure-apps/file-schema/
+- Directory.Packages.Props:
https://learn.microsoft.com/en-us/nuget/consume-packages/central-package-management
+- MSBuild: https://learn.microsoft.com/en-us/visualstudio/msbuild
+- Nuspec: https://learn.microsoft.com/en-us/nuget/reference/nuspec
+- Nuget.config:
https://learn.microsoft.com/en-us/nuget/reference/nuget-config-file
+- Packages.config:
https://learn.microsoft.com/en-us/nuget/reference/packages-config
+- Resx: Xsd-schema as included in default Resx-files generated by Resxen.exe
diff --git a/etc/schema/dotnet-appconfig.rnc b/etc/schema/dotnet-appconfig.rnc
new file mode 100644
index 00000000000..7e108672ed9
--- /dev/null
+++ b/etc/schema/dotnet-appconfig.rnc
@@ -0,0 +1,411 @@
+default namespace = ""
+namespace ns1 = "http://schemas.microsoft.com/.NetConfiguration/v2.0";
+namespace ns2 = "urn:schemas-microsoft-com:asm.v1"
+namespace xdt = "http://schemas.microsoft.com/XML-Document-Transform";
+
+start =
+ element configuration {
+ element configSections { (section | sectionGroup)* }?,
+ element system.web.webPages.razor {
+ element host {
+ attribute factoryType { text }
+ },
+ pages
+ }?,
+ (system.web
+ | system.webServer
+ | element location {
+ attribute inheritInChildApplications { xsd:boolean }?,
+ attribute path { text }?,
+ system.web?,
+ system.webServer?
+ }
+ | element runtime {
+ element loadFromRemoteSources {
+ attribute enabled { xsd:boolean }
+ }?,
+ element ns2:assemblyBinding {
+ attribute appliesTo { xsd:NCName }?,
+ element ns2:dependentAssembly {
+ element ns2:Paket { xsd:NCName }?,
+ element ns2:assemblyIdentity {
+ attribute culture { xsd:NCName }?,
+ attribute name { xsd:NCName },
+ attribute publicKeyToken { xsd:NMTOKEN }
+ },
+ element ns2:bindingRedirect {
+ attribute newVersion { xsd:NMTOKEN },
+ attribute oldVersion { xsd:NMTOKEN }
+ }
+ }+
+ }+
+ }
+ | element startup {
+ attribute useLegacyV2RuntimeActivationPolicy { xsd:boolean }?,
+ element supportedRuntime {
+ attribute sku { text },
+ attribute version { xsd:NCName }
+ }
+ }
+ | element system.codedom {
+ element compilers {
+ element compiler {
+ attribute compilerOptions { text }?,
+ attribute extension { xsd:NMTOKEN },
+ attribute language { text },
+ attribute type { text },
+ attribute warningLevel { xsd:integer },
+ element providerOption {
+ attribute name { xsd:NCName },
+ attribute value { xsd:NCName }
+ }*
+ }+
+ }
+ }
+ | element system.diagnostics {
+ element sources {
+ element source {
+ attribute name { xsd:NCName },
+ element listeners { add }?
+ }+
+ }?,
+ (element switches { empty },
+ element sharedListeners { empty },
+ element trace {
+ attribute autoflush { xsd:boolean }
+ })?
+ }
+ | element system.serviceModel {
+ element diagnostics {
+ element messageLogging {
+ attribute logEntireMessage { xsd:boolean },
+ attribute logMalformedMessages { xsd:boolean },
+ attribute logMessagesAtServiceLevel { xsd:boolean },
+ attribute logMessagesAtTransportLevel { xsd:boolean },
+ attribute maxMessagesToLog { xsd:integer },
+ attribute maxSizeOfMessageToLog { xsd:integer }
+ }
+ }?,
+ (element behaviors {
+ element serviceBehaviors {
+ element behavior {
+ attribute name { text }?,
+ element serviceMetadata {
+ attribute httpGetEnabled { xsd:boolean },
+ attribute httpsGetEnabled { xsd:boolean }?
+ },
+ element serviceDebug {
+ attribute httpHelpPageEnabled { xsd:boolean }?,
+ attribute includeExceptionDetailInFaults {
+ xsd:boolean
+ }
+ },
+ element dataContractSerializer {
+ attribute maxItemsInObjectGraph { xsd:integer }
+ }?,
+ (element serviceTelemetry { empty }
+ | element serviceThrottling {
+ attribute maxConcurrentCalls { xsd:integer },
+ attribute maxConcurrentInstances { xsd:integer },
+ attribute maxConcurrentSessions { xsd:integer }
+ })?
+ }
+ }
+ }
+ | element bindings {
+ element basicHttpBinding {
+ element binding {
+ attribute closeTimeout { xsd:time }?,
+ attribute maxBufferSize { xsd:integer }?,
+ attribute maxReceivedMessageSize { xsd:integer }?,
+ attribute name { xsd:NCName }?,
+ attribute openTimeout { xsd:time }?,
+ attribute receiveTimeout { xsd:time }?,
+ attribute sendTimeout { xsd:time }?,
+ element readerQuotas {
+ attribute maxArrayLength { xsd:integer },
+ attribute maxBytesPerRead { xsd:integer }?,
+ attribute maxDepth { xsd:integer }?,
+ attribute maxNameTableCharCount { xsd:integer }?,
+ attribute maxStringContentLength { xsd:integer }
+ }?,
+ security?
+ }+
+ }?
+ }
+ | element client { empty }
+ | element extensions {
+ element behaviorExtensions { add+ },
+ (element bindingElementExtensions { add+ },
+ element bindingExtensions { add+ })?
+ }
+ | element protocolMapping { add+ }
+ | element serviceHostingEnvironment {
+ attribute aspNetCompatibilityEnabled { xsd:boolean }?,
+ attribute multipleSiteBindingsEnabled { xsd:boolean }?
+ })*,
+ element services {
+ element service {
+ attribute behaviorConfiguration { xsd:NCName }?,
+ attribute name { text },
+ element endpoint {
+ attribute address { xsd:NCName }?,
+ attribute binding { xsd:NCName },
+ attribute bindingConfiguration { xsd:NCName }?,
+ attribute contract { xsd:NCName }
+ }+
+ }+
+ }?
+ })*
+ }
+ | element ns1:configuration {
+ element ns1:configSections {
+ element ns1:section {
+ attribute name { xsd:NCName },
+ attribute requirePermission { xsd:boolean },
+ attribute type { text }
+ }
+ },
+ element ns1:appSettings { empty },
+ element ns1:connectionStrings { empty },
+ element ns1:system.web {
+ element ns1:compilation {
+ attribute debug { xsd:boolean },
+ attribute defaultLanguage { text },
+ attribute targetFramework { xsd:decimal }
+ },
+ element ns1:authentication {
+ attribute mode { xsd:NCName }
+ },
+ element ns1:httpModules { ns1.add },
+ element ns1:pages {
+ attribute clientIDMode { xsd:NCName },
+ attribute controlRenderingCompatibilityVersion { xsd:decimal }
+ }
+ },
+ element ns1:system.webServer {
+ element ns1:modules {
+ attribute runAllManagedModulesForAllRequests { xsd:boolean },
+ ns1.add
+ }
+ },
+ element ns1:rewriter {
+ element ns1:rewrite {
+ attribute to { text },
+ attribute url { text }
+ }+
+ }
+ }
+section =
+ element section {
+ attribute allowExeDefinition { xsd:NCName }?,
+ attribute name { xsd:NCName },
+ attribute requirePermission { xsd:boolean }?,
+ attribute restartOnExternalChanges { xsd:boolean }?,
+ attribute type { text }
+ }
+sectionGroup =
+ element sectionGroup {
+ attribute name { xsd:NCName },
+ attribute type { text }?,
+ (section | sectionGroup)+
+ }
+pages =
+ element pages {
+ attribute clientIDMode { xsd:NCName }?,
+ attribute controlRenderingCompatibilityVersion { xsd:decimal }?,
+ attribute enableEventValidation { xsd:boolean }?,
+ attribute pageBaseType { xsd:NCName }?,
+ attribute theme { text }?,
+ attribute validateRequest { xsd:boolean }?,
+ attribute viewStateEncryptionMode { xsd:NCName }?,
+ element namespaces { add+ }?
+ }
+add =
+ element add {
+ attribute assembly { text }?,
+ attribute binding { xsd:NCName }?,
+ attribute bindingConfiguration { text }?,
+ attribute connectionString { xsd:anyURI }?,
+ attribute initializationPage { text }?,
+ attribute initializeData { text }?,
+ attribute input { text }?,
+ attribute key { xsd:anyURI }?,
+ attribute matchType { xsd:NCName }?,
+ attribute modules { xsd:NCName }?,
+ attribute name { xsd:NCName }?,
+ attribute namespace { xsd:NCName }?,
+ attribute negate { xsd:boolean }?,
+ attribute path { text }?,
+ attribute preCondition { text }?,
+ attribute providerName { xsd:NCName }?,
+ attribute resourceType { xsd:NCName }?,
+ attribute responseBufferLimit { xsd:integer }?,
+ attribute scheme { xsd:NCName }?,
+ attribute scriptProcessor { text }?,
+ attribute type { text }?,
+ attribute validate { xsd:boolean }?,
+ attribute value { text }?,
+ attribute verb { text }?,
+ attribute xdt:Locator { text }?,
+ attribute xdt:Transform { xsd:NCName }?
+ }
+security =
+ element security {
+ attribute mode { xsd:NCName }?,
+ attribute xdt:Transform { xsd:NCName }?,
+ (element requestFiltering {
+ attribute removeServerHeader { xsd:boolean },
+ element requestLimits {
+ attribute maxAllowedContentLength { xsd:integer }
+ }?
+ }
+ | element transport {
+ attribute clientCredentialType { xsd:NCName }
+ })?
+ }
+system.webServer =
+ element system.webServer {
+ (element httpErrors {
+ attribute errorMode { xsd:NCName }?,
+ attribute existingResponse { xsd:NCName },
+ (remove+,
+ element error {
+ attribute path { text },
+ attribute prefixLanguageFilePath { text },
+ attribute responseMode { xsd:NCName },
+ attribute statusCode { xsd:integer }
+ }+)?
+ }
+ | element staticContent {
+ element mimeMap {
+ attribute fileExtension { xsd:NMTOKEN },
+ attribute mimeType { text }
+ }+
+ })?,
+ (element applicationInitialization {
+ attribute xdt:Transform { xsd:NCName },
+ add
+ }
+ | element rewrite {
+ element rules {
+ clear
+ | element rule {
+ attribute name { text },
+ attribute stopProcessing { xsd:boolean },
+ element match {
+ attribute url { text }
+ },
+ element conditions {
+ attribute logicalGrouping { xsd:NCName },
+ add+
+ }?,
+ element action {
+ attribute redirectType { xsd:NCName }?,
+ attribute type { xsd:NCName },
+ attribute url { text }
+ }
+ }
+ }
+ })?,
+ (security
+ | element aspNetCore {
+ attribute arguments { text }?,
+ attribute hostingModel { xsd:NCName }?,
+ attribute processPath { text }?,
+ attribute requestTimeout { xsd:time }?,
+ attribute stdoutLogEnabled { xsd:boolean }?,
+ attribute stdoutLogFile { text }?,
+ attribute xdt:Transform { text }?
+ }
+ | element handlers { (add | remove)+ }
+ | element httpProtocol {
+ attribute xdt:Transform { xsd:NCName }?,
+ element customHeaders { clear?, remove+ }
+ }
+ | element modules {
+ attribute runAllManagedModulesForAllRequests { xsd:boolean }?,
+ (add | remove)*
+ }
+ | element validation {
+ attribute validateIntegratedModeConfiguration { xsd:boolean }
+ })*,
+ element directoryBrowse {
+ attribute enabled { xsd:boolean }
+ }?
+ }
+system.web =
+ element system.web {
+ element authorization {
+ element allow {
+ attribute users { text }
+ }
+ }
+ | (pages
+ | element authentication {
+ attribute mode { xsd:NCName }
+ }
+ | element compilation {
+ attribute debug { xsd:boolean }?,
+ attribute targetFramework { xsd:NMTOKEN }?,
+ attribute tempDirectory { text }?,
+ attribute xdt:Transform { text }?,
+ element assemblies { add+ }?
+ }
+ | element customErrors {
+ attribute defaultRedirect { text }?,
+ attribute mode { xsd:NCName },
+ attribute redirectMode { xsd:NCName }?
+ }
+ | element globalization {
+ attribute requestEncoding { xsd:NCName },
+ attribute responseEncoding { xsd:NCName }
+ }
+ | element httpHandlers { add+ }
+ | element httpModules { add* }
+ | element httpRuntime {
+ attribute appRequestQueueLimit { xsd:integer }?,
+ attribute enableVersionHeader { xsd:boolean }?,
+ attribute executionTimeout { xsd:integer }?,
+ attribute maxRequestLength { xsd:integer }?,
+ attribute minFreeThreads { xsd:integer }?,
+ attribute minLocalRequestFreeThreads { xsd:integer }?,
+ attribute requestPathInvalidCharacters { text }?,
+ attribute requestValidationMode { xsd:decimal }?,
+ attribute targetFramework { xsd:NMTOKEN }?,
+ attribute useFullyQualifiedRedirectUrl { xsd:boolean }?
+ }
+ | element identity {
+ attribute impersonate { xsd:boolean }
+ }
+ | element machineKey {
+ attribute validation { xsd:NCName }
+ }
+ | element sessionState {
+ attribute cookieSameSite { xsd:NCName }?,
+ attribute cookieless { xsd:boolean },
+ attribute mode { xsd:NCName },
+ attribute stateConnectionString { text }?,
+ attribute timeout { xsd:integer }
+ }
+ | element xhtmlConformance {
+ attribute mode { xsd:NCName }
+ })*
+ }
+Globalization =
+ element Globalization {
+ element ResourceProviders { empty }
+ | add+
+ }
+ns1.add =
+ element ns1:add {
+ attribute name { xsd:NCName },
+ attribute type { text }
+ }
+remove =
+ element remove {
+ attribute name { xsd:NCName }?,
+ attribute statusCode { xsd:integer }?,
+ attribute subStatusCode { xsd:integer }?
+ }
+clear = element clear { empty }
diff --git a/etc/schema/dotnet-packages-config.rnc
b/etc/schema/dotnet-packages-config.rnc
new file mode 100644
index 00000000000..702f11aca31
--- /dev/null
+++ b/etc/schema/dotnet-packages-config.rnc
@@ -0,0 +1,11 @@
+default namespace = ""
+
+start =
+ element packages {
+ element package {
+ attribute id { xsd:NCName },
+ attribute targetFramework { xsd:NCName }?,
+ attribute allowedVersions { xsd:NCName }?,
+ attribute version { xsd:NMTOKEN }
+ }+
+ }
diff --git a/etc/schema/dotnet-packages-props.rnc
b/etc/schema/dotnet-packages-props.rnc
new file mode 100644
index 00000000000..18c689eb2dd
--- /dev/null
+++ b/etc/schema/dotnet-packages-props.rnc
@@ -0,0 +1,22 @@
+default namespace = ""
+
+start =
+ element Project {
+ element PropertyGroup {
+ element ManagePackageVersionsCentrally { xsd:boolean },
+ element CentralPackageTransitivePinningEnabled { xsd:boolean },
+ element CentralPackageVersionOverrideEnabled { xsd:boolean }
+ }?,
+ element ItemGroup {
+ attribute Condition { text }?,
+ (element GlobalPackageReference {
+ attribute Condition { text }?,
+ attribute Include { xsd:NCName },
+ attribute Version { xsd:NMTOKEN }
+ }+
+ | element PackageVersion {
+ attribute Include { xsd:NCName },
+ attribute Version { text }
+ }+)
+ }+
+ }
diff --git a/etc/schema/dotnet-resx.rnc b/etc/schema/dotnet-resx.rnc
new file mode 100644
index 00000000000..26b77e47527
--- /dev/null
+++ b/etc/schema/dotnet-resx.rnc
@@ -0,0 +1,57 @@
+default namespace = ""
+namespace msdata = "urn:schemas-microsoft-com:xml-msdata"
+namespace xsd = "http://www.w3.org/2001/XMLSchema";
+
+start =
+ element root {
+ element xsd:schema {
+ attribute id { xsd:NCName },
+ element xsd:import {
+ attribute namespace { xsd:anyURI }
+ }?,
+ xsd.element
+ },
+ element resheader {
+ attribute name { xsd:NCName },
+ value
+ }+,
+ (element assembly {
+ attribute alias { xsd:NCName },
+ attribute name { text }
+ }
+ | element data {
+ attribute mimetype { text }?,
+ attribute name { text },
+ attribute type { text }?,
+ attribute xml:space { xsd:NCName }?,
+ value
+ }
+ | element metadata {
+ attribute name { xsd:NCName },
+ attribute type { text },
+ value
+ })*
+ }
+xsd.element =
+ element xsd:element {
+ attribute minOccurs { xsd:integer }?,
+ attribute name { xsd:NCName },
+ attribute type { xsd:NMTOKEN }?,
+ attribute msdata:IsDataSet { xsd:boolean }?,
+ attribute msdata:Ordinal { xsd:integer }?,
+ element xsd:complexType {
+ element xsd:choice {
+ attribute maxOccurs { xsd:NCName },
+ xsd.element+
+ }?,
+ element xsd:sequence { xsd.element+ }?,
+ element xsd:attribute {
+ attribute name { xsd:NCName }?,
+ attribute ref { xsd:NMTOKEN }?,
+ attribute type { xsd:NMTOKEN }?,
+ attribute use { xsd:NCName }?,
+ attribute msdata:Ordinal { xsd:integer }?
+ }*
+ }*
+ }
+value = element value { text }
diff --git a/etc/schema/msbuild.rnc b/etc/schema/msbuild.rnc
new file mode 100644
index 00000000000..9425bbdf0b9
--- /dev/null
+++ b/etc/schema/msbuild.rnc
@@ -0,0 +1,1041 @@
+default namespace = ""
+namespace ns1 = "http://schemas.microsoft.com/developer/msbuild/2003";
+
+start = Project | ns1.Project
+Project =
+ element Project {
+ attribute Sdk { text }?,
+ (text
+ | ItemGroup
+ | PropertyGroup
+ | element Import {
+ attribute Project { text }
+ }
+ | element ProjectExtensions {
+ element VisualStudio {
+ element FlavorProperties {
+ attribute GUID { text },
+ element WebProjectProperties {
+ element UseIIS { xsd:NCName },
+ element AutoAssignPort { xsd:NCName },
+ element DevelopmentServerPort { xsd:integer },
+ element DevelopmentServerVPath { text },
+ element IISUrl { xsd:anyURI },
+ element NTLMAuthentication { xsd:NCName },
+ element UseCustomServer { xsd:NCName },
+ element CustomServerUrl { empty },
+ element SaveServerSettingsInUserFile { xsd:NCName }
+ }
+ }
+ | element UserProperties {
+ attribute configuration_4bicepconfig_1json__JsonSchema {
+ xsd:anyURI
+ }
+ }
+ }
+ }
+ | element Target {
+ attribute AfterTargets { xsd:NCName }?,
+ attribute BeforeTargets { xsd:NCName }?,
+ attribute Condition { text }?,
+ attribute DependsOnTargets { text }?,
+ attribute Inputs { text }?,
+ attribute Name { xsd:NCName },
+ attribute Outputs { text }?,
+ (PropertyGroup
+ | (element RemoveDir {
+ attribute Condition { text },
+ attribute Directories { text }
+ },
+ element Delete {
+ attribute Condition { text },
+ attribute Files { text }
+ }))?,
+ (ItemGroup
+ | element Error {
+ attribute Condition { text },
+ attribute Text { text }
+ }
+ | element Exec {
+ attribute Command { text },
+ attribute Condition { text }?,
+ attribute ContinueOnError { xsd:boolean }?,
+ attribute EnvironmentVariables { text }?,
+ attribute WorkingDirectory { text }?,
+ element Output {
+ attribute PropertyName { xsd:NCName },
+ attribute TaskParameter { xsd:NCName }
+ }?
+ }
+ | element MakeDir {
+ attribute Directories { text }
+ }
+ | element Message {
+ attribute Condition { text }?,
+ attribute Importance { xsd:NCName },
+ attribute Text { text }
+ })*,
+ (element Copy {
+ attribute DestinationFolder { text },
+ attribute SourceFiles { text }
+ }
+ | element MSBuild {
+ attribute BuildInParallel { xsd:boolean },
+ attribute Projects { text },
+ attribute Properties { text },
+ attribute Targets { xsd:NCName }
+ })?
+ })+
+ }
+ns1.Project =
+ element ns1:Project {
+ attribute DefaultTargets { xsd:NCName }?,
+ attribute ToolsVersion { xsd:decimal }?,
+ (text
+ | ns1.ItemGroup
+ | ns1.PropertyGroup
+ | element ns1:Choose {
+ element ns1:When {
+ attribute Condition { text },
+ (ns1.PropertyGroup | ns1.ItemGroup+)
+ }+,
+ element ns1:Otherwise { ns1.ItemGroup }?
+ }
+ | element ns1:Import {
+ attribute Condition { text }?,
+ attribute Label { xsd:NCName }?,
+ attribute Project { text }
+ }
+ | element ns1:ProjectExtensions {
+ element ns1:VisualStudio {
+ element ns1:FlavorProperties {
+ attribute GUID { text },
+ (element ns1:WebProjectProperties {
+ (element ns1:UseIIS { xsd:NCName },
+ element ns1:AutoAssignPort { xsd:NCName },
+ element ns1:DevelopmentServerPort { xsd:integer },
+ element ns1:DevelopmentServerVPath { text },
+ element ns1:IISUrl { xsd:anyURI },
+ element ns1:NTLMAuthentication { xsd:NCName },
+ element ns1:UseCustomServer { xsd:NCName },
+ element ns1:CustomServerUrl { empty })?,
+ element ns1:SaveServerSettingsInUserFile { xsd:NCName }
+ }
+ | (element ns1:ProjectProperties {
+ attribute AddItemTemplatesGuid { text },
+ attribute ApplicationType { xsd:NCName },
+ attribute DebugInfoExeName { text },
+ attribute HostName { xsd:NCName },
+ attribute HostPackage { text },
+ attribute Language { xsd:NCName },
+ attribute OfficeVersion { xsd:decimal },
+ attribute TemplatesPath { xsd:NCName },
+ attribute VstxVersion { xsd:decimal }
+ },
+ element ns1:Host {
+ attribute GeneratedCodeNamespace { xsd:NCName },
+ attribute IconIndex { xsd:integer },
+ attribute Name { xsd:NCName },
+ attribute PublishedHash { text },
+ element ns1:HostItem {
+ attribute Blueprint { xsd:NCName },
+ attribute CanActivate { xsd:boolean },
+ attribute CanonicalName { xsd:NCName },
+ attribute Code { xsd:NCName },
+ attribute GeneratedCode { xsd:NCName },
+ attribute IconIndex { xsd:integer },
+ attribute Name { xsd:NCName },
+ attribute PublishedHash { text }
+ }
+ }))
+ }
+ | element ns1:UserProperties {
+ attribute Name { xsd:NCName }
+ }
+ }
+ }
+ | element ns1:Target {
+ attribute AfterTargets { xsd:NCName }?,
+ attribute BeforeTargets { xsd:NCName }?,
+ attribute Condition { text }?,
+ attribute Name { xsd:NCName },
+ attribute Outputs { text }?,
+ (ns1.PropertyGroup
+ | element ns1:Error {
+ attribute Condition { text },
+ attribute HelpKeyword { xsd:NCName },
+ attribute Text { text }
+ }*
+ | (ns1.ItemGroup
+ | element ns1:MakeDir {
+ attribute Directories { text }
+ }
+ | element ns1:WriteCodeFragment {
+ attribute AssemblyAttributes { text },
+ attribute Language { text },
+ attribute OutputFile { text }
+ })*),
+ (element ns1:Copy {
+ attribute ContinueOnError { xsd:boolean }?,
+ attribute DestinationFolder { text },
+ attribute OverwriteReadOnlyFiles { xsd:NCName },
+ attribute SourceFiles { text }
+ }
+ | element ns1:CreateItem {
+ attribute Exclude { text }?,
+ attribute Include { text },
+ ns1.Output
+ }
+ | element ns1:Delete {
+ attribute Files { text },
+ attribute TreatErrorsAsWarnings { xsd:NCName }
+ }
+ | element ns1:Exec {
+ attribute Command { text },
+ attribute WorkingDirectory { text }?
+ }
+ | element ns1:GetVersionParts {
+ attribute AssemblyPath { text },
+ ns1.Output+
+ }
+ | element ns1:Message {
+ attribute Importance { xsd:NCName }?,
+ attribute Text { text }
+ }
+ | element ns1:TokenReplace {
+ attribute Condition { text }?,
+ attribute Destination { text },
+ attribute Path { text },
+ attribute Replacement { text },
+ attribute Token { text }
+ })*,
+ element ns1:CallTarget {
+ attribute Condition { text }?,
+ attribute Targets { xsd:NCName }
+ }?
+ }
+ | element ns1:UsingTask {
+ attribute AssemblyFile { text },
+ attribute TaskFactory { xsd:NCName },
+ attribute TaskName { xsd:NCName },
+ element ns1:ParameterGroup {
+ (element ns1:Path {
+ attribute ParameterType { xsd:NCName },
+ attribute Required { xsd:boolean }
+ },
+ element ns1:Destination {
+ attribute ParameterType { xsd:NCName },
+ attribute Required { xsd:boolean }
+ },
+ element ns1:Token {
+ attribute ParameterType { xsd:NCName },
+ attribute Required { xsd:boolean }
+ },
+ element ns1:Replacement {
+ attribute ParameterType { xsd:NCName },
+ attribute Required { xsd:boolean }
+ })
+ | (element ns1:AssemblyPath {
+ attribute ParameterType { xsd:NCName },
+ attribute Required { xsd:boolean }
+ },
+ element ns1:MajorVersion {
+ attribute Output { xsd:boolean },
+ attribute ParameterType { xsd:NCName }
+ },
+ element ns1:MinorVersion {
+ attribute Output { xsd:boolean },
+ attribute ParameterType { xsd:NCName }
+ },
+ element ns1:BuildVersion {
+ attribute Output { xsd:boolean },
+ attribute ParameterType { xsd:NCName }
+ },
+ element ns1:RevisionVersion {
+ attribute Output { xsd:boolean },
+ attribute ParameterType { xsd:NCName }
+ })
+ },
+ element ns1:Task {
+ element ns1:Using {
+ attribute Namespace { xsd:NCName }
+ }?,
+ element ns1:Code {
+ attribute Language { xsd:NCName },
+ attribute Type { xsd:NCName },
+ text
+ }
+ }
+ })+
+ }
+PropertyGroup =
+ element PropertyGroup {
+ attribute Condition { text }?,
+ attribute Label { xsd:NCName }?,
+ element TargetFrameworks { text }?,
+ (element DotnetMonoRepoVersion { xsd:NMTOKEN }
+ | (element CFBundleName { text },
+ element CFBundleDisplayName { text },
+ element CFBundleIdentifier { xsd:NCName },
+ element CFBundleVersion { xsd:NMTOKEN },
+ element CFBundleShortVersionString { xsd:NMTOKEN },
+ element CFBundlePackageType { xsd:NCName },
+ element CFBundleExecutable { xsd:NCName },
+ element CFBundleIconFile { xsd:NCName },
+ element NSPrincipalClass { xsd:NCName },
+ element NSHighResolutionCapable { xsd:boolean }))?,
+ (element SoAssemblyFileVersion {
+ attribute Condition { text },
+ xsd:NMTOKEN
+ },
+ element SoReleaseVersion {
+ attribute Condition { text },
+ text
+ })?,
+ (element AccelerateBuildsInVisualStudio { xsd:boolean }
+ | element AddLicenseAsEmbeddedResource { xsd:boolean }
+ | element AddNoticeAsEmbeddedResource { xsd:boolean }
+ | element AnalysisMode { xsd:NCName }
+ | element ApiName {
+ attribute Condition { text },
+ xsd:NCName
+ }
+ | element AppConfig { xsd:NCName }
+ | element AppendTargetFrameworkToOutputPath { xsd:boolean }
+ | element ApplicationIcon { text }
+ | element ApplicationManifest { xsd:NCName }
+ | element AspNetCoreHostingModel { xsd:NCName }
+ | element AssemblyName { text }
+ | element AssemblyOriginatorKeyFile { text }
+ | element AssemblyTitle { text }
+ | element AssemblyVersion { xsd:NMTOKEN }
+ | element Authors { text }
+ | element AutoGenerateBindingRedirects {
+ attribute Condition { text }?,
+ xsd:boolean
+ }
+ | element AzureFunctionsVersion { xsd:NCName }
+ | element BicepCompileAfterTargets { xsd:NCName }
+ | element BicepCompileBeforeTargets { xsd:NCName }
+ | element BootstrapperEnabled { xsd:boolean }
+ | element BuildOutputTargetFolder { xsd:NCName }
+ | element BuildServerSideRenderer { xsd:boolean }
+ | element BuiltInComInteropSupport { xsd:boolean }
+ | element CentralPackageTransitivePinningEnabled { xsd:boolean }
+ | element CodeAnalysisTreatWarningsAsErrors { xsd:boolean }
+ | element Company { text }
+ | element CopyLocalLockFileAssemblies { xsd:boolean }
+ | element Copyright { text }
+ | element DebugType {
+ attribute Condition { text }?,
+ xsd:NCName
+ }
+ | element DefaultItemExcludes { text }
+ | element DefineConstants { text }
+ | element DelaySign { xsd:boolean }
+ | element Description { text }
+ | element Deterministic { xsd:boolean }
+ | element DisableImplicitNuGetFallbackFolder { xsd:boolean }
+ | element DisableTransitiveProjectReferences { xsd:boolean }
+ | element DockerDefaultTargetOS { xsd:NCName }
+ | element DockerfileContext { text }
+ | element EmbedUntrackedSources { xsd:boolean }
+ | element EnableCompressionInSingleFile { xsd:boolean }
+ | element EnableDefaultCompileItems { xsd:boolean }
+ | element EnableDefaultEmbeddedResourceItems { xsd:boolean }
+ | element EnableMSTestRunner { xsd:boolean }
+ | element EnableNETAnalyzers { xsd:boolean }
+ | element EnableNuget { xsd:boolean }
+ | element EnableTrimAnalyzer { xsd:boolean }
+ | element EnforceCodeStyleInBuild { xsd:boolean }
+ | element ErrorReport { xsd:NCName }
+ | element FileVersion { xsd:NMTOKEN }
+ | element FindInvalidProjectReferences { xsd:boolean }
+ | element GenerateAssemblyInfo { xsd:boolean }
+ | element GenerateBindingRedirectsOutputType { xsd:boolean }
+ | element GenerateDocumentationFile { xsd:NCName }
+ | element GeneratePackageOnBuild { xsd:NCName }
+ | element GenerateResourceUsePreserializedResources { xsd:boolean }
+ | element ImplicitUsings { xsd:NCName }
+ | element IncludeNativeLibrariesForSelfExtract { xsd:boolean }
+ | element IncludeSymbols { xsd:boolean }
+ | element IsPackable { xsd:boolean }
+ | element LangVersion { xsd:NMTOKEN }
+ | element ManagePackageVersionsCentrally { xsd:boolean }
+ | element MapFileExtensions { xsd:boolean }
+ | element NoPackageAnalysis { xsd:boolean }
+ | element NoWarn { text }
+ | element Nullable { xsd:NCName }
+ | element Optimize { xsd:boolean }
+ | element OutputPath { text }
+ | element OutputType { xsd:NCName }
+ | element PackAsTool { xsd:boolean }
+ | element PackageIcon { text }
+ | element PackageIconUrl { empty }
+ | element PackageId { text }
+ | element PackageLicenseFile { xsd:NCName }
+ | element PackageProjectUrl { xsd:anyURI }
+ | element PackageReleaseNotes { text }
+ | element PackageTags { text }
+ | element PlatformTarget { xsd:NCName }
+ | element Platforms { text }
+ | element Prefer32Bit { xsd:boolean }
+ | element ProduceReferenceAssembly { xsd:NCName }
+ | element Product { text }
+ | element ProjectGuid { text }
+ | element PublishRepositoryUrl { xsd:boolean }
+ | element PublishSingleFile { xsd:boolean }
+ | element RepositoryType { empty }
+ | element RepositoryUrl { empty }
+ | element RestoreLockedMode {
+ attribute Condition { text },
+ xsd:boolean
+ }
+ | element RestorePackagesWithLockFile { xsd:boolean }
+ | element RestoreProjectStyle { xsd:NCName }
+ | element RootNamespace { text }
+ | element RunPostBuildEvent { xsd:NCName }
+ | element RunSettingsFilePath { text }
+ | element RuntimeIdentifier { xsd:NCName }
+ | element RuntimeIdentifiers {
+ attribute Condition { text }?,
+ text
+ }
+ | element SatelliteResourceLanguages { xsd:NCName }
+ | element SelfContained { xsd:boolean }
+ | element SignAssembly { xsd:NCName }
+ | element SoVersionOptions { xsd:NCName }
+ | element SpaRoot { text }
+ | element StartupObject { xsd:NCName }
+ | element Summary { text }
+ | element SupportedOSPlatformVersion { xsd:decimal }
+ | element SuppressTrimAnalysisWarnings { xsd:boolean }
+ | element SymbolPackageFormat { xsd:NCName }
+ | element TargetFramework { text }
+ | element Title { text }
+ | element ToolCommandName { xsd:NCName }
+ | element TreatWarningsAsErrors { xsd:boolean }
+ | element TrimMode { xsd:NCName }
+ | element TypeScriptCompileBlocked {
+ attribute Condition { text }?,
+ xsd:boolean
+ }
+ | element TypeScriptToolsVersion { xsd:NCName }
+ | element UseAppHost { xsd:boolean }
+ | element UseApplicationTrust { xsd:boolean }
+ | element UseWPF { xsd:boolean }
+ | element UseWindowsForms { xsd:boolean }
+ | element UserSecretsId { text }
+ | element Version {
+ attribute Condition { text }?,
+ text
+ }
+ | element WarningsAsErrors { text }
+ | element WarningsNotAsErrors { text }
+ | element WasmMainJSPath { text })*,
+ (element PackageRequireLicenseAcceptance { xsd:boolean }
+ | element _FunctionsSkipCleanOutput { xsd:boolean }
+ | (element OutDir { text },
+ element ExcludeXmlAssemblyFiles { xsd:boolean }))?,
+ element EnableUnsafeBinaryFormatterSerialization { xsd:boolean }?,
+ (element AssemblySearchPaths { text }
+ | element AvaloniaUseCompiledBindingsByDefault { xsd:boolean }
+ | element BaseOutputPath { text }
+ | element BicepOutputStyle { xsd:NCName }
+ | element ContinuousIntegrationBuild { xsd:boolean }
+ | element DebugSymbols { xsd:boolean }
+ | element DefaultDocumentationIncludeUndocumentedItems {
+ xsd:boolean
+ }
+ | element DscZipFile { text }
+ | element EnableNoticeInPublishOutput { xsd:boolean }
+ | element GenerateDocumentation { xsd:boolean }
+ | element IncludeAllContentForSelfExtract { xsd:boolean }
+ | element IsTestProject { xsd:boolean }
+ | element NetSdk { xsd:NCName }
+ | element ResolveAssemblyWarnOrErrorOnTargetArchitectureMismatch {
+ xsd:NCName
+ }
+ | element ShouldIncludeNativeSkiaSharp { xsd:NCName }
+ | element TargetsForTfmSpecificBuildOutput { text }
+ | (element SccProjectName { xsd:NCName },
+ element SccProvider { xsd:NCName },
+ element SccAuxPath { xsd:NCName },
+ element SccLocalPath { xsd:NCName })
+ | (element GenerateNoticePackageVersion { xsd:NMTOKEN },
+ element GenerateNoticeRetryCount { xsd:integer },
+ element GenerateNoticeBatchSize { xsd:integer },
+ element GenerateNoticeUseLocalFile {
+ attribute Condition { text },
+ xsd:boolean
+ },
+ element GenerateNoticeUpdateLocalFile {
+ attribute Condition { text },
+ xsd:boolean
+ })
+ | (element RunNswag { xsd:boolean },
+ element RunNodeBuild { xsd:boolean })
+ | (element PublishTrimmed { xsd:boolean },
+ element JsonSerializerIsReflectionEnabledByDefault {
+ xsd:boolean
+ })
+ | (element ApplicationId { xsd:NCName },
+ element ApplicationVersion { xsd:integer },
+ element ApplicationDisplayVersion { xsd:decimal },
+ element AndroidPackageFormat { xsd:NCName },
+ element AndroidEnableProfiledAot { xsd:NCName })
+ | (element DefaultDocumentationFolder { text },
+ element DefaultDocumentationLinksBaseUrl { text },
+ element DefaultDocumentationLinksOutputFile { text },
+ element DefaultDocumentationExternLinksFiles { text },
+ element DefaultDocumentationConfigurationFile { text }))?,
+ element ServiceName { xsd:NCName }?,
+ (element RazorLangVersion { xsd:decimal }
+ | (element WebRoot { text },
+ element WebProjectFile { text },
+ element WebOutputPath { text }))?,
+ element ClientName { text }?,
+ element DisableDataAnnotationsParam { text }?,
+ (element AvaloniaVersion { xsd:NMTOKEN }
+ | element ContinuePackingAfterGeneratingNuspec { xsd:boolean }
+ | ((element NSwagGenerateExceptionClasses { xsd:boolean }
+ | element WrapResponseMethods { text })+,
+ element NSwagOptions { text })
+ | (element DeployDefaultTargetFrameworkVersion { xsd:decimal },
+ element VisualStudioVersion {
+ attribute Condition { text },
+ xsd:decimal
+ }))?
+ }
+ItemGroup =
+ element ItemGroup {
+ attribute Condition { text }?,
+ (element ApiClientGen {
+ attribute Include { xsd:NCName }
+ }
+ | element AvaloniaXaml {
+ attribute Remove { text }
+ }
+ | element BuildOutputInPackage {
+ attribute Include { text },
+ attribute TargetPath { text }
+ }
+ | element InternalsVisibleTo {
+ attribute Condition { text },
+ attribute Include { text }
+ }
+ | element ProjectsToPublish {
+ attribute Include { text }
+ }
+ | element Service {
+ attribute Include { text }
+ }
+ | element _ReferenceCopyLocalPaths {
+ attribute Include { text }
+ }
+ | element ClaimsRequirement {
+ attribute Include { xsd:NCName }
+ }*),
+ element WCFMetadata {
+ attribute Include { text }
+ }?,
+ (element AdditionalFiles {
+ attribute Remove { text }
+ }
+ | element SourceRoot {
+ attribute Include { text }
+ }
+ | element ApiClient {
+ attribute Include { xsd:NCName }
+ }*),
+ element FrameworkReference {
+ attribute Include { xsd:NCName }
+ }?,
+ (element COMReference {
+ attribute Include { xsd:NCName },
+ element Guid { text },
+ element VersionMajor { xsd:integer },
+ element VersionMinor { xsd:integer },
+ element Lcid { xsd:integer },
+ element WrapperTool { xsd:NCName },
+ element Isolated { xsd:NCName },
+ EmbedInteropTypes
+ }
+ | element TrimmerRootDescriptor {
+ attribute Include { xsd:NCName }
+ }
+ | element Watch {
+ attribute Exclude { text }?,
+ attribute Include { text }?,
+ attribute Remove { text }?
+ }*
+ | element AvaloniaResource {
+ attribute Include { text }?,
+ attribute Remove { text }?
+ }*
+ | element OpenApiReference {
+ attribute ClassName { text }?,
+ attribute Include { text },
+ attribute Namespace { text }?,
+ attribute Options { text }?,
+ element CodeGenerator { xsd:NCName }?
+ }*),
+ element Bicep {
+ attribute Exclude { text }?,
+ attribute Include { text }?,
+ attribute NoBuild { xsd:boolean }?,
+ attribute OutputFile { text }?,
+ attribute Update { text }?,
+ element OutputFile { text }?
+ }*,
+ (element Folder {
+ attribute Include { text }
+ }*
+ | element BicepParam {
+ attribute Include { text }
+ }*),
+ (element Compile {
+ attribute Include { text }?,
+ attribute Link { xsd:NCName }?,
+ attribute Remove { text }?,
+ attribute Update { text }?,
+ Link?,
+ (DependentUpon
+ | element AutoGen { xsd:NCName }
+ | element DesignTime { xsd:NCName })*,
+ (SubType
+ | element DesignTimeSharedInput { xsd:NCName })?
+ }
+ | element Content {
+ attribute CopyToOutputDirectory { xsd:NCName }?,
+ attribute CopyToPublishDirectory { xsd:NCName }?,
+ attribute Exclude { text }?,
+ attribute Include { text }?,
+ attribute Link { text }?,
+ attribute PackagePath { text }?,
+ attribute Remove { text }?,
+ attribute Update { text }?,
+ Link?,
+ (CopyToOutputDirectory
+ | CopyToPublishDirectory
+ | DependentUpon
+ | ExcludeFromSingleFile
+ | SubType)*
+ }
+ | element EmbeddedResource {
+ attribute Condition { text }?,
+ attribute Include { text }?,
+ attribute Link { text }?,
+ attribute LogicalName { text }?,
+ attribute Remove { text }?,
+ attribute Update { text }?,
+ attribute WithCulture { xsd:boolean }?,
+ CopyToOutputDirectory?,
+ element CustomToolNamespace { xsd:NCName }?,
+ element LogicalName { text }?,
+ (Generator | LastGenOutput)*,
+ SubType?,
+ Link?,
+ (DependentUpon
+ | element WithCulture { xsd:boolean })?
+ }
+ | element None {
+ attribute CopyToOutputDirectory { xsd:NCName }?,
+ attribute CopyToPublishDirectory { xsd:NCName }?,
+ attribute Exclude { text }?,
+ attribute Include { text }?,
+ attribute Link { xsd:NCName }?,
+ attribute Pack { xsd:boolean }?,
+ attribute PackagePath { text }?,
+ attribute Remove { text }?,
+ attribute Update { text }?,
+ Generator?,
+ (LastGenOutput
+ | SubType
+ | (element Pack { xsd:NCName }
+ | element PackagePath { empty })*),
+ CopyToOutputDirectory?,
+ (CopyToPublishDirectory | DependentUpon)?
+ }
+ | element Resource {
+ attribute Include { text }
+ }
+ | element WCFMetadataStorage {
+ attribute Include { text }
+ })*,
+ (element AndroidResource {
+ attribute Include { xsd:NCName },
+ Link
+ }
+ | element DesignData {
+ attribute Include { text }
+ }
+ | element WasmExtraFilesToDeploy {
+ attribute Include { text }
+ }
+ | element Using {
+ attribute Alias { xsd:NCName }?,
+ attribute Include { xsd:NCName }
+ }*
+ | element DocumentName {
+ attribute Include { xsd:NCName }
+ }*
+ | (element PackageDownload {
+ attribute Include { xsd:NCName },
+ attribute Version { text }
+ }
+ | element PackageReference {
+ attribute Condition { text }?,
+ attribute ExcludeAssets { xsd:NCName }?,
+ attribute Include { text },
+ attribute PrivateAssets { xsd:NCName }?,
+ attribute Version { text }?,
+ (element IncludeAssets { text }
+ | element PrivateAssets { xsd:NCName })*
+ }
+ | element ProjectReference {
+ attribute Include { text }?,
+ attribute PrivateAssets { xsd:NCName }?,
+ attribute Remove { xsd:NCName }?,
+ (element Properties { text }
+ | (Project,
+ element Name { xsd:NCName }))?
+ }
+ | element Reference {
+ attribute Include { text },
+ (EmbedInteropTypes
+ | element HintPath {
+ attribute Condition { text }?,
+ text
+ }
+ | element Private { xsd:NCName }
+ | element SpecificVersion { xsd:NCName })*
+ })*
+ | (element DistFiles {
+ attribute Condition { text }?,
+ attribute Include { text }
+ }+,
+ element ResolvedFileToPublish {
+ attribute Exclude { text },
+ attribute Include { text },
+ element RelativePath { text },
+ CopyToPublishDirectory,
+ ExcludeFromSingleFile?
+ })
+ | element TypeScriptCompile {
+ attribute Include { text }?,
+ attribute Remove { text }?,
+ DependentUpon?
+ }*
+ | element Page {
+ attribute Generator { xsd:NMTOKEN }?,
+ attribute Include { text }?,
+ attribute Remove { text }?,
+ attribute SubType { xsd:NCName }?
+ }*)
+ }
+ns1.PropertyGroup =
+ element ns1:PropertyGroup {
+ attribute Condition { text }?,
+ (element ns1:NugetFolder { text },
+ element ns1:BuildFolder { text })?,
+ element ns1:SoReleaseVersion { text }?,
+ (element ns1:ApplicationManifest { xsd:NCName }
+ | element ns1:ErrorText { text }
+ | element ns1:__paket__NETStandard_Library_targets { text })?,
+ element ns1:PreBuildEvent {
+ attribute Condition { text }?,
+ text
+ }?,
+ element ns1:__paket__MSTest_TestFramework_targets { text }?,
+ element ns1:SoLegacyVersion { xsd:NCName }?,
+ element ns1:SoBetaTag { empty }?,
+ element ns1:ComputerName { text }?,
+ element ns1:__paket__MSTest_TestAdapter_props { text }?,
+ element ns1:__paket__MSTest_TestAdapter_targets { text }?,
+ element ns1:MinimumVisualStudioVersion { xsd:decimal }?,
+ (element ns1:AppDesignerFolder { xsd:NCName }
+ | element ns1:ApplicationRevision { xsd:integer }
+ | element ns1:ApplicationVersion { text }
+ | element ns1:AssemblyName { xsd:NCName }
+ | element ns1:AssemblyOriginatorKeyFile { text }
+ | element ns1:AutoGenerateBindingRedirects { xsd:boolean }
+ | element ns1:AutoIncrementApplicationRevision { xsd:boolean }
+ | element ns1:BootstrapperEnabled { xsd:boolean }
+ | element ns1:CodeAnalysisRuleSet { text }
+ | element ns1:Configuration {
+ attribute Condition { text },
+ xsd:NCName
+ }
+ | element ns1:DebugSymbols { xsd:boolean }
+ | element ns1:DebugType { xsd:NCName }
+ | element ns1:DefineConstants { text }
+ | element ns1:DependsOnNETStandard { xsd:NCName }
+ | element ns1:Deterministic { xsd:boolean }
+ | element ns1:DocumentationFile { text }
+ | element ns1:EnableUnmanagedDebugging { xsd:boolean }
+ | element ns1:ErrorReport { xsd:NCName }
+ | element ns1:FileAlignment { xsd:integer }
+ | element ns1:FileUpgradeFlags { empty }
+ | element ns1:FindInvalidProjectReferences { xsd:boolean }
+ | element ns1:FriendlyName { xsd:NCName }
+ | element ns1:GenerateBindingRedirectsOutputType { xsd:boolean }
+ | element ns1:IISExpressAnonymousAuthentication { empty }
+ | element ns1:IISExpressSSLPort { text }
+ | element ns1:IISExpressUseClassicPipelineMode { empty }
+ | element ns1:IISExpressWindowsAuthentication { empty }
+ | element ns1:Install { xsd:boolean }
+ | element ns1:InstallFrom { xsd:NCName }
+ | element ns1:InstallUrl { empty }
+ | element ns1:IsCodedUITest { xsd:NCName }
+ | element ns1:IsWebBootstrapper { xsd:NCName }
+ | element ns1:LoadBehavior { xsd:integer }
+ | element ns1:ManifestCertificateThumbprint { text }
+ | element ns1:ManifestKeyFile { text }
+ | element ns1:MapFileExtensions { xsd:boolean }
+ | element ns1:NoStandardLibraries { xsd:boolean }
+ | element ns1:NoWarn { text }
+ | element ns1:NuGetPackageImportStamp { empty }
+ | element ns1:NugetExe { text }
+ | element ns1:OfficeApplicationDescription { empty }
+ | element ns1:OldToolsVersion { xsd:decimal }
+ | element ns1:Optimize { xsd:boolean }
+ | element ns1:OutputPath { text }
+ | element ns1:OutputType { xsd:NCName }
+ | element ns1:PackageDestinationDirectory { text }
+ | element ns1:Platform {
+ attribute Condition { text },
+ xsd:NCName
+ }
+ | element ns1:PlatformTarget { xsd:NCName }
+ | element ns1:Prefer32Bit { xsd:boolean }
+ | element ns1:ProductName { xsd:NCName }
+ | element ns1:ProductVersion { text }
+ | element ns1:ProjectGuid { text }
+ | element ns1:ProjectTypeGuids { text }
+ | element ns1:PublishUrl { text }
+ | element ns1:PublisherName { empty }
+ | element ns1:ReferencePath { text }
+ | element ns1:RestorePackages { xsd:boolean }
+ | element ns1:RootNamespace { xsd:NCName }
+ | element ns1:RunPostBuildEvent { xsd:NCName }
+ | element ns1:SccAuxPath { xsd:anyURI }
+ | element ns1:SccLocalPath { xsd:NMTOKEN }
+ | element ns1:SccProjectName { text }
+ | element ns1:SccProvider { text }
+ | element ns1:SchemaVersion { xsd:decimal }
+ | element ns1:SignAssembly { xsd:boolean }
+ | element ns1:SignManifests { xsd:boolean }
+ | element ns1:SolutionDir {
+ attribute Condition { text },
+ text
+ }
+ | element ns1:StartupObject { empty }
+ | element ns1:SupportUrl { empty }
+ | element ns1:TargetCulture { xsd:NCName }
+ | element ns1:TargetFrameworkProfile { text }
+ | element ns1:TargetFrameworkVersion { xsd:NCName }
+ | element ns1:TargetVsixContainerName { xsd:NCName }
+ | element ns1:TestProjectType { xsd:NCName }
+ | element ns1:TypeScriptCompileBlocked { xsd:boolean }
+ | element ns1:TypeScriptToolsVersion { xsd:decimal }
+ | element ns1:UpdateEnabled { xsd:boolean }
+ | element ns1:UpdateInterval { xsd:integer }
+ | element ns1:UpdateIntervalUnits { xsd:NCName }
+ | element ns1:UpdateMode { xsd:NCName }
+ | element ns1:UpdatePeriodically { xsd:boolean }
+ | element ns1:UpdateRequired { xsd:boolean }
+ | element ns1:UpgradeBackupLocation { empty }
+ | element ns1:Use64BitIISExpress { empty }
+ | element ns1:UseApplicationTrust { xsd:boolean }
+ | element ns1:UseGlobalApplicationHostFile { empty }
+ | element ns1:UseIISExpress { xsd:boolean }
+ | element ns1:UseVSHostingProcess { xsd:boolean }
+ | element ns1:VSTO_TrustAssembliesLocation { xsd:boolean }
+ | element ns1:VSToolsPath {
+ attribute Condition { text },
+ text
+ }
+ | element ns1:VisualStudioVersion {
+ attribute Condition { text },
+ xsd:decimal
+ }
+ | element ns1:WarningLevel { xsd:integer }
+ | element ns1:WcfConfigValidationEnabled { xsd:NCName })*,
+ element ns1:UseCodebase { xsd:boolean }?,
+ element ns1:GeneratePkgDefFile { xsd:boolean }?,
+ (element ns1:CopyBuildOutputToOutputDirectory { xsd:boolean }
+ | element ns1:CopyOutputSymbolsToOutputDirectory { xsd:boolean }
+ | element ns1:CopyVsixManifestToOutput { xsd:boolean }
+ | element ns1:CreateVsixContainer { xsd:boolean }
+ | element ns1:DeployExtension { xsd:boolean }
+ | element ns1:DeployVSTemplates { xsd:boolean }
+ | element ns1:IncludeAssemblyInVSIXContainer { xsd:boolean }
+ | element ns1:IncludeDebugSymbolsInLocalVSIXDeployment {
+ xsd:boolean
+ }
+ | element ns1:IncludeDebugSymbolsInVSIXContainer { xsd:boolean }
+ | element ns1:RuntimeIdentifier { xsd:NCName })*,
+ (element ns1:ApplicationIcon { xsd:NCName }
+ | element ns1:OfficeApplication { xsd:NCName }
+ | element ns1:PostBuildEvent {
+ attribute Condition { text }?,
+ text
+ }*
+ | (element ns1:StartAction { xsd:NCName },
+ element ns1:StartProgram {
+ attribute Condition { text },
+ text
+ },
+ element ns1:StartArguments { text },
+ element ns1:EnableNoticeInVisualStudioVsix { xsd:boolean }))
+ }
+ns1.ItemGroup =
+ element ns1:ItemGroup {
+ (element ns1:AssemblyAttributes {
+ attribute Include { xsd:NCName },
+ element ns1:_Parameter1 { text }
+ }
+ | element ns1:COMReference {
+ attribute Include { xsd:NCName },
+ element ns1:Guid { text },
+ element ns1:VersionMajor { xsd:integer },
+ element ns1:VersionMinor { xsd:integer },
+ element ns1:Lcid { xsd:integer },
+ element ns1:WrapperTool { xsd:NCName },
+ element ns1:Isolated { xsd:NCName },
+ ns1.EmbedInteropTypes
+ }
+ | element ns1:WCFMetadata {
+ attribute Include { text }
+ }
+ | element ns1:ProjectReference {
+ attribute Include { text },
+ ns1.Project,
+ element ns1:Name { xsd:NCName },
+ (ns1.VSIXSubPath,
+ element ns1:ReferenceOutputAssembly { xsd:boolean })?,
+ element ns1:IncludeOutputGroupsInVSIX { text }?,
+ element ns1:IncludeOutputGroupsInVSIXLocalOnly { text }?
+ }*
+ | element ns1:Folder {
+ attribute Include { text }
+ }*),
+ element ns1:VSTemplate {
+ attribute Include { xsd:NCName },
+ element ns1:OutputSubPath { xsd:NCName }?,
+ ns1.SubType
+ }*,
+ (element ns1:CodeAnalysisDependentAssemblyPaths {
+ attribute Condition { text },
+ attribute Include { text },
+ element ns1:Visible { xsd:NCName }
+ }
+ | element ns1:PackageSourceDirectory {
+ attribute Include { text }
+ }
+ | element ns1:WebReferences {
+ attribute Include { text }
+ }
+ | element ns1:Page {
+ attribute Include { text },
+ ns1.Generator,
+ ns1.SubType
+ }*
+ | element ns1:Reference {
+ attribute Include { text },
+ element ns1:RequiredTargetFramework { xsd:decimal }?,
+ element ns1:SpecificVersion { xsd:NCName }?,
+ ns1.EmbedInteropTypes?,
+ element ns1:HintPath { text }?,
+ element ns1:Private { xsd:NCName }?,
+ ns1.Paket?
+ }*
+ | element ns1:VSIXSourceItem {
+ attribute Exclude { text }?,
+ attribute Include { text },
+ attribute VSIXSubPath { xsd:NCName }?,
+ ns1.VSIXSubPath?
+ }*
+ | element ns1:PackageReference {
+ attribute Include { xsd:NCName },
+ attribute Version { text }?,
+ element ns1:Version { xsd:NMTOKEN }?,
+ element ns1:IncludeAssets { text }?,
+ element ns1:PrivateAssets { xsd:NCName }?
+ }*
+ | element ns1:Analyzer {
+ attribute Include { text },
+ ns1.Paket
+ }*),
+ element ns1:ApplicationDefinition {
+ attribute Include { xsd:NCName },
+ ns1.Generator,
+ ns1.SubType
+ }?,
+ (element ns1:Compile {
+ attribute Include { text },
+ element ns1:AutoGen { xsd:NCName }?,
+ ns1.Link?,
+ (ns1.DependentUpon
+ | element ns1:DesignTime { xsd:NCName }
+ | element ns1:DesignTimeSharedInput { xsd:NCName })*,
+ ns1.SubType?
+ }
+ | element ns1:Content {
+ attribute Include { text },
+ element ns1:IncludeInVSIX { xsd:boolean }?,
+ (ns1.CopyToOutputDirectory | ns1.DependentUpon | ns1.SubType)?
+ }
+ | element ns1:EmbeddedResource {
+ attribute Include { text },
+ (ns1.Generator, ns1.LastGenOutput)?,
+ (ns1.DependentUpon | ns1.SubType)?
+ }
+ | element ns1:EntityDeploy {
+ attribute Include { xsd:NCName },
+ ns1.Generator,
+ ns1.LastGenOutput
+ }
+ | element ns1:None {
+ attribute Include { text },
+ (ns1.Generator, ns1.LastGenOutput)?,
+ (ns1.DependentUpon | ns1.Link)?,
+ ns1.CopyToOutputDirectory?,
+ ns1.SubType?
+ }
+ | element ns1:Resource {
+ attribute Include { text }
+ })*,
+ (element ns1:AppDesigner {
+ attribute Include { text }
+ }
+ | element ns1:Service {
+ attribute Include { text }
+ }*)
+ }
+ns1.Output =
+ element ns1:Output {
+ attribute ItemName { xsd:NCName }?,
+ attribute PropertyName { xsd:NCName }?,
+ attribute TaskParameter { xsd:NCName }
+ }
+EmbedInteropTypes = element EmbedInteropTypes { xsd:NCName }
+Generator = element Generator { text }
+SubType = element SubType { text }
+LastGenOutput = element LastGenOutput { xsd:NCName }
+CopyToOutputDirectory = element CopyToOutputDirectory { xsd:NCName }
+DependentUpon = element DependentUpon { text }
+CopyToPublishDirectory = element CopyToPublishDirectory { xsd:NCName }
+Link = element Link { text }
+ExcludeFromSingleFile = element ExcludeFromSingleFile { xsd:boolean }
+ns1.VSIXSubPath = element ns1:VSIXSubPath { xsd:NCName }
+ns1.EmbedInteropTypes = element ns1:EmbedInteropTypes { xsd:NCName }
+ns1.SubType = element ns1:SubType { xsd:NCName }
+ns1.Generator = element ns1:Generator { xsd:NMTOKEN }
+ns1.Paket = element ns1:Paket { xsd:NCName }
+ns1.LastGenOutput = element ns1:LastGenOutput { xsd:NCName }
+ns1.DependentUpon = element ns1:DependentUpon { xsd:NCName }
+ns1.Link = element ns1:Link { text }
+ns1.CopyToOutputDirectory =
+ element ns1:CopyToOutputDirectory { xsd:NCName }
diff --git a/etc/schema/nuget.rnc b/etc/schema/nuget.rnc
new file mode 100644
index 00000000000..ab7052e91d1
--- /dev/null
+++ b/etc/schema/nuget.rnc
@@ -0,0 +1,25 @@
+default namespace = ""
+
+start =
+ element configuration {
+ element packageRestore { add+ }?,
+ (element config { add }
+ | element packageSourceMapping {
+ element packageSource {
+ attribute key { xsd:NCName },
+ element package {
+ attribute pattern { text }
+ }
+ }+
+ }
+ | element packageSources {
+ element clear { empty },
+ add+
+ })+
+ }
+add =
+ element add {
+ attribute key { xsd:NCName },
+ attribute protocolVersion { xsd:integer }?,
+ attribute value { xsd:anyURI }
+ }
diff --git a/etc/schema/nuspec.rnc b/etc/schema/nuspec.rnc
new file mode 100644
index 00000000000..a4332f84fc0
--- /dev/null
+++ b/etc/schema/nuspec.rnc
@@ -0,0 +1,100 @@
+namespace a = "http://relaxng.org/ns/compatibility/annotations/1.0";
+default namespace mstns =
"http://schemas.microsoft.com/packaging/2011/08/nuspec.xsd";
+namespace rng = "http://relaxng.org/ns/structure/1.0";
+
+dependency =
+ attribute id { xsd:string },
+ attribute version { xsd:string }?,
+ attribute include { xsd:string }?,
+ attribute exclude { xsd:string }?
+dependencyGroup =
+ element dependency { dependency }*,
+ attribute targetFramework { xsd:string }?
+reference = attribute file { xsd:string }
+contentFileEntries =
+ attribute include { xsd:string },
+ attribute exclude { xsd:string }?,
+ attribute buildAction { xsd:string }?,
+ attribute copyToOutput { xsd:boolean }?,
+ attribute flatten { xsd:boolean }?
+referenceGroup =
+ element reference { reference }+,
+ attribute targetFramework { xsd:string }?
+frameworkReference = attribute name { xsd:string }
+frameworkReferenceGroup =
+ element frameworkReference { frameworkReference }*,
+ attribute targetFramework { xsd:string }
+start |= starting_package
+starting_package =
+ element package {
+ element metadata {
+ (element id { xsd:string }
+ & element version { xsd:string }
+ & element title { xsd:string }?
+ & element authors { xsd:string }
+ & element owners { xsd:string }?
+ & element licenseUrl { xsd:anyURI }?
+ & element projectUrl { xsd:anyURI }?
+ & element iconUrl { xsd:anyURI }?
+ & element requireLicenseAcceptance { xsd:boolean }?
+ & element developmentDependency { xsd:boolean }?
+ & element description { xsd:string }
+ & element summary { xsd:string }?
+ & element releaseNotes { xsd:string }?
+ & (element copyright { xsd:string }?)
+ >> a:documentation [
+ "\x{a}" ~
+ " default value is : en-US"
+ ]
+ & element language { xsd:string }?
+ & element tags { xsd:string }?
+ & element serviceable { xsd:boolean }?
+ & element icon { xsd:string }?
+ & element readme { xsd:string }?
+ & element repository {
+ attribute type { xsd:string }?,
+ attribute url { xsd:anyURI }?,
+ attribute branch { xsd:string }?,
+ attribute commit { xsd:string }?
+ }?
+ & element license {
+ xsd:string,
+ attribute type { xsd:string },
+ attribute version { xsd:string }?
+ }?
+ & element packageTypes {
+ element packageType {
+ attribute name { xsd:string },
+ attribute version { xsd:string }?
+ }*
+ }?
+ & element dependencies {
+ (element dependency { dependency }
+ | element group { dependencyGroup })*
+ }?
+ & element frameworkAssemblies {
+ element frameworkAssembly {
+ attribute assemblyName { xsd:string },
+ attribute targetFramework { xsd:string }?
+ }*
+ }?
+ & element frameworkReferences {
+ element group { frameworkReferenceGroup }*
+ }?
+ & element references {
+ (element reference { reference }
+ | element group { referenceGroup })*
+ }?
+ & element contentFiles {
+ (element files { contentFileEntries })*
+ }?),
+ attribute minClientVersion { xsd:string }?
+ },
+ element files {
+ element file {
+ attribute src { xsd:string },
+ attribute target { xsd:string }?,
+ attribute exclude { xsd:string }?
+ }*
+ }?
+ }
diff --git a/etc/schema/schemas.xml b/etc/schema/schemas.xml
index f04bba849b4..be0dacd6ecf 100644
--- a/etc/schema/schemas.xml
+++ b/etc/schema/schemas.xml
@@ -66,4 +66,31 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. -->
<typeId id="LibreOffice" uri="OpenDocument-schema-v1.3+libreoffice.rnc"/>
<typeId id="OpenDocument Manifest" uri="od-manifest-schema-v1.2-os.rnc"/>
+ <!-- .net development related schemas -->
+ <uri pattern="nuget.config" typeId="Nuget Config" />
+ <typeId id="Nuget Config" uri="nuget.rnc" />
+
+ <uri pattern="*.nuspec" typeId="Nuget Spec" />
+ <namespace ns="http://schemas.microsoft.com/packaging/2011/08/nuspec.xsd";
typeId="Nuget Spec" />
+ <typeId id="Nuget Spec" uri="nuspec.rnc" />
+
+ <uri pattern="web.config" typeId="Dotnet App Config" />
+ <uri pattern="app.config" typeId="Dotnet App Config" />
+ <namespace ns="http://schemas.microsoft.com/.NetConfiguration/v2.0";
typeId="Dotnet App Config" />
+ <typeId id="Dotnet App Config" uri="dotnet-appconfig.rnc" />
+
+ <uri pattern="Directory.Packages.props" typeId="Dotnet Packages Props" />
+ <typeId id="Dotnet Packages Props" uri="dotnet-packages-props.rnc" />
+
+ <uri pattern="packages.config" typeId="Dotnet Packages Config" />
+ <typeId id="Dotnet Packages Config" uri="dotnet-packages-config.rnc" />
+
+ <uri pattern="*.resx" typeId="Dotnet Resx" />
+ <typeId id="Dotnet Resx" uri="dotnet-resx.rnc" />
+
+ <uri pattern="*.*proj" typeId="MSBuild" />
+ <uri pattern="Directory.Build.props" typeId="MSBuild" />
+ <documentElement localName="Project" typeId="MSBuild"/>
+ <typeId id="MSBuild" uri="msbuild.rnc" />
+
</locatingRules>
diff --git a/java/INSTALL b/java/INSTALL
index 6daef59084e..94bf0b01a96 100644
--- a/java/INSTALL
+++ b/java/INSTALL
@@ -268,14 +268,13 @@ When building for Intel systems, some ``ndk-build''
modules require
the Netwide Assembler, usually installed under ``nasm'', to be present
on the system that is building Emacs.
-Google, Inc. has adapted many common Emacs dependencies to use the
-`ndk-build' system. Here is a non-exhaustive list of what is known to
-work, along with what has to be patched to make them work:
+Google has adapted several Emacs dependencies to use the `ndk-build'
+system, many of which require patches to function under an Emacs
+environment. As such, it is generally the wiser choice to use our ports
+in their place, but the following list and patches are still provided
+for reference.
libpng - https://android.googlesource.com/platform/external/libpng
- libwebp - https://android.googlesource.com/platform/external/webp
- (You must apply the patch at the end of this file for the resulting
- binary to work on armv7 devices.)
giflib - https://android.googlesource.com/platform/external/giflib
(You must add LOCAL_EXPORT_CFLAGS := -I$(LOCAL_PATH) before
its Android.mk includes $(BUILD_STATIC_LIBRARY))
@@ -307,6 +306,13 @@ Many of these dependencies have been migrated over to the
However, the old ``Android.mk'' Makefiles are still present in older
branches, and can be easily adapted to newer versions.
+In addition, some Emacs dependencies provide `ndk-build' support
+themselves:
+
+ libwebp - https://android.googlesource.com/platform/external/webp
+ (You must apply the patch at the end of this file for the resulting
+ binary to work on armv7 devices.)
+
Emacs developers have ported the following dependencies to ARM Android
systems:
@@ -318,6 +324,15 @@ systems:
(Please see the section TREE-SITTER near the end of this file.)
harfbuzz - https://sourceforge.net/projects/android-ports-for-gnu-emacs
(Please see the section HARFBUZZ near the end of this file.)
+ libxml2 - https://sourceforge.net/projects/android-ports-for-gnu-emacs
+ (Please see the section LIBXML2 near the end of this file.)
+ libjpeg-turbo - https://sourceforge.net/projects/android-ports-for-gnu-emacs
+ giflib - https://sourceforge.net/projects/android-ports-for-gnu-emacs
+ libtiff - https://sourceforge.net/projects/android-ports-for-gnu-emacs
+ libpng - https://sourceforge.net/projects/android-ports-for-gnu-emacs
+ (Please see the section IMAGE LIBRARIES near the end of this file.)
+ libselinux - https://sourceforge.net/projects/android-ports-for-gnu-emacs
+ (Please see the section SELINUX near the end of this file.)
And other developers have ported the following dependencies to Android
systems:
@@ -345,14 +360,67 @@ To build Emacs with GnuTLS, you must unpack each of the
following tar
archives in that site:
gmp-6.2.1-emacs.tgz
- gnutls-3.7.8-emacs.tar.gz
+ gnutls-3.8.5-emacs.tar.gz
+ (or gnutls-3.8.5-emacs-armv7a.tar.gz on 32-bit systems)
libtasn1-4.19.0-emacs.tar.gz
p11-kit-0.24.1-emacs.tar.gz
nettle-3.8-emacs.tar.gz
-and add the resulting folders to ``--with-ndk-path''. Note that you
-should not try to build these packages separately using any
-`configure' script or Makefiles inside.
+and add the resulting folders to ``--with-ndk-path''. Do not attempt to
+build these packages separately by means of `configure' scripts or
+Makefiles inside.
+
+
+LIBXML2
+
+A copy of libxml2 adapted for the same build system is provided under
+the name:
+
+ libxml2-2.12.4-emacs.tar.gz
+
+In contrast to the version distributed by Google, internationalization
+is disabled, which eliminates the dependency on icu4c (and by extension
+a C++ compiler).
+
+
+IMAGE LIBRARIES
+
+ndk-build enabled versions of image libraries required by Emacs are also
+provided as:
+
+ giflib-5.2.1-emacs.tar.gz
+ libjpeg-turbo-3.0.2-emacs.tar.gz
+ libpng-1.6.41-emacs.tar.gz
+ tiff-4.5.0-emacs.tar.gz
+
+Of which all but libjpeg-turbo-3.0.2-emacs.tar.gz should compile on
+every supported Android system and toolchain; where the latter does not
+compile, i.e. old armeabi toolchains, Google's version is a suitable
+substitute.
+
+Of the three remaining image-related dependencies, libwebp provides
+upstream support for ndk-build, ImageMagick has been ported by
+interested third-party developers, while librsvg2, with its numerous and
+unnavigable web of dependencies and toolchains for non-C languages,
+would be such a great undertaking to port that we do not anticipate its
+ever becoming available.
+
+We are actively searching for alternatives to librsvg2 that are feasible
+to port, or better yet, natively support Android. Please send
+suggestions or patches to emacs-devel@gnu.org.
+
+
+SELINUX
+
+The upstream version of libselinux is available as:
+
+ libselinux-3.6-emacs.tar.gz
+
+and compiles on toolchains configured for Android 4.3 and later, which
+are the earliest Android releases to support SELinux. Its principal
+advantage over Google's edition is the absence of Android-specific
+modifications that create dependencies on libpackagelistparser and
+libcrypto; Google's pcre remains a requirement.
TREE-SITTER
@@ -372,7 +440,9 @@ A copy of HarfBuzz modified to build with the ndk-build
system can
also be found at that URL. To build Emacs with HarfBuzz, you must
unpack the following tar archive in that site:
- harfbuzz-7.1.0-emacs.tar.gz
+ harfbuzz-7.1.0-emacs.tar.gz (when building for Android >4.3
+ with 21.0.x or later of the NDK)
+ harfbuzz-1.7.7.tar.gz (earlier NDK or platform releases)
and add the resulting folder to ``--with-ndk-build''.
diff --git a/java/Makefile.in b/java/Makefile.in
index 7d732be8f91..35d2637837c 100644
--- a/java/Makefile.in
+++ b/java/Makefile.in
@@ -83,6 +83,10 @@ RESOURCE_FILES := $(foreach file,$(wildcard
$(srcdir)/res/*), \
# code. Instead, it is automatically included by the Java compiler.
RESOURCE_FILE := $(srcdir)/org/gnu/emacs/R.java
+# EmacsConfig.java is a file that holds information regarding the set of
+# shared libraries this binary links to, and similar build variables.
+CONFIG_FILE := $(builddir)/org/gnu/emacs/EmacsConfig.java
+
# CLASS_FILES is what should actually be built and included in the
# resulting Emacs executable. The Java compiler might generate more
# than one class file for each source file, so this only serves as a
@@ -193,10 +197,13 @@ install_temp: $(CROSS_BINS) $(CROSS_LIBS)
$(RESOURCE_FILES)
$(AM_V_SILENT) mkdir -p install_temp/assets/etc
$(AM_V_SILENT) mkdir -p install_temp/assets/lisp
$(AM_V_SILENT) mkdir -p install_temp/assets/info
-# Install architecture independents to assets/etc and assets/lisp
+ $(AM_V_SILENT) mkdir -p install_temp/assets/bitmaps
+# Install architecture independents to assets/etc, assets/lisp and
+# assets/bitmaps
$(AM_V_SILENT) cp -r $(top_srcdir)/lisp install_temp/assets
$(AM_V_SILENT) cp -r $(top_srcdir)/etc install_temp/assets
$(AM_V_SILENT) cp -r $(top_srcdir)/info install_temp/assets
+ $(AM_V_SILENT) cp -r $(top_srcdir)/src/bitmaps install_temp/assets
# Replace etc/DOC generated by compiling Emacs for the build machine
# with etc/DOC from the cross-compiled Emacs.
$(AM_V_SILENT) test -f $(top_builddir)/cross/etc/DOC \
@@ -294,24 +301,99 @@ $(RESOURCE_FILE): $(RESOURCE_FILES)
-J $(dir $@) -M AndroidManifest.xml \
-S $(top_srcdir)/java/res
-# Make all class files depend on R.java being built.
-$(CLASS_FILES): $(RESOURCE_FILE)
+# Generate a list of libemacs's dependencies with each item ordered
+# before its dependents for the startup process to load in advance, as
+# older versions of the dynamic linker do not consider these libraries
+# when resolving its imports. The several following statements are
+# executed from a recursive `make' run after shared libraries are
+# generated.
+
+ALL_DEPENDENCIES :=
+
+ifneq (,$(filter cf-stamp-1,$(MAKECMDGOALS)))
+# Don't be sidetracked by dependencies of shared libraries outside the
+# ndk-build directory.
+define get-dependencies
+$(foreach x, \
+$(and $(wildcard $(top_builddir)/cross/ndk-build/$1.so), \
+ $(shell $(NDK_BUILD_READELF) -d \
+ $(wildcard $(top_builddir)/cross/ndk-build/$1.so) \
+ | sed -n 's/.*(NEEDED).*\[\(.*\.so\)\].*/\1/p')), \
+$(basename $(notdir $(x))))
+endef #get-dependencies
+define resolve-one-dependency
+$(foreach dependency,$(call get-dependencies,$1),\
+ $(if $(findstring "$(dependency)",$(ALL_DEPENDENCIES)),,\
+ $(call resolve-one-dependency,$(basename $(notdir $(dependency)))) \
+ $(eval ALL_DEPENDENCIES := $(ALL_DEPENDENCIES) "$(dependency)",)))
+endef #resolve-one-dependency
+DEPENDENCIES := $(foreach file,$(NDK_BUILD_SHARED),\
+ $(basename $(notdir $(file))))
+$(foreach file,$(DEPENDENCIES),\
+ $(if $(findstring "$(file)",$(ALL_DEPENDENCIES)),,\
+ $(call resolve-one-dependency,$(file)) \
+ $(eval ALL_DEPENDENCIES := $(ALL_DEPENDENCIES) "$(file)",)))
+endif
+
+# EmacsConfig.java:
+ifeq (${V},1)
+AM_V_EMACSCONFIG =
+else
+AM_V_EMACSCONFIG = @$(info $. GEN org/gnu/emacs/EmacsConfig.java)
+endif
+
+.PHONY: cf-stamp-1
+cf-stamp-1:
+ $(AM_V_at) echo 'package org.gnu.emacs;\
+public class EmacsConfig\
+{\
+/* This is a generated file. Do not edit! */\
+public static final String[] EMACS_SHARED_LIBRARIES\
+= {$(ALL_DEPENDENCIES)};\
+}' | sed 's/\\//g' > globals.tmp
+ $(AM_V_at) mkdir -p org/gnu/emacs
+ $(AM_V_at) $(top_srcdir)/build-aux/move-if-change \
+ globals.tmp org/gnu/emacs/EmacsConfig.java
+
+# cf-stamp-1 is a phony target invoked in a second `make' instance after
+# all shared libraries are compiled, because the computation of
+# ALL_DEPENDENCIES in this instance of Make cannot be postponed until
+# that stage.
+cf-stamp: $(NDK_BUILD_SHARED) $(CROSS_LIBS)
+ $(AM_V_EMACSCONFIG) $(MAKE) cf-stamp-1
+ $(AM_V_at) touch $@
+$(CONFIG_FILE): cf-stamp; @true
+
+# Make all class files depend on R.java and EmacsConfig.java being
+# built.
+$(CLASS_FILES): $(RESOURCE_FILE) $(CONFIG_FILE)
.SUFFIXES: .java .class
$(CLASS_FILES) &: $(JAVA_FILES)
- $(AM_V_JAVAC) $(JAVAC) $(JAVAFLAGS) $(JAVA_FILES)
+ $(AM_V_JAVAC) $(JAVAC) $(JAVAFLAGS) $(JAVA_FILES) $(CONFIG_FILE)
$(AM_V_SILENT) touch $(CLASS_FILES)
# N.B. that find must be called all over again in case javac generated
# nested classes.
+ALL_CLASS_FILES = \
+ $(subst $$,\$$,$(shell find $(srcdir) -type f -name *.class))
+ALL_CLASS_FILES_1 =
+
+ifneq ($(builddir),$(srcdir))
+# If the build directory is distinct from the source directory, also
+# include generated class files located there.
+ALL_CLASS_FILES_1 = \
+ $(subst $$,\$$,$(shell find $(builddir) -type f -name *.class))
+endif
+
classes.dex: $(CLASS_FILES) $(if $(IS_D8_R8), $(srcdir)/proguard.conf)
$(AM_V_D8) $(D8) --classpath $(ANDROID_JAR) \
- $(subst $$,\$$,$(shell find $(srcdir) -type f \
- -name *.class)) --output $(builddir) \
+ $(ALL_CLASS_FILES) $(ALL_CLASS_FILES_1) \
+ --output $(builddir) \
--min-api $(ANDROID_MIN_SDK) \
$(if $(filter false,$(ANDROID_DEBUGGABLE)),--release, \
- --debug) \
+ --debug) \
$(if $(IS_D8_R8),--pg-conf $(srcdir)/proguard.conf)
# When emacs.keystore expires, regenerate it with:
@@ -345,7 +427,8 @@ TAGS: $(ETAGS) $(tagsfiles)
$(AM_V_GEN) $(ETAGS) $(tagsfiles)
clean:
- rm -f *.apk emacs.apk-in *.dex *.unaligned *.class *.idsig
+ rm -f *.apk emacs.apk-in *.dex *.unaligned *.class *.idsig \
+ cf-stamp $(CONFIG_FILE)
rm -rf install-temp $(RESOURCE_FILE) TAGS
find . -name '*.class' $(FIND_DELETE)
diff --git a/java/org/gnu/emacs/EmacsActivity.java
b/java/org/gnu/emacs/EmacsActivity.java
index 28bb6e4c065..7d02e4f4834 100644
--- a/java/org/gnu/emacs/EmacsActivity.java
+++ b/java/org/gnu/emacs/EmacsActivity.java
@@ -27,6 +27,7 @@ import java.util.ArrayList;
import java.util.concurrent.TimeUnit;
import android.app.Activity;
+import android.app.ActivityManager.TaskDescription;
import android.content.ContentResolver;
import android.content.Context;
@@ -55,6 +56,9 @@ public class EmacsActivity extends Activity
{
public static final String TAG = "EmacsActivity";
+ /* Key of intent value providing extra startup argument. */
+ public static final String EXTRA_STARTUP_ARGUMENTS;
+
/* ID for URIs from a granted document tree. */
public static final int ACCEPT_DOCUMENT_TREE = 1;
@@ -88,6 +92,7 @@ public class EmacsActivity extends Activity
static
{
focusedActivities = new ArrayList<EmacsActivity> ();
+ EXTRA_STARTUP_ARGUMENTS = "org.gnu.emacs.STARTUP_ARGUMENTS";
};
public static void
@@ -162,6 +167,10 @@ public class EmacsActivity extends Activity
layout.removeView (window.view);
window = null;
+ /* Reset the WM name. */
+ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.LOLLIPOP)
+ updateWmName ();
+
invalidateFocus (0);
}
}
@@ -201,6 +210,11 @@ public class EmacsActivity extends Activity
invalidateFocus (1);
}
});
+
+ /* Synchronize the window's window manager name with this activity's
+ task in the recents list. */
+ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.LOLLIPOP)
+ updateWmName ();
}
@Override
@@ -242,8 +256,8 @@ public class EmacsActivity extends Activity
/* See if Emacs should be started with any extra arguments, such
as `--quick'. */
intent = getIntent ();
- EmacsService.extraStartupArgument
- = intent.getStringExtra ("org.gnu.emacs.STARTUP_ARGUMENT");
+ EmacsService.extraStartupArguments
+ = intent.getStringArrayExtra (EXTRA_STARTUP_ARGUMENTS);
matchParent = FrameLayout.LayoutParams.MATCH_PARENT;
params
@@ -440,8 +454,7 @@ public class EmacsActivity extends Activity
if (!EmacsContextMenu.itemAlreadySelected)
{
serial = EmacsContextMenu.lastMenuEventSerial;
- EmacsNative.sendContextMenu ((short) 0, 0,
- serial);
+ EmacsNative.sendContextMenu (0, 0, serial);
}
super.onContextMenuClosed (menu);
@@ -519,6 +532,29 @@ public class EmacsActivity extends Activity
}
}
+ /* Update the name of this activity's task description from the
+ current window, or reset the same if no window is attached. */
+
+ @SuppressWarnings ("deprecation")
+ public final void
+ updateWmName ()
+ {
+ String wmName;
+ TaskDescription description;
+
+ if (window == null || window.wmName == null)
+ wmName = "Emacs";
+ else
+ wmName = window.wmName;
+
+ if (Build.VERSION.SDK_INT < Build.VERSION_CODES.TIRAMISU)
+ description = new TaskDescription (wmName);
+ else
+ description = (new TaskDescription.Builder ()
+ .setLabel (wmName).build ());
+ setTaskDescription (description);
+ }
+
@Override
public final void
onAttachedToWindow ()
diff --git a/java/org/gnu/emacs/EmacsClipboard.java
b/java/org/gnu/emacs/EmacsClipboard.java
index 9db436ca1e2..2560ef793c2 100644
--- a/java/org/gnu/emacs/EmacsClipboard.java
+++ b/java/org/gnu/emacs/EmacsClipboard.java
@@ -19,6 +19,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
package org.gnu.emacs;
+import android.content.res.AssetFileDescriptor;
import android.os.Build;
/* This class provides helper code for accessing the clipboard,
@@ -26,13 +27,13 @@ import android.os.Build;
public abstract class EmacsClipboard
{
- public abstract void setClipboard (byte[] bytes);
+ public abstract void setClipboard (String string);
public abstract int ownsClipboard ();
public abstract boolean clipboardExists ();
- public abstract byte[] getClipboard ();
+ public abstract String getClipboard ();
- public abstract byte[][] getClipboardTargets ();
- public abstract long[] getClipboardData (byte[] target);
+ public abstract String[] getClipboardTargets ();
+ public abstract AssetFileDescriptor getClipboardData (String target);
/* Create the correct kind of clipboard for this system. */
diff --git a/java/org/gnu/emacs/EmacsContextMenu.java
b/java/org/gnu/emacs/EmacsContextMenu.java
index 2bbf2a313d6..365a7ec40af 100644
--- a/java/org/gnu/emacs/EmacsContextMenu.java
+++ b/java/org/gnu/emacs/EmacsContextMenu.java
@@ -108,8 +108,8 @@ public final class EmacsContextMenu
will normally confuse Emacs into thinking that the
context menu has been dismissed. Wrong!
- Setting this flag makes EmacsActivity to only handle
- SubMenuBuilder being closed, which always means the menu
+ Setting this flag prompts EmacsActivity to only handle
+ SubMenuBuilders being closed, which always means the menu
has actually been dismissed.
However, these extraneous events aren't sent on devices
@@ -121,8 +121,7 @@ public final class EmacsContextMenu
}
/* Send a context menu event. */
- EmacsNative.sendContextMenu ((short) 0, itemID,
- lastMenuEventSerial);
+ EmacsNative.sendContextMenu (0, itemID, lastMenuEventSerial);
/* Say that an item has already been selected. */
itemAlreadySelected = true;
diff --git a/java/org/gnu/emacs/EmacsCursor.java
b/java/org/gnu/emacs/EmacsCursor.java
index 1049c03d7da..e5f22c23cfc 100644
--- a/java/org/gnu/emacs/EmacsCursor.java
+++ b/java/org/gnu/emacs/EmacsCursor.java
@@ -31,9 +31,9 @@ public final class EmacsCursor extends EmacsHandleObject
public final PointerIcon icon;
public
- EmacsCursor (short handle, int glyph)
+ EmacsCursor (int glyph)
{
- super (handle);
+ super ();
if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N)
{
diff --git a/java/org/gnu/emacs/EmacsDialog.java
b/java/org/gnu/emacs/EmacsDialog.java
index 0d5b650f7d0..31b2969197e 100644
--- a/java/org/gnu/emacs/EmacsDialog.java
+++ b/java/org/gnu/emacs/EmacsDialog.java
@@ -93,7 +93,7 @@ public final class EmacsDialog implements
DialogInterface.OnDismissListener
onClick (View view)
{
wasButtonClicked = true;
- EmacsNative.sendContextMenu ((short) 0, id, menuEventSerial);
+ EmacsNative.sendContextMenu (0, id, menuEventSerial);
dismissDialog.dismiss ();
}
@@ -102,7 +102,7 @@ public final class EmacsDialog implements
DialogInterface.OnDismissListener
onClick (DialogInterface dialog, int which)
{
wasButtonClicked = true;
- EmacsNative.sendContextMenu ((short) 0, id, menuEventSerial);
+ EmacsNative.sendContextMenu (0, id, menuEventSerial);
}
};
@@ -414,6 +414,6 @@ public final class EmacsDialog implements
DialogInterface.OnDismissListener
if (wasButtonClicked)
return;
- EmacsNative.sendContextMenu ((short) 0, 0, menuEventSerial);
+ EmacsNative.sendContextMenu (0, 0, menuEventSerial);
}
};
diff --git a/java/org/gnu/emacs/EmacsDrawLine.java
b/java/org/gnu/emacs/EmacsDrawLine.java
index 61b7d54d63c..c3399b4a75e 100644
--- a/java/org/gnu/emacs/EmacsDrawLine.java
+++ b/java/org/gnu/emacs/EmacsDrawLine.java
@@ -25,6 +25,97 @@ import android.graphics.Rect;
public final class EmacsDrawLine
{
+ /* Return the normalized slope and magnitude of a line whose extrema
+ are DX and DY removed, on the X and Y axes respectively, from its
+ origin point. */
+
+ private static float[]
+ measureLine (float dx, float dy)
+ {
+ float hypot;
+
+ if (dx == 0f && dy == 0f)
+ return new float[] { 0f, 0f, 0f, };
+
+ if (dx == 0f)
+ return new float[] { 0f, dy > 0f ? 1f : -1f, Math.abs (dy), };
+ else if (dy == 0f)
+ return new float[] { dx > 0f ? 1f : -1f, 0f, Math.abs (dx), };
+ else
+ {
+ hypot = (float) Math.hypot (dx, dy);
+ return new float[] { dx / hypot, dy / hypot, hypot, };
+ }
+ }
+
+ private static void
+ polyDashPattern (EmacsGC gc, Canvas canvas, Paint paint, float x0,
+ float y0, float x1, float y1)
+ {
+ int patternTotal, i, offset;
+ float dx, dy, mag, dash_mag, rem, lx1, ly1;
+ float[] measured;
+ boolean which;
+
+ /* Compute the total length of this pattern. */
+ patternTotal = 0;
+ for (i = 0; i < gc.dashes.length; ++i)
+ patternTotal += gc.dashes[i];
+ if ((gc.dashes.length & 1) != 0)
+ patternTotal += patternTotal;
+
+ /* Subtract as much of the offset as does not contribute to the
+ phase at the first pixel of the line. */
+ offset = gc.dash_offset % patternTotal;
+
+ /* Set I to the first dash that ought to be drawn and WHICH to its
+ phase. */
+ i = 0;
+ which = true;
+ while (offset >= gc.dashes[i])
+ {
+ offset -= gc.dashes[i++];
+ if (i >= gc.dashes.length)
+ i = 0;
+ which = !which;
+ }
+
+ /* Compute the length of the first visible segment. */
+ dash_mag = gc.dashes[i] - offset;
+
+ /* Compute the slope of the line. */
+ dx = x1 - x0;
+ dy = y1 - y0;
+ measured = measureLine (dx, dy);
+ dx = measured[0];
+ dy = measured[1];
+ rem = mag = measured[2];
+ lx1 = x0;
+ ly1 = y0;
+
+ while (rem > 0f)
+ {
+ dash_mag = Math.min (dash_mag, rem);
+ rem -= dash_mag;
+
+ /* End of this segment. */
+ x1 = (mag - rem) * dx + x0;
+ y1 = (mag - rem) * dy + y0;
+
+ if (which)
+ canvas.drawLine (lx1, ly1, x1, y1, paint);
+ which = !which;
+
+ /* Start of the next segment. */
+ lx1 = x1;
+ ly1 = y1;
+ i++;
+ if (i >= gc.dashes.length)
+ i = 0;
+ dash_mag = gc.dashes[i];
+ }
+ }
+
public static void
perform (EmacsDrawable drawable, EmacsGC gc,
int x, int y, int x2, int y2)
@@ -52,22 +143,14 @@ public final class EmacsDrawLine
if (canvas == null)
return;
- paint.setStyle (Paint.Style.FILL);
-
- /* Since drawLine has PostScript style behavior, adjust the
- coordinates appropriately.
-
- The left most pixel of a straight line is always partially
- filled. Patch it in manually. */
-
if (gc.clip_mask == null)
{
- canvas.drawLine ((float) x + 0.5f, (float) y + 0.5f,
- (float) x2 + 0.5f, (float) y2 + 0.5f,
- paint);
-
- if (x2 > x)
- canvas.drawRect (new Rect (x, y, x + 1, y + 1), paint);
+ if (gc.line_style != EmacsGC.GC_LINE_ON_OFF_DASH)
+ canvas.drawLine ((float) x, (float) y, (float) x2, (float) y2,
+ paint);
+ else
+ polyDashPattern (gc, canvas, paint, (float) x, (float) y,
+ (float) x2, (float) y2);
}
/* DrawLine with clip mask not implemented; it is not used by
diff --git a/java/org/gnu/emacs/EmacsDrawRectangle.java
b/java/org/gnu/emacs/EmacsDrawRectangle.java
index a8f68c6530a..ea0f1c28106 100644
--- a/java/org/gnu/emacs/EmacsDrawRectangle.java
+++ b/java/org/gnu/emacs/EmacsDrawRectangle.java
@@ -22,13 +22,23 @@ package org.gnu.emacs;
import android.graphics.Bitmap;
import android.graphics.Canvas;
import android.graphics.Paint;
+import android.graphics.PorterDuff.Mode;
+import android.graphics.PorterDuffXfermode;
import android.graphics.Rect;
import android.graphics.RectF;
+import android.graphics.Xfermode;
import android.util.Log;
public final class EmacsDrawRectangle
{
+ private static final Xfermode srcInAlu;
+
+ static
+ {
+ srcInAlu = new PorterDuffXfermode (Mode.SRC_IN);
+ };
+
public static void
perform (EmacsDrawable drawable, EmacsGC gc,
int x, int y, int width, int height)
@@ -40,8 +50,10 @@ public final class EmacsDrawRectangle
Canvas canvas;
Bitmap clipBitmap;
- /* TODO implement stippling. */
- if (gc.fill_style == EmacsGC.GC_FILL_OPAQUE_STIPPLED)
+ /* TODO implement stippling for this request. */
+ if (gc.fill_style == EmacsGC.GC_FILL_OPAQUE_STIPPLED
+ /* And GC_INVERT also. */
+ || gc.fill_style == EmacsGC.GC_INVERT)
return;
canvas = drawable.lockCanvas (gc);
@@ -52,6 +64,9 @@ public final class EmacsDrawRectangle
paint = gc.gcPaint;
paint.setStyle (Paint.Style.STROKE);
+ /* This graphics request, in contrast to X, does not presently
+ respect the GC's line style. */
+
if (gc.clip_mask == null)
/* Use canvas.drawRect with a RectF. That seems to reliably
get PostScript behavior. */
@@ -100,7 +115,7 @@ public final class EmacsDrawRectangle
/* Set the transfer mode to SRC_IN to preserve only the parts
of the source that overlap with the mask. */
maskPaint = new Paint ();
- maskPaint.setXfermode (EmacsGC.srcInAlu);
+ maskPaint.setXfermode (srcInAlu);
maskPaint.setStyle (Paint.Style.STROKE);
/* Draw the source. */
diff --git a/java/org/gnu/emacs/EmacsFillRectangle.java
b/java/org/gnu/emacs/EmacsFillRectangle.java
index ca87c06c014..7642deed7c3 100644
--- a/java/org/gnu/emacs/EmacsFillRectangle.java
+++ b/java/org/gnu/emacs/EmacsFillRectangle.java
@@ -21,6 +21,8 @@ package org.gnu.emacs;
import android.graphics.Bitmap;
import android.graphics.Canvas;
+import android.graphics.ColorFilter;
+import android.graphics.ColorMatrixColorFilter;
import android.graphics.Paint;
import android.graphics.Rect;
@@ -28,89 +30,62 @@ import android.util.Log;
public final class EmacsFillRectangle
{
+ /* Color filter that inverts colors from the source. */
+ private static final ColorFilter invertFilter;
+
+ static
+ {
+ invertFilter = new ColorMatrixColorFilter (new float[] {
+ -1f, 0f, 0f, 0f, 255f,
+ 0f, -1f, 0f, 0f, 255f,
+ 0f, 0f, -1f, 0f, 255f,
+ 0f, 0f, 0f, 1f, 0f,
+ });
+ };
+
public static void
perform (EmacsDrawable drawable, EmacsGC gc,
int x, int y, int width, int height)
{
- Paint maskPaint, paint;
- Canvas maskCanvas;
- Bitmap maskBitmap;
+ Paint paint;
Rect rect;
- Rect maskRect, dstRect;
Canvas canvas;
- Bitmap clipBitmap;
-
- /* TODO implement stippling. */
- if (gc.fill_style == EmacsGC.GC_FILL_OPAQUE_STIPPLED)
- return;
+ Bitmap invertBitmap;
canvas = drawable.lockCanvas (gc);
- if (canvas == null)
+ /* Clip masks are not respected or implemented when specified with
+ this request. */
+ if (canvas == null || gc.clip_mask != null)
return;
- paint = gc.gcPaint;
rect = new Rect (x, y, x + width, y + height);
- paint.setStyle (Paint.Style.FILL);
+ if (gc.function != EmacsGC.GC_INVERT)
+ {
+ paint = gc.gcPaint;
+ paint.setStyle (Paint.Style.FILL);
- if (gc.clip_mask == null)
- canvas.drawRect (rect, paint);
+ if (gc.fill_style != EmacsGC.GC_FILL_OPAQUE_STIPPLED)
+ canvas.drawRect (rect, paint);
+ else
+ gc.blitOpaqueStipple (canvas, rect);
+ }
else
{
- /* Drawing with a clip mask involves calculating the
- intersection of the clip mask with the dst rect, and
- extrapolating the corresponding part of the src rect. */
-
- clipBitmap = gc.clip_mask.bitmap;
- dstRect = new Rect (x, y, x + width, y + height);
- maskRect = new Rect (gc.clip_x_origin,
- gc.clip_y_origin,
- (gc.clip_x_origin
- + clipBitmap.getWidth ()),
- (gc.clip_y_origin
- + clipBitmap.getHeight ()));
-
- if (!maskRect.setIntersect (dstRect, maskRect))
- /* There is no intersection between the clip mask and the
- dest rect. */
- return;
-
- /* Finally, create a temporary bitmap that is the size of
- maskRect. */
-
- maskBitmap
- = Bitmap.createBitmap (maskRect.width (), maskRect.height (),
- Bitmap.Config.ARGB_8888);
-
- /* Draw the mask onto the maskBitmap. */
- maskCanvas = new Canvas (maskBitmap);
- maskRect.offset (-gc.clip_x_origin,
- -gc.clip_y_origin);
- maskCanvas.drawBitmap (gc.clip_mask.bitmap,
- maskRect, new Rect (0, 0,
- maskRect.width (),
- maskRect.height ()),
- paint);
- maskRect.offset (gc.clip_x_origin,
- gc.clip_y_origin);
-
- /* Set the transfer mode to SRC_IN to preserve only the parts
- of the source that overlap with the mask. */
- maskPaint = new Paint ();
- maskPaint.setXfermode (EmacsGC.srcInAlu);
-
- /* Draw the source. */
- maskCanvas.drawRect (maskRect, maskPaint);
-
- /* Finally, draw the mask bitmap to the destination. */
- paint.setXfermode (null);
- canvas.drawBitmap (maskBitmap, null, maskRect, paint);
-
- /* Recycle this unused bitmap. */
- maskBitmap.recycle ();
+ paint = new Paint ();
+
+ /* Simply invert the destination, which is only implemented for
+ this request. As Android doesn't permit copying a bitmap to
+ itself, a copy of the source must be procured beforehand. */
+ invertBitmap = Bitmap.createBitmap (drawable.getBitmap (),
+ x, y, width, height);
+ paint.setColorFilter (invertFilter);
+ canvas.drawBitmap (invertBitmap, null, rect, paint);
+ paint.setColorFilter (null);
+ invertBitmap.recycle ();
}
drawable.damageRect (rect);
}
-}
+};
diff --git a/java/org/gnu/emacs/EmacsGC.java b/java/org/gnu/emacs/EmacsGC.java
index e45f0666fe2..d400c23e067 100644
--- a/java/org/gnu/emacs/EmacsGC.java
+++ b/java/org/gnu/emacs/EmacsGC.java
@@ -22,31 +22,42 @@ package org.gnu.emacs;
import android.graphics.Rect;
import android.graphics.Paint;
+import android.graphics.Bitmap;
+import android.graphics.Canvas;
+import android.graphics.ColorFilter;
import android.graphics.PorterDuff.Mode;
-import android.graphics.PorterDuffXfermode;
-import android.graphics.Xfermode;
+import android.graphics.PorterDuffColorFilter;
+import android.graphics.Shader.TileMode;
+
+import android.os.Build;
/* X like graphics context structures. Keep the enums in synch with
androidgui.h! */
public final class EmacsGC extends EmacsHandleObject
{
- public static final int GC_COPY = 0;
- public static final int GC_XOR = 1;
+ public static final int GC_COPY = 0;
+ public static final int GC_INVERT = 1;
public static final int GC_FILL_SOLID = 0;
public static final int GC_FILL_OPAQUE_STIPPLED = 1;
- public static final Xfermode xorAlu, srcInAlu;
+ public static final int GC_LINE_SOLID = 0;
+ public static final int GC_LINE_ON_OFF_DASH = 1;
public int function, fill_style;
public int foreground, background;
public int clip_x_origin, clip_y_origin;
public int ts_origin_x, ts_origin_y;
+ public int line_style, line_width;
+ public int dashes[], dash_offset;
public Rect clip_rects[], real_clip_rects[];
public EmacsPixmap clip_mask, stipple;
public Paint gcPaint;
+ /* Drawable object for rendering the stiple bitmap. */
+ public EmacsTileObject tileObject;
+
/* ID incremented every time the clipping rectangles of any GC
changes. */
private static long clip_serial;
@@ -55,28 +66,26 @@ public final class EmacsGC extends EmacsHandleObject
rectangles changed. 0 if there are no clip rectangles. */
public long clipRectID;
- static
- {
- xorAlu = new PorterDuffXfermode (Mode.XOR);
- srcInAlu = new PorterDuffXfermode (Mode.SRC_IN);
- }
-
/* The following fields are only set on immutable GCs. */
public
- EmacsGC (short handle)
+ EmacsGC ()
{
/* For historical reasons the C code has an extra layer of
indirection above this GC handle. struct android_gc is the GC
used by Emacs code, while android_gcontext is the type of the
handle. */
- super (handle);
+ super ();
fill_style = GC_FILL_SOLID;
function = GC_COPY;
foreground = 0;
background = 0xffffff;
gcPaint = new Paint ();
+
+ /* Android S and above enable anti-aliasing unless explicitly told
+ otherwise. */
+ gcPaint.setAntiAlias (false);
}
/* Mark this GC as dirty. Apply parameters to the paint and
@@ -86,6 +95,7 @@ public final class EmacsGC extends EmacsHandleObject
markDirty (boolean clipRectsChanged)
{
int i;
+ Bitmap stippleBitmap;
if (clipRectsChanged)
{
@@ -106,16 +116,83 @@ public final class EmacsGC extends EmacsHandleObject
clipRectID = ++clip_serial;
}
- gcPaint.setStrokeWidth (1f);
+ /* A line_width of 0 is equivalent to that of 1. */
+ gcPaint.setStrokeWidth (line_width < 1 ? 1 : line_width);
gcPaint.setColor (foreground | 0xff000000);
- gcPaint.setXfermode (function == GC_XOR
- ? xorAlu : srcInAlu);
+
+ /* Update the stipple object with the new stipple bitmap, or delete
+ it if the stipple has been cleared on systems too old to support
+ modifying such objects. */
+
+ if (stipple != null)
+ {
+ stippleBitmap = stipple.getBitmap ();
+
+ /* Allocate a new tile object if none is already present or it
+ cannot be reconfigured. */
+ if (tileObject == null)
+ {
+ tileObject = new EmacsTileObject (stippleBitmap);
+ tileObject.setTileModeXY (TileMode.REPEAT, TileMode.REPEAT);
+ }
+ else
+ /* Otherwise, update the existing tile object with the new
+ bitmap. */
+ tileObject.setBitmap (stippleBitmap);
+ }
+ else if (tileObject != null)
+ tileObject.setBitmap (null);
}
- public void
- resetXfermode ()
+ /* Prepare the tile object to draw a stippled image onto a section of
+ a drawable defined by RECT. It is an error to call this function
+ unless the `stipple' field of the GContext is set. */
+
+ private void
+ prepareStipple (Rect rect)
+ {
+ int sx, sy; /* Stipple origin. */
+ int bw, bh; /* Stipple size. */
+ Bitmap bitmap;
+ Rect boundsRect;
+
+ /* Retrieve the dimensions of the stipple bitmap, which doubles as
+ the unit of advance for this stipple. */
+ bitmap = tileObject.getBitmap ();
+ bw = bitmap.getWidth ();
+ bh = bitmap.getHeight ();
+
+ /* Align the lower left corner of the bounds rectangle to the
+ initial position of the stipple. */
+ sx = (rect.left % bw) * -1 + (-ts_origin_x % bw) * -1;
+ sy = (rect.top % bh) * -1 + (-ts_origin_y % bh) * -1;
+ boundsRect = new Rect (rect.left + sx, rect.top + sy,
+ rect.right, rect.bottom);
+ tileObject.setBounds (boundsRect);
+ }
+
+ /* Fill the rectangle BOUNDS in the provided CANVAS with the stipple
+ pattern defined for this GContext, in the foreground color where
+ the pattern is on, and in the background color where off. */
+
+ protected void
+ blitOpaqueStipple (Canvas canvas, Rect rect)
{
- gcPaint.setXfermode (function == GC_XOR
- ? xorAlu : srcInAlu);
+ ColorFilter filter;
+
+ prepareStipple (rect);
+ filter = new PorterDuffColorFilter (foreground | 0xff000000,
+ Mode.SRC_IN);
+ tileObject.setColorFilter (filter);
+
+ canvas.save ();
+ canvas.clipRect (rect);
+
+ tileObject.draw (canvas);
+ filter = new PorterDuffColorFilter (background | 0xff000000,
+ Mode.SRC_OUT);
+ tileObject.setColorFilter (filter);
+ tileObject.draw (canvas);
+ canvas.restore ();
}
};
diff --git a/java/org/gnu/emacs/EmacsHandleObject.java
b/java/org/gnu/emacs/EmacsHandleObject.java
index 8534f08519c..cbd579bac5b 100644
--- a/java/org/gnu/emacs/EmacsHandleObject.java
+++ b/java/org/gnu/emacs/EmacsHandleObject.java
@@ -33,14 +33,9 @@ public abstract class EmacsHandleObject
/* Whether or not this handle has been destroyed. */
volatile boolean destroyed;
- /* The handle associated with this object. */
- public short handle;
-
- public
- EmacsHandleObject (short handle)
- {
- this.handle = handle;
- }
+ /* The handle associated with this object, set in
+ android_globalize_reference. */
+ public long handle;
public void
destroyHandle () throws IllegalStateException
diff --git a/java/org/gnu/emacs/EmacsInputConnection.java
b/java/org/gnu/emacs/EmacsInputConnection.java
index 054eca66cf3..5b409fa1f57 100644
--- a/java/org/gnu/emacs/EmacsInputConnection.java
+++ b/java/org/gnu/emacs/EmacsInputConnection.java
@@ -48,7 +48,7 @@ public final class EmacsInputConnection implements
InputConnection
private EmacsView view;
/* The handle ID associated with that view's window. */
- private short windowHandle;
+ private long windowHandle;
/* Number of batch edits currently underway. Used to avoid
synchronizing with the Emacs thread after each
diff --git a/java/org/gnu/emacs/EmacsNative.java
b/java/org/gnu/emacs/EmacsNative.java
index 24440bd5953..97415fcb876 100644
--- a/java/org/gnu/emacs/EmacsNative.java
+++ b/java/org/gnu/emacs/EmacsNative.java
@@ -36,12 +36,6 @@ public final class EmacsNative
private static final String[] libraryDeps;
- /* Like `dup' in C. */
- public static native int dup (int fd);
-
- /* Like `close' in C. */
- public static native int close (int fd);
-
/* Obtain the fingerprint of this build of Emacs. The fingerprint
can be used to determine the dump file name. */
public static native String getFingerprint ();
@@ -108,92 +102,92 @@ public final class EmacsNative
/* Send an ANDROID_CONFIGURE_NOTIFY event. The values of all the
functions below are the serials of the events sent. */
- public static native long sendConfigureNotify (short window, long time,
+ public static native long sendConfigureNotify (long window, long time,
int x, int y, int width,
int height);
/* Send an ANDROID_KEY_PRESS event. */
- public static native long sendKeyPress (short window, long time, int state,
+ public static native long sendKeyPress (long window, long time, int state,
int keyCode, int unicodeChar);
/* Send an ANDROID_KEY_RELEASE event. */
- public static native long sendKeyRelease (short window, long time, int state,
+ public static native long sendKeyRelease (long window, long time, int state,
int keyCode, int unicodeChar);
/* Send an ANDROID_FOCUS_IN event. */
- public static native long sendFocusIn (short window, long time);
+ public static native long sendFocusIn (long window, long time);
/* Send an ANDROID_FOCUS_OUT event. */
- public static native long sendFocusOut (short window, long time);
+ public static native long sendFocusOut (long window, long time);
/* Send an ANDROID_WINDOW_ACTION event. */
- public static native long sendWindowAction (short window, int action);
+ public static native long sendWindowAction (long window, int action);
/* Send an ANDROID_ENTER_NOTIFY event. */
- public static native long sendEnterNotify (short window, int x, int y,
+ public static native long sendEnterNotify (long window, int x, int y,
long time);
/* Send an ANDROID_LEAVE_NOTIFY event. */
- public static native long sendLeaveNotify (short window, int x, int y,
+ public static native long sendLeaveNotify (long window, int x, int y,
long time);
/* Send an ANDROID_MOTION_NOTIFY event. */
- public static native long sendMotionNotify (short window, int x, int y,
+ public static native long sendMotionNotify (long window, int x, int y,
long time);
/* Send an ANDROID_BUTTON_PRESS event. */
- public static native long sendButtonPress (short window, int x, int y,
+ public static native long sendButtonPress (long window, int x, int y,
long time, int state,
int button);
/* Send an ANDROID_BUTTON_RELEASE event. */
- public static native long sendButtonRelease (short window, int x, int y,
+ public static native long sendButtonRelease (long window, int x, int y,
long time, int state,
int button);
/* Send an ANDROID_TOUCH_DOWN event. */
- public static native long sendTouchDown (short window, int x, int y,
+ public static native long sendTouchDown (long window, int x, int y,
long time, int pointerID,
int flags);
/* Send an ANDROID_TOUCH_UP event. */
- public static native long sendTouchUp (short window, int x, int y,
+ public static native long sendTouchUp (long window, int x, int y,
long time, int pointerID,
int flags);
/* Send an ANDROID_TOUCH_MOVE event. */
- public static native long sendTouchMove (short window, int x, int y,
+ public static native long sendTouchMove (long window, int x, int y,
long time, int pointerID,
int flags);
/* Send an ANDROID_WHEEL event. */
- public static native long sendWheel (short window, int x, int y,
+ public static native long sendWheel (long window, int x, int y,
long time, int state,
float xDelta, float yDelta);
/* Send an ANDROID_ICONIFIED event. */
- public static native long sendIconified (short window);
+ public static native long sendIconified (long window);
/* Send an ANDROID_DEICONIFIED event. */
- public static native long sendDeiconified (short window);
+ public static native long sendDeiconified (long window);
/* Send an ANDROID_CONTEXT_MENU event. */
- public static native long sendContextMenu (short window, int menuEventID,
+ public static native long sendContextMenu (long window, int menuEventID,
int menuEventSerial);
/* Send an ANDROID_EXPOSE event. */
- public static native long sendExpose (short window, int x, int y,
+ public static native long sendExpose (long window, int x, int y,
int width, int height);
/* Send an ANDROID_DND_DRAG event. */
- public static native long sendDndDrag (short window, int x, int y);
+ public static native long sendDndDrag (long window, int x, int y);
/* Send an ANDROID_DND_URI event. */
- public static native long sendDndUri (short window, int x, int y,
+ public static native long sendDndUri (long window, int x, int y,
String text);
/* Send an ANDROID_DND_TEXT event. */
- public static native long sendDndText (short window, int x, int y,
+ public static native long sendDndText (long window, int x, int y,
String text);
/* Send an ANDROID_NOTIFICATION_CANCELED event. */
@@ -228,6 +222,10 @@ public final class EmacsNative
be prevented from reaching the system input method. */
public static native boolean shouldForwardCtrlSpace ();
+ /* Return the keycode repeated activation of which should signal
+ quit. */
+ public static native int getQuitKeycode ();
+
/* Initialize the current thread, by blocking signals that do not
interest it. */
public static native void setupSystemThread ();
@@ -237,48 +235,48 @@ public final class EmacsNative
/* Input connection functions. These mostly correspond to their
counterparts in Android's InputConnection. */
- public static native void beginBatchEdit (short window);
- public static native void endBatchEdit (short window);
- public static native void commitCompletion (short window, String text,
+ public static native void beginBatchEdit (long window);
+ public static native void endBatchEdit (long window);
+ public static native void commitCompletion (long window, String text,
int position);
- public static native void commitText (short window, String text,
+ public static native void commitText (long window, String text,
int position);
- public static native void deleteSurroundingText (short window,
+ public static native void deleteSurroundingText (long window,
int leftLength,
int rightLength);
- public static native void finishComposingText (short window);
- public static native void replaceText (short window, int start, int end,
+ public static native void finishComposingText (long window);
+ public static native void replaceText (long window, int start, int end,
String text, int newCursorPosition,
TextAttribute attributes);
- public static native String getSelectedText (short window, int flags);
- public static native String getTextAfterCursor (short window, int length,
+ public static native String getSelectedText (long window, int flags);
+ public static native String getTextAfterCursor (long window, int length,
int flags);
- public static native String getTextBeforeCursor (short window, int length,
+ public static native String getTextBeforeCursor (long window, int length,
int flags);
- public static native void setComposingText (short window, String text,
+ public static native void setComposingText (long window, String text,
int newCursorPosition);
- public static native void setComposingRegion (short window, int start,
+ public static native void setComposingRegion (long window, int start,
int end);
- public static native void setSelection (short window, int start, int end);
- public static native void performEditorAction (short window,
+ public static native void setSelection (long window, int start, int end);
+ public static native void performEditorAction (long window,
int editorAction);
- public static native void performContextMenuAction (short window,
+ public static native void performContextMenuAction (long window,
int contextMenuAction);
- public static native ExtractedText getExtractedText (short window,
+ public static native ExtractedText getExtractedText (long window,
ExtractedTextRequest req,
int flags);
- public static native void requestSelectionUpdate (short window);
- public static native void requestCursorUpdates (short window, int mode);
- public static native void clearInputFlags (short window);
- public static native SurroundingText getSurroundingText (short window,
+ public static native void requestSelectionUpdate (long window);
+ public static native void requestCursorUpdates (long window, int mode);
+ public static native void clearInputFlags (long window);
+ public static native SurroundingText getSurroundingText (long window,
int left, int right,
int flags);
- public static native TextSnapshot takeSnapshot (short window);
+ public static native TextSnapshot takeSnapshot (long window);
/* Return the current value of the selection, or -1 upon
failure. */
- public static native int[] getSelection (short window);
+ public static native int[] getSelection (long window);
/* Graphics functions used as replacements for potentially buggy
@@ -321,39 +319,35 @@ public final class EmacsNative
static
{
- /* Older versions of Android cannot link correctly with shared
- libraries that link with other shared libraries built along
- Emacs unless all requisite shared libraries are explicitly
- loaded from Java.
-
- Every time you add a new shared library dependency to Emacs,
- please add it here as well. */
-
- 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",
- "nettle_emacs", "p11-kit_emacs",
- "tasn1_emacs", "hogweed_emacs",
- "jpeg_emacs",
- "tiff_emacs", "xml2_emacs",
- "icuuc_emacs", "harfbuzz_emacs",
- "tree-sitter_emacs", };
+ /* A library search path misconfiguration prevents older versions of
+ Android from successfully loading application shared libraries
+ unless all requisite shared libraries provided by the application
+ are explicitly loaded from Java. The build process arranges that
+ EmacsConfig.EMACS_SHARED_LIBRARIES hold the names of each of
+ these libraries in the correct order, so load them now. */
+
+ libraryDeps = EmacsConfig.EMACS_SHARED_LIBRARIES;
for (String dependency : libraryDeps)
{
- try
- {
- System.loadLibrary (dependency);
- }
- catch (UnsatisfiedLinkError exception)
- {
- /* Ignore this exception. */
- }
+ /* Remove the "lib" prefix, if any. */
+ if (dependency.startsWith ("lib"))
+ dependency = dependency.substring (3);
+
+ /* If this library is provided by the operating system, don't
+ link to it. */
+ if (dependency.equals ("z")
+ || dependency.equals ("c")
+ || dependency.equals ("m")
+ || dependency.equals ("dl")
+ || dependency.equals ("log")
+ || dependency.equals ("android"))
+ continue;
+
+ System.loadLibrary (dependency);
}
+ /* At this point, it should be alright to load Emacs. */
System.loadLibrary ("emacs");
};
};
diff --git a/java/org/gnu/emacs/EmacsOpenActivity.java
b/java/org/gnu/emacs/EmacsOpenActivity.java
index 327a53bc417..28e1e261821 100644
--- a/java/org/gnu/emacs/EmacsOpenActivity.java
+++ b/java/org/gnu/emacs/EmacsOpenActivity.java
@@ -19,29 +19,23 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
package org.gnu.emacs;
-/* This class makes the Emacs server work reasonably on Android.
+/* Opening external documents on Android.
- There is no way to make the Unix socket publicly available on
- Android.
+ This activity is registered as an application capable of opening text
+ files and files in several other formats that Emacs understands, and
+ assumes responsibility for deriving file names from the files
+ provided to `onCreate', potentially copying them to temporary
+ directories in the process, and invoking `emacsclient' with suitable
+ arguments to open the same. In this respect, it fills the role of
+ `etc/emacs.desktop' on XDG systems.
- Instead, this activity tries to connect to the Emacs server, to
- make it open files the system asks Emacs to open, and to emulate
- some reasonable behavior when Emacs has not yet started.
+ It is also registered as a handler for mailto URIs, in which capacity
+ it constructs invocations of `emacsclient' so as to start
+ `message-mailto' with their contents and attachments, much like
+ `etc/emacs-mail.desktop'.
- First, Emacs registers itself as an application that can open text
- and image files.
-
- Then, when the user is asked to open a file and selects ``Emacs''
- as the application that will open the file, the system pops up a
- window, this activity, and calls the `onCreate' function.
-
- `onCreate' then tries very to find the file name of the file that
- was selected, and give it to emacsclient.
-
- If emacsclient successfully opens the file, then this activity
- starts EmacsActivity (to bring it on to the screen); otherwise, it
- displays the output of emacsclient or any error message that occurs
- and exits. */
+ As with all other activities, it is registered in the package
+ manifest file. */
import android.app.AlertDialog;
import android.app.Activity;
@@ -76,11 +70,6 @@ public final class EmacsOpenActivity extends Activity
{
private static final String TAG = "EmacsOpenActivity";
- /* The name of any file that should be opened as EmacsThread starts
- Emacs. This is never cleared, even if EmacsOpenActivity is
- started a second time, as EmacsThread only starts once. */
- public static String fileToOpen;
-
/* Any currently focused EmacsOpenActivity. Used to show pop ups
while the activity is active and Emacs doesn't have permission to
display over other programs. */
@@ -628,11 +617,12 @@ public final class EmacsOpenActivity extends Activity
if (scheme.equals ("content")
/* Retrieving the native file descriptor of a
- ParcelFileDescriptor requires Honeycomb, and
+ ParcelFileDescriptor requires Honeycomb MR1, 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)
+ && (Build.VERSION.SDK_INT
+ >= Build.VERSION_CODES.HONEYCOMB_MR1))
{
/* This is one of the annoying Android ``content''
URIs. Most of the time, there is actually an
@@ -702,9 +692,10 @@ public final class EmacsOpenActivity extends Activity
if (EmacsService.SERVICE == null)
{
- fileToOpen = fileName;
intent = new Intent (EmacsOpenActivity.this,
EmacsActivity.class);
+ intent.putExtra (EmacsActivity.EXTRA_STARTUP_ARGUMENTS,
+ new String [] { fileName, });
finish ();
startActivity (intent);
return;
diff --git a/java/org/gnu/emacs/EmacsPixmap.java
b/java/org/gnu/emacs/EmacsPixmap.java
index c621e2de3c5..bd4e085994e 100644
--- a/java/org/gnu/emacs/EmacsPixmap.java
+++ b/java/org/gnu/emacs/EmacsPixmap.java
@@ -51,9 +51,9 @@ public final class EmacsPixmap extends EmacsHandleObject
private long gcClipRectID;
public
- EmacsPixmap (short handle, int width, int height, int depth)
+ EmacsPixmap (int width, int height, int depth)
{
- super (handle);
+ super ();
if (depth != 1 && depth != 24)
throw new IllegalArgumentException ("Invalid depth specified"
diff --git a/java/org/gnu/emacs/EmacsPreferencesActivity.java
b/java/org/gnu/emacs/EmacsPreferencesActivity.java
index 766e2e11d46..a3edd6388b4 100644
--- a/java/org/gnu/emacs/EmacsPreferencesActivity.java
+++ b/java/org/gnu/emacs/EmacsPreferencesActivity.java
@@ -57,7 +57,8 @@ public class EmacsPreferencesActivity extends
PreferenceActivity
intent = new Intent (this, EmacsActivity.class);
intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK
| Intent.FLAG_ACTIVITY_CLEAR_TASK);
- intent.putExtra ("org.gnu.emacs.STARTUP_ARGUMENT", "--quick");
+ intent.putExtra (EmacsActivity.EXTRA_STARTUP_ARGUMENTS,
+ new String[] {"--quick", });
startActivity (intent);
System.exit (0);
}
@@ -74,7 +75,8 @@ public class EmacsPreferencesActivity extends
PreferenceActivity
intent = new Intent (this, EmacsActivity.class);
intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK
| Intent.FLAG_ACTIVITY_CLEAR_TASK);
- intent.putExtra ("org.gnu.emacs.STARTUP_ARGUMENT", "--debug-init");
+ intent.putExtra (EmacsActivity.EXTRA_STARTUP_ARGUMENTS,
+ new String[] {"--debug-init", });
startActivity (intent);
System.exit (0);
}
diff --git a/java/org/gnu/emacs/EmacsSafThread.java
b/java/org/gnu/emacs/EmacsSafThread.java
index 14c3f222833..ee8c2e7e0c3 100644
--- a/java/org/gnu/emacs/EmacsSafThread.java
+++ b/java/org/gnu/emacs/EmacsSafThread.java
@@ -1623,10 +1623,10 @@ public final class EmacsSafThread extends HandlerThread
mode is merely w.
This may be ascribed to a mix-up in Android's documentation
- regardin DocumentsProvider: the `openDocument' function is only
- documented to accept r or rw, whereas the default
- implementation of the `openFile' function (which documents rwt)
- delegates to `openDocument'. */
+ regarding DocumentsProvider: the `openDocument' function is only
+ documented to accept r or rw, whereas the default implementation
+ of the `openFile' function (which documents rwt) delegates to
+ `openDocument'. */
if (read && write && truncate && fileDescriptor != null
&& !EmacsNative.ftruncate (fileDescriptor.getFd ()))
diff --git a/java/org/gnu/emacs/EmacsSdk11Clipboard.java
b/java/org/gnu/emacs/EmacsSdk11Clipboard.java
index 850bb6c8deb..e179551c14d 100644
--- a/java/org/gnu/emacs/EmacsSdk11Clipboard.java
+++ b/java/org/gnu/emacs/EmacsSdk11Clipboard.java
@@ -86,32 +86,23 @@ public final class EmacsSdk11Clipboard extends
EmacsClipboard
}
}
- /* Set the clipboard text to CLIPBOARD, a string in UTF-8
- encoding. */
+ /* Save the STRING into the clipboard by way of text copied by the
+ user. */
@Override
public synchronized void
- setClipboard (byte[] bytes)
+ setClipboard (String string)
{
ClipData data;
- String string;
- try
- {
- string = new String (bytes, "UTF-8");
- data = ClipData.newPlainText ("Emacs", string);
- manager.setPrimaryClip (data);
- ownsClipboard = true;
-
- /* onPrimaryClipChanged will be called again. Use this
- variable to keep track of how many times the clipboard has
- been changed. */
- ++clipboardChangedCount;
- }
- catch (UnsupportedEncodingException exception)
- {
- Log.w (TAG, "setClipboard: " + exception);
- }
+ data = ClipData.newPlainText ("Emacs", string);
+ manager.setPrimaryClip (data);
+ ownsClipboard = true;
+
+ /* onPrimaryClipChanged will be called again. Use this
+ variable to keep track of how many times the clipboard has
+ been changed. */
+ ++clipboardChangedCount;
}
/* Return whether or not Emacs owns the clipboard. Value is 1 if
@@ -141,7 +132,7 @@ public final class EmacsSdk11Clipboard extends
EmacsClipboard
NULL if no content is available. */
@Override
- public byte[]
+ public String
getClipboard ()
{
ClipData clip;
@@ -154,30 +145,20 @@ public final class EmacsSdk11Clipboard extends
EmacsClipboard
return null;
context = EmacsService.SERVICE;
-
- try
- {
- text = clip.getItemAt (0).coerceToText (context);
- return text.toString ().getBytes ("UTF-8");
- }
- catch (UnsupportedEncodingException exception)
- {
- Log.w (TAG, "getClipboard: " + exception);
- }
-
- return null;
+ text = clip.getItemAt (0).coerceToText (context);
+ return text.toString ();
}
/* Return an array of targets currently provided by the
clipboard, or NULL if there are none. */
@Override
- public byte[][]
+ public String[]
getClipboardTargets ()
{
ClipData clip;
ClipDescription description;
- byte[][] typeArray;
+ String[] typeArray;
int i;
/* N.B. that Android calls the clipboard the ``primary clip''; it
@@ -189,17 +170,10 @@ public final class EmacsSdk11Clipboard extends
EmacsClipboard
description = clip.getDescription ();
i = description.getMimeTypeCount ();
- typeArray = new byte[i][i];
+ typeArray = new String[i];
- try
- {
- for (i = 0; i < description.getMimeTypeCount (); ++i)
- typeArray[i] = description.getMimeType (i).getBytes ("UTF-8");
- }
- catch (UnsupportedEncodingException exception)
- {
- return null;
- }
+ for (i = 0; i < description.getMimeTypeCount (); ++i)
+ typeArray[i] = description.getMimeType (i);
return typeArray;
}
@@ -207,8 +181,9 @@ public final class EmacsSdk11Clipboard extends
EmacsClipboard
/* Return the clipboard data for the given target, or NULL if it
does not exist.
- Value is normally an array of three longs: the file descriptor,
- the start offset of the data, and its length; length may be
+ Value is normally an asset file descriptor, which in turn holds
+ three important values: the file descriptor, the start offset of
+ the data, and its length; length may be
AssetFileDescriptor.UNKNOWN_LENGTH, meaning that the data extends
from that offset to the end of the file.
@@ -217,36 +192,23 @@ public final class EmacsSdk11Clipboard extends
EmacsClipboard
solely of a URI. */
@Override
- public long[]
- getClipboardData (byte[] target)
+ public AssetFileDescriptor
+ getClipboardData (String target)
{
ClipData data;
String mimeType;
- int fd;
AssetFileDescriptor assetFd;
Uri uri;
- long[] value;
-
- /* Decode the target given by Emacs. */
- try
- {
- mimeType = new String (target, "UTF-8");
- }
- catch (UnsupportedEncodingException exception)
- {
- return null;
- }
/* Now obtain the clipboard data and the data corresponding to
that MIME type. */
+ mimeType = target;
data = manager.getPrimaryClip ();
if (data == null || data.getItemCount () < 1)
return null;
- fd = -1;
-
try
{
uri = data.getItemAt (0).getUri ();
@@ -257,52 +219,15 @@ public final class EmacsSdk11Clipboard extends
EmacsClipboard
/* Now open the file descriptor. */
assetFd = resolver.openTypedAssetFileDescriptor (uri, mimeType,
null);
-
- /* Duplicate the file descriptor. */
- fd = assetFd.getParcelFileDescriptor ().getFd ();
- fd = EmacsNative.dup (fd);
-
- /* Return the relevant information. */
- value = new long[] { fd, assetFd.getStartOffset (),
- assetFd.getLength (), };
-
- /* Close the original offset. */
- assetFd.close ();
+ return assetFd;
}
catch (SecurityException e)
{
- /* Guarantee a file descriptor duplicated or detached is
- ultimately closed if an error arises. */
-
- if (fd != -1)
- EmacsNative.close (fd);
-
return null;
}
catch (FileNotFoundException e)
{
- /* Guarantee a file descriptor duplicated or detached is
- ultimately closed if an error arises. */
-
- if (fd != -1)
- EmacsNative.close (fd);
-
- return null;
- }
- catch (IOException e)
- {
- /* Guarantee a file descriptor duplicated or detached is
- ultimately closed if an error arises. */
-
- if (fd != -1)
- EmacsNative.close (fd);
-
return null;
}
-
- /* Don't return value if the file descriptor couldn't be
- created. */
-
- return fd != -1 ? value : null;
}
};
diff --git a/java/org/gnu/emacs/EmacsSdk8Clipboard.java
b/java/org/gnu/emacs/EmacsSdk8Clipboard.java
index 418f55c12c1..afd235babf5 100644
--- a/java/org/gnu/emacs/EmacsSdk8Clipboard.java
+++ b/java/org/gnu/emacs/EmacsSdk8Clipboard.java
@@ -25,6 +25,8 @@ package org.gnu.emacs;
import android.text.*;
import android.content.Context;
+import android.content.res.AssetFileDescriptor;
+
import android.util.Log;
import java.io.UnsupportedEncodingException;
@@ -50,21 +52,14 @@ public final class EmacsSdk8Clipboard extends EmacsClipboard
= (ClipboardManager) context.getSystemService (what);
}
- /* Set the clipboard text to CLIPBOARD, a string in UTF-8
- encoding. */
+ /* Save the STRING into the clipboard by way of text copied by the
+ user. */
@Override
public void
- setClipboard (byte[] bytes)
+ setClipboard (String string)
{
- try
- {
- manager.setText (new String (bytes, "UTF-8"));
- }
- catch (UnsupportedEncodingException exception)
- {
- Log.w (TAG, "setClipboard: " + exception);
- }
+ manager.setText (string);
}
/* Return whether or not Emacs owns the clipboard. Value is 1 if
@@ -91,7 +86,7 @@ public final class EmacsSdk8Clipboard extends EmacsClipboard
NULL if no content is available. */
@Override
- public byte[]
+ public String
getClipboard ()
{
String string;
@@ -103,24 +98,14 @@ public final class EmacsSdk8Clipboard extends
EmacsClipboard
return null;
string = text.toString ();
-
- try
- {
- return string.getBytes ("UTF-8");
- }
- catch (UnsupportedEncodingException exception)
- {
- Log.w (TAG, "getClipboard: " + exception);
- }
-
- return null;
+ return string;
}
/* Return an array of targets currently provided by the
clipboard, or NULL if there are none. */
@Override
- public byte[][]
+ public String[]
getClipboardTargets ()
{
return null;
@@ -129,9 +114,10 @@ public final class EmacsSdk8Clipboard extends
EmacsClipboard
/* Return the clipboard data for the given target, or NULL if it
does not exist.
- Value is normally an array of three longs: the file descriptor,
- the start offset of the data, and its length; length may be
- AssetFileDescriptor.UNKOWN_LENGTH, meaning that the data extends
+ Value is normally an asset file descriptor, which in turn holds
+ three important values: the file descriptor, the start offset of
+ the data, and its length; length may be
+ AssetFileDescriptor.UNKNOWN_LENGTH, meaning that the data extends
from that offset to the end of the file.
Do not use this function to open text targets; use `getClipboard'
@@ -139,8 +125,8 @@ public final class EmacsSdk8Clipboard extends EmacsClipboard
solely of a URI. */
@Override
- public long[]
- getClipboardData (byte[] target)
+ public AssetFileDescriptor
+ getClipboardData (String target)
{
return null;
}
diff --git a/java/org/gnu/emacs/EmacsService.java
b/java/org/gnu/emacs/EmacsService.java
index b1ec397bc41..2dcaad16e50 100644
--- a/java/org/gnu/emacs/EmacsService.java
+++ b/java/org/gnu/emacs/EmacsService.java
@@ -25,6 +25,7 @@ import java.io.IOException;
import java.io.UnsupportedEncodingException;
import java.util.ArrayList;
+import java.util.Arrays;
import java.util.HashSet;
import java.util.List;
@@ -64,6 +65,7 @@ import android.content.pm.PackageManager;
import android.content.res.AssetManager;
import android.content.res.Configuration;
+import android.content.res.Resources;
import android.hardware.input.InputManager;
@@ -101,9 +103,9 @@ public final class EmacsService extends Service
/* The started Emacs service object. */
public static EmacsService SERVICE;
- /* If non-NULL, an extra argument to pass to
+ /* If non-NULL, an array of extra arguments to pass to
`android_emacs_init'. */
- public static String extraStartupArgument;
+ public static String[] extraStartupArguments;
/* The thread running Emacs C code. */
private EmacsThread thread;
@@ -146,6 +148,9 @@ public final class EmacsService extends Service
thread. */
private Thread mainThread;
+ /* "Resources" object required by GContext bookkeeping. */
+ public static Resources resources;
+
static
{
servicingQuery = new AtomicInteger ();
@@ -238,10 +243,11 @@ public final class EmacsService extends Service
super.onCreate ();
SERVICE = this;
+ resources = getResources ();
handler = new Handler (Looper.getMainLooper ());
manager = getAssets ();
app_context = getApplicationContext ();
- metrics = getResources ().getDisplayMetrics ();
+ metrics = resources.getDisplayMetrics ();
pixelDensityX = metrics.xdpi;
pixelDensityY = metrics.ydpi;
tempScaledDensity = ((getScaledDensity (metrics)
@@ -284,7 +290,9 @@ public final class EmacsService extends Service
Log.d (TAG, "Initializing Emacs, where filesDir = " + filesDir
+ ", libDir = " + libDir + ", and classPath = " + classPath
- + "; fileToOpen = " + EmacsOpenActivity.fileToOpen
+ + "; args = " + (extraStartupArguments != null
+ ? Arrays.toString (extraStartupArguments)
+ : "(none)")
+ "; display density: " + pixelDensityX + " by "
+ pixelDensityY + " scaled to " + scaledDensity);
@@ -301,9 +309,7 @@ public final class EmacsService extends Service
classPath, EmacsService.this,
Build.VERSION.SDK_INT);
}
- }, extraStartupArgument,
- /* If any file needs to be opened, open it now. */
- EmacsOpenActivity.fileToOpen);
+ }, extraStartupArguments);
thread.start ();
}
catch (IOException exception)
@@ -509,10 +515,10 @@ public final class EmacsService extends Service
vibrator.vibrate (duration);
}
- public short[]
+ public long[]
queryTree (EmacsWindow window)
{
- short[] array;
+ long[] array;
List<EmacsWindow> windowList;
int i;
@@ -524,7 +530,7 @@ public final class EmacsService extends Service
synchronized (windowList)
{
- array = new short[windowList.size () + 1];
+ array = new long[windowList.size () + 1];
i = 1;
array[0] = (window == null
@@ -841,7 +847,7 @@ public final class EmacsService extends Service
}
public static int[]
- viewGetSelection (short window)
+ viewGetSelection (long window)
{
int[] selection;
@@ -962,11 +968,13 @@ public final class EmacsService extends Service
string; make it writable if WRITABLE, and readable if READABLE.
Truncate the file if TRUNCATE.
- Value is the resulting file descriptor or -1 upon failure. */
+ Value is the resulting file descriptor, -1, or an exception will be
+ raised. */
public int
- openContentUri (byte[] bytes, boolean writable, boolean readable,
+ openContentUri (String uri, boolean writable, boolean readable,
boolean truncate)
+ throws FileNotFoundException, IOException
{
String name, mode;
ParcelFileDescriptor fd;
@@ -985,39 +993,19 @@ public final class EmacsService extends Service
if (truncate)
mode += "t";
- /* Try to open an associated ParcelFileDescriptor. */
-
- try
- {
- /* The usual file name encoding question rears its ugly head
- again. */
+ /* Try to open a corresponding ParcelFileDescriptor. Though
+ `fd.detachFd' is exclusive to Honeycomb and up, this function is
+ never called on systems older than KitKat, which is Emacs's
+ minimum requirement for access to /content/by-authority. */
- name = new String (bytes, "UTF-8");
- fd = resolver.openFileDescriptor (Uri.parse (name), mode);
+ fd = resolver.openFileDescriptor (Uri.parse (uri), mode);
+ if (fd == null)
+ return -1;
- /* Use detachFd on newer versions of Android or plain old
- dup. */
-
- if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB_MR1)
- {
- i = fd.detachFd ();
- fd.close ();
-
- return i;
- }
- else
- {
- i = EmacsNative.dup (fd.getFd ());
- fd.close ();
+ i = fd.detachFd ();
+ fd.close ();
- return i;
- }
- }
- catch (Exception exception)
- {
- exception.printStackTrace ();
- return -1;
- }
+ return i;
}
/* Return whether Emacs is directly permitted to access the
@@ -1413,22 +1401,12 @@ public final class EmacsService extends Service
otherwise. */
public String[]
- getDocumentTrees (byte provider[])
+ getDocumentTrees (String provider)
{
- String providerName;
List<String> treeList;
List<UriPermission> permissions;
Uri uri;
- try
- {
- providerName = new String (provider, "US-ASCII");
- }
- catch (UnsupportedEncodingException exception)
- {
- return null;
- }
-
permissions = resolver.getPersistedUriPermissions ();
treeList = new ArrayList<String> ();
@@ -1437,7 +1415,7 @@ public final class EmacsService extends Service
uri = permission.getUri ();
if (DocumentsContract.isTreeUri (uri)
- && uri.getAuthority ().equals (providerName)
+ && uri.getAuthority ().equals (provider)
&& permission.isReadPermission ())
/* Make sure the tree document ID is encoded. Refrain from
encoding characters such as +:&?#, since they don't
@@ -1447,6 +1425,9 @@ public final class EmacsService extends Service
" +:&?#"));
}
+ /* The empty string array that is ostensibly allocated to provide
+ the first argument provides just the type of the array to be
+ returned. */
return treeList.toArray (new String[0]);
}
diff --git a/java/org/gnu/emacs/EmacsThread.java
b/java/org/gnu/emacs/EmacsThread.java
index 4adcb98b2f7..a90eb73b1ef 100644
--- a/java/org/gnu/emacs/EmacsThread.java
+++ b/java/org/gnu/emacs/EmacsThread.java
@@ -28,24 +28,20 @@ public final class EmacsThread extends Thread
{
private static final String TAG = "EmacsThread";
- /* Whether or not Emacs should be started with an additional
- argument, and that additional argument if non-NULL. */
- private String extraStartupArgument;
+ /* Whether or not Emacs should be started with additional arguments,
+ and those additional arguments if non-NULL. */
+ private final String[] extraStartupArguments;
/* Runnable run to initialize Emacs. */
- private Runnable paramsClosure;
-
- /* Whether or not to open a file after starting Emacs. */
- private String fileToOpen;
+ private final Runnable paramsClosure;
public
EmacsThread (EmacsService service, Runnable paramsClosure,
- String extraStartupArgument, String fileToOpen)
+ String[] extraStartupArguments)
{
super ("Emacs main thread");
- this.extraStartupArgument = extraStartupArgument;
+ this.extraStartupArguments = extraStartupArguments;
this.paramsClosure = paramsClosure;
- this.fileToOpen = fileToOpen;
}
@Override
@@ -54,23 +50,15 @@ public final class EmacsThread extends Thread
{
String args[];
- if (fileToOpen == null)
- {
- if (extraStartupArgument == null)
- args = new String[] { "libandroid-emacs.so", };
- else
- args = new String[] { "libandroid-emacs.so",
- extraStartupArgument, };
- }
+ if (extraStartupArguments == null)
+ args = new String[] { "libandroid-emacs.so", };
else
{
- if (extraStartupArgument == null)
- args = new String[] { "libandroid-emacs.so",
- fileToOpen, };
- else
- args = new String[] { "libandroid-emacs.so",
- extraStartupArgument,
- fileToOpen, };
+ /* Prepend "libandroid-emacs.so" to the list of arguments. */
+ args = new String[extraStartupArguments.length + 1];
+ args[0] = "libandroid-emacs.so";
+ System.arraycopy (extraStartupArguments, 0, args,
+ 1, extraStartupArguments.length);
}
paramsClosure.run ();
diff --git a/java/org/gnu/emacs/EmacsTileObject.java
b/java/org/gnu/emacs/EmacsTileObject.java
new file mode 100644
index 00000000000..2caa28cbcd6
--- /dev/null
+++ b/java/org/gnu/emacs/EmacsTileObject.java
@@ -0,0 +1,101 @@
+/* Communication module for Android terminals. -*- c-file-style: "GNU" -*-
+
+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/>. */
+
+package org.gnu.emacs;
+
+import android.graphics.Bitmap;
+import android.graphics.BitmapShader;
+import android.graphics.Canvas;
+import android.graphics.ColorFilter;
+import android.graphics.Paint;
+import android.graphics.Rect;
+import android.graphics.Shader.TileMode;
+
+/* This is a crude facsimilie of the BitmapDrawable class implementing
+ just enough of its functionality to support displaying stipples in
+ EmacsGC. */
+
+public final class EmacsTileObject
+{
+ /* Color filter object set by EmacsGC. */
+ private ColorFilter colorFilter;
+
+ /* Bitmap object set by EmacsGC. */
+ private Bitmap bitmap;
+
+ /* Tiling modes on either axis. */
+ private TileMode xTile, yTile;
+
+ /* Destination rectangle. */
+ private Rect boundsRect;
+
+ /* Paint providing graphics properties for drawBitmap. */
+ private Paint paint;
+
+
+
+ public
+ EmacsTileObject (Bitmap stippleBitmap)
+ {
+ bitmap = stippleBitmap;
+ paint = new Paint ();
+ }
+
+ public void
+ setBitmap (Bitmap newBitmap)
+ {
+ bitmap = newBitmap;
+ }
+
+ public void
+ setBounds (Rect bounds)
+ {
+ boundsRect = bounds;
+ }
+
+ public void
+ setTileModeXY (TileMode newXTile, TileMode newYTile)
+ {
+ xTile = newXTile;
+ yTile = newYTile;
+ }
+
+ public void
+ setColorFilter (ColorFilter filterObject)
+ {
+ paint.setColorFilter (filterObject);
+ }
+
+ public Bitmap
+ getBitmap ()
+ {
+ return bitmap;
+ }
+
+ /* Replicate `bitmap' over CANVAS so that boundsRect is covered with
+ copies thereof on the X axis, if xTile is REPEAT, and also on the Y
+ axis, if yTile is a like value. */
+
+ public void
+ draw (Canvas canvas)
+ {
+ paint.setShader (new BitmapShader (bitmap, xTile, yTile));
+ canvas.drawRect (boundsRect, paint);
+ }
+};
diff --git a/java/org/gnu/emacs/EmacsView.java
b/java/org/gnu/emacs/EmacsView.java
index 977ad90310d..244a3a02166 100644
--- a/java/org/gnu/emacs/EmacsView.java
+++ b/java/org/gnu/emacs/EmacsView.java
@@ -45,6 +45,8 @@ import android.graphics.Paint;
import android.os.Build;
import android.util.Log;
+import java.util.Arrays;
+
/* This is an Android view which has a back and front buffer. When
swapBuffers is called, the back buffer is swapped to the front
buffer, and any damage is invalidated. frontBitmap and backBitmap
@@ -505,42 +507,45 @@ public final class EmacsView extends ViewGroup
public boolean
onKeyDown (int keyCode, KeyEvent event)
{
- if ((keyCode == KeyEvent.KEYCODE_VOLUME_UP
- || keyCode == KeyEvent.KEYCODE_VOLUME_DOWN
- || keyCode == KeyEvent.KEYCODE_VOLUME_MUTE)
- && !EmacsNative.shouldForwardMultimediaButtons ())
- return false;
+ if (((keyCode == KeyEvent.KEYCODE_VOLUME_UP
+ || keyCode == KeyEvent.KEYCODE_VOLUME_DOWN
+ || keyCode == KeyEvent.KEYCODE_VOLUME_MUTE)
+ && !EmacsNative.shouldForwardMultimediaButtons ())
+ || keyCode == KeyEvent.KEYCODE_SCROLL_LOCK
+ || keyCode == KeyEvent.KEYCODE_NUM_LOCK)
+ return super.onKeyDown (keyCode, event);
- window.onKeyDown (keyCode, event);
- return true;
+ return window.onKeyDown (keyCode, event);
}
@Override
public boolean
onKeyMultiple (int keyCode, int repeatCount, KeyEvent event)
{
- if ((keyCode == KeyEvent.KEYCODE_VOLUME_UP
- || keyCode == KeyEvent.KEYCODE_VOLUME_DOWN
- || keyCode == KeyEvent.KEYCODE_VOLUME_MUTE)
- && !EmacsNative.shouldForwardMultimediaButtons ())
- return false;
+ if (((keyCode == KeyEvent.KEYCODE_VOLUME_UP
+ || keyCode == KeyEvent.KEYCODE_VOLUME_DOWN
+ || keyCode == KeyEvent.KEYCODE_VOLUME_MUTE)
+ && !EmacsNative.shouldForwardMultimediaButtons ())
+ || keyCode == KeyEvent.KEYCODE_SCROLL_LOCK
+ || keyCode == KeyEvent.KEYCODE_NUM_LOCK)
+ return super.onKeyMultiple (keyCode, repeatCount, event);
- window.onKeyDown (keyCode, event);
- return true;
+ return window.onKeyDown (keyCode, event);
}
@Override
public boolean
onKeyUp (int keyCode, KeyEvent event)
{
- if ((keyCode == KeyEvent.KEYCODE_VOLUME_UP
- || keyCode == KeyEvent.KEYCODE_VOLUME_DOWN
- || keyCode == KeyEvent.KEYCODE_VOLUME_MUTE)
- && !EmacsNative.shouldForwardMultimediaButtons ())
- return false;
+ if (((keyCode == KeyEvent.KEYCODE_VOLUME_UP
+ || keyCode == KeyEvent.KEYCODE_VOLUME_DOWN
+ || keyCode == KeyEvent.KEYCODE_VOLUME_MUTE)
+ && !EmacsNative.shouldForwardMultimediaButtons ())
+ || keyCode == KeyEvent.KEYCODE_SCROLL_LOCK
+ || keyCode == KeyEvent.KEYCODE_NUM_LOCK)
+ return super.onKeyUp (keyCode, event);
- window.onKeyUp (keyCode, event);
- return true;
+ return window.onKeyUp (keyCode, event);
}
@Override
@@ -828,6 +833,12 @@ public final class EmacsView extends ViewGroup
selection = EmacsService.viewGetSelection (window.handle);
+ if (EmacsService.DEBUG_IC)
+ Log.d (TAG, ("onCreateInputConnection: "
+ + (selection != null
+ ? Arrays.toString (selection)
+ : "(unavailable)")));
+
if (selection == null)
{
/* If the selection could not be obtained, return 0 by 0.
diff --git a/java/org/gnu/emacs/EmacsWindow.java
b/java/org/gnu/emacs/EmacsWindow.java
index 911e082144e..5a4e04ae169 100644
--- a/java/org/gnu/emacs/EmacsWindow.java
+++ b/java/org/gnu/emacs/EmacsWindow.java
@@ -20,12 +20,16 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
package org.gnu.emacs;
import java.lang.IllegalStateException;
+
import java.util.ArrayList;
+import java.util.LinkedHashMap;
import java.util.List;
import java.util.ListIterator;
-import java.util.LinkedHashMap;
import java.util.Map;
+import java.util.concurrent.Callable;
+import java.util.concurrent.FutureTask;
+
import android.app.Activity;
import android.content.ClipData;
@@ -136,10 +140,10 @@ public final class EmacsWindow extends EmacsHandleObject
there is no such window manager. */
private WindowManager windowManager;
- /* The time of the last KEYCODE_VOLUME_DOWN release. This is used
- to quit Emacs upon two rapid clicks of the volume down
- button. */
- private long lastVolumeButtonRelease;
+ /* The time of the last release of the quit keycode, generally
+ KEYCODE_VOLUME_DOWN. This is used to signal quit upon two rapid
+ presses of such key. */
+ private long lastQuitKeyRelease;
/* Linked list of character strings which were recently sent as
events. */
@@ -169,12 +173,15 @@ public final class EmacsWindow extends EmacsHandleObject
and whether this window has previously been attached to a task. */
public boolean preserve, previouslyAttached;
+ /* The window manager name of this window, which supplies the name of
+ activities in which it is displayed as a toplevel window, or
+ NULL. */
+ public String wmName;
+
public
- EmacsWindow (short handle, final EmacsWindow parent, int x, int y,
+ EmacsWindow (final EmacsWindow parent, int x, int y,
int width, int height, boolean overrideRedirect)
{
- super (handle);
-
rect = new Rect (x, y, x + width, y + height);
pointerMap = new SparseArray<Coordinate> ();
@@ -205,7 +212,7 @@ public final class EmacsWindow extends EmacsHandleObject
});
}
- scratchGC = new EmacsGC ((short) 0);
+ scratchGC = new EmacsGC ();
/* Create the map of input method-committed strings. Keep at most
ten strings in the map. */
@@ -635,8 +642,8 @@ public final class EmacsWindow extends EmacsHandleObject
/* Return the modifier mask associated with the specified keyboard
- input EVENT. Replace bits corresponding to Left or Right keys
- with their corresponding general modifier bits. */
+ input EVENT. Replace bits representing Left or Right keys with
+ their corresponding general modifier bits. */
public static int
eventModifiers (KeyEvent event)
@@ -644,7 +651,7 @@ public final class EmacsWindow extends EmacsHandleObject
int state;
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB_MR2)
- state = event.getModifiers ();
+ state = KeyEvent.normalizeMetaState (event.getMetaState ());
else
{
/* Replace this with getMetaState and manual
@@ -669,10 +676,10 @@ public final class EmacsWindow extends EmacsHandleObject
/* event.getCharacters is used because older input methods still
require it. */
@SuppressWarnings ("deprecation")
- public void
+ public boolean
onKeyDown (int keyCode, KeyEvent event)
{
- int state, state_1, extra_ignored;
+ int state, state_1, extra_ignored, unicode_char;
long serial;
String characters;
@@ -688,18 +695,15 @@ public final class EmacsWindow extends EmacsHandleObject
Deliver onKeyDown events in onKeyUp instead, so as not to
navigate backwards during gesture navigation. */
- return;
+ return true;
}
state = eventModifiers (event);
- /* Num Lock, Scroll Lock and Meta aren't supported by systems older
- than Android 3.0. */
+ /* Meta isn't supported by systems older than Android 3.0. */
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB)
- extra_ignored = (KeyEvent.META_NUM_LOCK_ON
- | KeyEvent.META_SCROLL_LOCK_ON
- | KeyEvent.META_META_MASK);
+ extra_ignored = KeyEvent.META_META_MASK;
else
extra_ignored = 0;
@@ -725,23 +729,36 @@ public final class EmacsWindow extends EmacsHandleObject
state &= ~KeyEvent.META_ALT_MASK;
}
+ unicode_char = getEventUnicodeChar (event, state_1);
+
+ /* If a NUMPAD_ key is detected for which no character is returned,
+ return false without sending the key event, as this will prompt
+ the system to send an event with the corresponding action
+ key. */
+
+ if (keyCode >= KeyEvent.KEYCODE_NUMPAD_0
+ && keyCode <= KeyEvent.KEYCODE_NUMPAD_RIGHT_PAREN
+ && unicode_char == 0)
+ return false;
+
synchronized (eventStrings)
{
serial
= EmacsNative.sendKeyPress (this.handle,
event.getEventTime (),
state, keyCode,
- getEventUnicodeChar (event,
- state_1));
+ unicode_char);
characters = event.getCharacters ();
if (characters != null && characters.length () > 1)
saveUnicodeString ((int) serial, characters);
}
+
+ return true;
}
- public void
+ public boolean
onKeyUp (int keyCode, KeyEvent event)
{
int state, state_1, unicode_char, extra_ignored;
@@ -750,13 +767,10 @@ public final class EmacsWindow extends EmacsHandleObject
/* Compute the event's modifier mask. */
state = eventModifiers (event);
- /* Num Lock, Scroll Lock and Meta aren't supported by systems older
- than Android 3.0. */
+ /* Meta isn't supported by systems older than Android 3.0. */
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB)
- extra_ignored = (KeyEvent.META_NUM_LOCK_ON
- | KeyEvent.META_SCROLL_LOCK_ON
- | KeyEvent.META_META_MASK);
+ extra_ignored = KeyEvent.META_META_MASK;
else
extra_ignored = 0;
@@ -789,16 +803,25 @@ public final class EmacsWindow extends EmacsHandleObject
/* If the key press's been canceled, return immediately. */
if ((event.getFlags () & KeyEvent.FLAG_CANCELED) != 0)
- return;
+ return true;
+ /* Dispatch the key press event that was deferred till now. */
EmacsNative.sendKeyPress (this.handle, event.getEventTime (),
state, keyCode, unicode_char);
}
+ /* If a NUMPAD_ key is detected for which no character is returned,
+ return false without sending the key event, as this will prompt
+ the system to send an event with the corresponding action
+ key. */
+ else if (keyCode >= KeyEvent.KEYCODE_NUMPAD_0
+ && keyCode <= KeyEvent.KEYCODE_NUMPAD_RIGHT_PAREN
+ && unicode_char == 0)
+ return false;
EmacsNative.sendKeyRelease (this.handle, event.getEventTime (),
state, keyCode, unicode_char);
- if (keyCode == KeyEvent.KEYCODE_VOLUME_DOWN)
+ if (keyCode == EmacsNative.getQuitKeycode ())
{
/* Check if this volume down press should quit Emacs.
Most Android devices have no physical keyboard, so it
@@ -806,11 +829,13 @@ public final class EmacsWindow extends EmacsHandleObject
time = event.getEventTime ();
- if (time - lastVolumeButtonRelease < 350)
+ if (time - lastQuitKeyRelease < 350)
EmacsNative.quit ();
- lastVolumeButtonRelease = time;
+ lastQuitKeyRelease = time;
}
+
+ return true;
}
public void
@@ -1546,6 +1571,36 @@ public final class EmacsWindow extends EmacsHandleObject
return dontFocusOnMap;
}
+ public void
+ setWmName (final String wmName)
+ {
+ if (Build.VERSION.SDK_INT < Build.VERSION_CODES.LOLLIPOP)
+ return;
+
+ EmacsService.SERVICE.runOnUiThread (new Runnable () {
+ @Override
+ public void
+ run ()
+ {
+ EmacsActivity activity;
+ Object tem;
+
+ EmacsWindow.this.wmName = wmName;
+
+ /* If an activity is already attached, replace its task
+ description. */
+
+ tem = getAttachedConsumer ();
+
+ if (tem != null && tem instanceof EmacsActivity)
+ {
+ activity = (EmacsActivity) tem;
+ activity.updateWmName ();
+ }
+ }
+ });
+ }
+
public int[]
translateCoordinates (int x, int y)
{
@@ -1569,23 +1624,38 @@ public final class EmacsWindow extends EmacsHandleObject
public void
toggleOnScreenKeyboard (final boolean on)
{
+ FutureTask<Void> task;
+
/* Even though InputMethodManager functions are thread safe,
`showOnScreenKeyboard' etc must be called from the UI thread in
order to avoid deadlocks if the calls happen in tandem with a
call to a synchronizing function within
`onCreateInputConnection'. */
- EmacsService.SERVICE.runOnUiThread (new Runnable () {
+ task = new FutureTask<Void> (new Callable<Void> () {
@Override
- public void
- run ()
+ public Void
+ call ()
{
if (on)
view.showOnScreenKeyboard ();
else
view.hideOnScreenKeyboard ();
+ return null;
}
});
+
+ /* Block Lisp until this request to display the on-screen keyboard
+ is registered by the UI thread, or updates arising from a
+ redisplay that are reported between the two events will be liable
+ to run afoul of the IMM's cache of selection positions and never
+ reach the input method, if it is currently hidden, as input
+ methods receive outdated selection information reported during
+ the previous call to `onCreateInputConnection' when first
+ displayed.
+
+ Chances are this is a long-standing bug in the system. */
+ EmacsService.<Void>syncRunnable (task);
}
public String
@@ -1615,7 +1685,7 @@ public final class EmacsWindow extends EmacsHandleObject
fullscreen = isFullscreen;
tem = getAttachedConsumer ();
- if (tem != null)
+ if (tem != null && tem instanceof EmacsActivity)
{
activity = (EmacsActivity) tem;
activity.syncFullscreenWith (EmacsWindow.this);
diff --git a/java/org/gnu/emacs/EmacsWindowManager.java
b/java/org/gnu/emacs/EmacsWindowManager.java
index 49f0ebd5841..23dc71dbd29 100644
--- a/java/org/gnu/emacs/EmacsWindowManager.java
+++ b/java/org/gnu/emacs/EmacsWindowManager.java
@@ -145,7 +145,7 @@ public final class EmacsWindowManager
}
}
- EmacsNative.sendWindowAction ((short) 0, 0);
+ EmacsNative.sendWindowAction (0, 0);
}
public synchronized void
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index ea34d5f7b93..79db1ef2f47 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -1460,8 +1460,8 @@ local_sockname (int s, char sockname[socknamesize], int
tmpdirlen,
this user's directory and does not let others write to it; this
fends off some symlink attacks. To avoid races, keep the parent
directory open while checking. */
- char *emacsdirend = sockname + tmpdirlen + suffixlen -
- strlen(server_name) - 1;
+ char *emacsdirend = (sockname + tmpdirlen + suffixlen
+ - strlen (server_name) - 1);
*emacsdirend = '\0';
int dir = open (sockname, O_PATH | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC);
*emacsdirend = '/';
@@ -1505,6 +1505,7 @@ set_local_socket (char const *server_name)
}
else
{
+#ifndef HAVE_ANDROID
/* socket_name is a file name component. */
char const *xdg_runtime_dir = egetenv ("XDG_RUNTIME_DIR");
if (xdg_runtime_dir)
@@ -1534,10 +1535,35 @@ set_local_socket (char const *server_name)
if (tmpdirlen < 0)
tmpdirlen = snprintf (sockname, socknamesize, "/tmp");
}
+
sock_status = local_sockname (s, sockname, tmpdirlen,
uid, server_name);
tmpdir_used = true;
}
+#else /* HAVE_ANDROID */
+ char const *tmpdir;
+ int socknamelen;
+ uintmax_t uidmax;
+
+ /* The TMPDIR of any process to which this binary is
+ accessible must be reserved for Emacs, so the checks in
+ local_sockname and the like are redundant. */
+ tmpdir = egetenv ("TMPDIR");
+
+ /* Resort to the usual location of the cache directory, though
+ this location is not guaranteed to remain stable over
+ future releases of Android. */
+ if (!tmpdir)
+ tmpdir = "/data/data/org.gnu.emacs/cache";
+
+ uidmax = uid;
+ socknamelen = snprintf (sockname, socknamesize,
+ "%s/emacs%"PRIuMAX"/%s",
+ tmpdir, uidmax, server_name);
+ sock_status = (0 <= socknamelen && socknamelen < socknamesize
+ ? connect_socket (AT_FDCWD, sockname, s, 0)
+ : ENAMETOOLONG);
+#endif /* !HAVE_ANDROID */
}
if (sock_status == 0)
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 032cfa8010b..03bc55de03d 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -143,6 +143,12 @@ University of California, as described above. */
# define MERCURY_HEURISTICS_RATIO 0.5
#endif
+/* Work around GCC bug 114882
+ <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114882>. */
+#if GNUC_PREREQ (14, 0, 0)
+# pragma GCC diagnostic ignored "-Wanalyzer-use-of-uninitialized-value"
+#endif
+
/* COPY to DEST from SRC (containing LEN bytes), and append a NUL byte. */
static void
memcpyz (void *dest, void const *src, ptrdiff_t len)
@@ -243,12 +249,10 @@ endtoken (unsigned char c)
}
/*
- * xnew, xrnew -- allocate, reallocate storage
+ * xrnew -- reallocate storage
*
- * SYNOPSIS: Type *xnew (ptrdiff_t n, Type);
- * void xrnew (OldPointer, ptrdiff_t n, int multiplier);
+ * SYNOPSIS: void xrnew (OldPointer, ptrdiff_t n, int multiplier);
*/
-#define xnew(n, Type) ((Type *) xnmalloc (n, sizeof (Type)))
#define xrnew(op, n, m) ((op) = xnrealloc (op, n, (m) * sizeof *(op)))
typedef void Lang_function (FILE *);
@@ -701,7 +705,7 @@ and optionally Prolog-like definitions (first rule for a
predicate or \
function).\n\
To enable this behavior, run etags using --declarations.";
static bool with_mercury_definitions = false;
-float mercury_heuristics_ratio = MERCURY_HEURISTICS_RATIO;
+static float mercury_heuristics_ratio = MERCURY_HEURISTICS_RATIO;
static const char *Objc_suffixes [] =
{ "lm", /* Objective lex file */
@@ -1125,13 +1129,13 @@ main (int argc, char **argv)
progname = argv[0];
nincluded_files = 0;
- included_files = xnew (argc, char *);
+ included_files = xnmalloc (argc, sizeof *included_files);
current_arg = 0;
file_count = 0;
/* Allocate enough no matter what happens. Overkill, but each one
is small. */
- argbuffer = xnew (argc, argument);
+ argbuffer = xnmalloc (argc, sizeof *argbuffer);
/*
* Always find typedefs and structure tags.
@@ -1778,7 +1782,7 @@ process_file (FILE *fh, char *fn, language *lang)
infilename = fn;
/* Create a new input file description entry. */
- fdp = xnew (1, fdesc);
+ fdp = xmalloc (sizeof *fdp);
*fdp = emptyfdesc;
fdp->next = fdhead;
fdp->infname = savestr (fn);
@@ -2080,7 +2084,7 @@ pfnote (char *name, /* tag name, or NULL if
unnamed */
|| (!CTAGS && name && name[0] == '\0'))
return;
- np = xnew (1, node);
+ np = xmalloc (sizeof *np);
/* If ctags mode, change name "main" to M<thisfilename>. */
if (CTAGS && !cxref_style && streq (name, "main"))
@@ -2135,7 +2139,7 @@ push_node (node *np, stkentry **stack_top)
{
if (np)
{
- stkentry *new = xnew (1, stkentry);
+ stkentry *new = xmalloc (sizeof *new);
new->np = np;
new->next = *stack_top;
@@ -3425,8 +3429,8 @@ C_entries (int c_ext, /* extension of C */
{
cstack.size = (DEBUG) ? 1 : 4;
cstack.nl = 0;
- cstack.cname = xnew (cstack.size, char *);
- cstack.bracelev = xnew (cstack.size, ptrdiff_t);
+ cstack.cname = xnmalloc (cstack.size, sizeof *cstack.cname);
+ cstack.bracelev = xnmalloc (cstack.size, sizeof *cstack.bracelev);
}
tokoff = toklen = typdefbracelev = 0; /* keep compiler quiet */
@@ -5077,7 +5081,7 @@ Ruby_functions (FILE *inf)
if (writer)
{
size_t name_len = cp - np + 1;
- char *wr_name = xnew (name_len + 1, char);
+ char *wr_name = xmalloc (name_len + 1);
strcpy (mempcpy (wr_name, np, name_len - 1), "=");
pfnote (wr_name, true, lb.buffer, cp - lb.buffer + 1,
@@ -5854,7 +5858,7 @@ TEX_decode_env (const char *evarname, const char *defenv)
for (p = env; (p = strchr (p, ':')); )
if (*++p)
len++;
- TEX_toktab = xnew (len, linebuffer);
+ TEX_toktab = xnmalloc (len, sizeof *TEX_toktab);
/* Unpack environment string into token table. Be careful about */
/* zero-length strings (leading ':', "::" and trailing ':') */
@@ -7033,7 +7037,7 @@ add_regex (char *regexp_pattern, language *lang)
break;
}
- patbuf = xnew (1, struct re_pattern_buffer);
+ patbuf = xmalloc (sizeof *patbuf);
*patbuf = zeropattern;
if (ignore_case)
{
@@ -7064,7 +7068,7 @@ add_regex (char *regexp_pattern, language *lang)
}
rp = p_head;
- p_head = xnew (1, regexp);
+ p_head = xmalloc (sizeof *p_head);
p_head->pattern = savestr (regexp_pattern);
p_head->p_next = rp;
p_head->lang = lang;
@@ -7104,7 +7108,7 @@ substitute (char *in, char *out, struct re_registers
*regs)
/* Allocate space and do the substitutions. */
assert (size >= 0);
- result = xnew (size + 1, char);
+ result = xmalloc (size + 1);
for (t = result; *out != '\0'; out++)
if (*out == '\\' && c_isdigit (*++out))
@@ -7377,26 +7381,26 @@ readline (linebuffer *lbp, FILE *stream)
/* Check whether this is a #line directive. */
if (result > 12 && strneq (lbp->buffer, "#line ", 6))
{
- intmax_t lno;
- int start = 0;
+ char *lno_start = lbp->buffer + 6;
+ char *lno_end;
+ intmax_t lno = strtoimax (lno_start, &lno_end, 10);
+ char *quoted_filename
+ = lno_start < lno_end ? skip_spaces (lno_end) : NULL;
- if (sscanf (lbp->buffer, "#line %"SCNdMAX" \"%n", &lno, &start) >= 1
- && start > 0) /* double quote character found */
+ if (quoted_filename && *quoted_filename == '"')
{
- char *endp = lbp->buffer + start;
+ char *endp = quoted_filename;
+ while (*++endp && *endp != '"')
+ endp += *endp == '\\' && endp[1];
- while ((endp = strchr (endp, '"')) != NULL
- && endp[-1] == '\\')
- endp++;
- if (endp != NULL)
+ if (*endp)
/* Ok, this is a real #line directive. Let's deal with it. */
{
char *taggedabsname; /* absolute name of original file */
char *taggedfname; /* name of original file as given */
- char *name; /* temp var */
+ char *name = quoted_filename + 1;
discard_until_line_directive = false; /* found it */
- name = lbp->buffer + start;
*endp = '\0';
canonicalize_filename (name);
taggedabsname = absolute_filename (name, tagfiledir);
@@ -7452,7 +7456,7 @@ readline (linebuffer *lbp, FILE *stream)
if (fdp == NULL) /* not found */
{
fdp = fdhead;
- fdhead = xnew (1, fdesc);
+ fdhead = xmalloc (sizeof *fdhead);
*fdhead = *curfdp; /* copy curr. file description */
fdhead->next = fdp;
fdhead->infname = savestr (curfdp->infname);
@@ -7552,7 +7556,7 @@ readline (linebuffer *lbp, FILE *stream)
/*
* Return a pointer to a space of size strlen(cp)+1 allocated
- * with xnew where the string CP has been copied.
+ * with xmalloc where the string CP has been copied.
*/
static char *
savestr (const char *cp)
@@ -7561,13 +7565,13 @@ savestr (const char *cp)
}
/*
- * Return a pointer to a space of size LEN+1 allocated with xnew
+ * Return a pointer to a space of size LEN+1 allocated with xmalloc
* with a copy of CP (containing LEN bytes) followed by a NUL byte.
*/
static char *
savenstr (const char *cp, ptrdiff_t len)
{
- char *dp = xnew (len + 1, char);
+ char *dp = xmalloc (len + 1);
dp[len] = '\0';
return memcpy (dp, cp, len);
}
@@ -7650,7 +7654,7 @@ static char *
concat (const char *s1, const char *s2, const char *s3)
{
ptrdiff_t len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3);
- char *result = xnew (len1 + len2 + len3 + 1, char);
+ char *result = xmalloc (len1 + len2 + len3 + 1);
strcpy (stpcpy (stpcpy (result, s1), s2), s3);
return result;
}
@@ -7662,7 +7666,7 @@ static char *
etags_getcwd (void)
{
ptrdiff_t bufsize = 200;
- char *path = xnew (bufsize, char);
+ char *path = xmalloc (bufsize);
while (getcwd (path, bufsize) == NULL)
{
@@ -7748,7 +7752,7 @@ escape_shell_arg_string (char *str)
p++;
}
- char *new_str = xnew (need_space + 1, char);
+ char *new_str = xmalloc (need_space + 1);
new_str[0] = '\'';
new_str[need_space-1] = '\'';
@@ -7841,7 +7845,7 @@ relative_filename (char *file, char *dir)
i = 0;
while ((dp = strchr (dp + 1, '/')) != NULL)
i += 1;
- res = xnew (3*i + strlen (fp + 1) + 1, char);
+ res = xmalloc (3*i + strlen (fp + 1) + 1);
char *z = res;
while (i-- > 0)
z = stpcpy (z, "../");
@@ -7996,7 +8000,7 @@ static void
linebuffer_init (linebuffer *lbp)
{
lbp->size = (DEBUG) ? 3 : 200;
- lbp->buffer = xnew (lbp->size, char);
+ lbp->buffer = xmalloc (lbp->size);
lbp->buffer[0] = '\0';
lbp->len = 0;
}
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index ac4f320f9a5..ee589e03397 100644
--- a/lib-src/make-docfile.c
+++ b/lib-src/make-docfile.c
@@ -660,11 +660,11 @@ close_emacs_globals (ptrdiff_t num_symbols)
printf (("};\n"
"extern struct emacs_globals globals;\n"
"\n"
- "#ifndef DEFINE_SYMBOLS\n"
- "extern\n"
- "#endif\n"
- "struct Lisp_Symbol lispsym[%td];\n"),
- num_symbols);
+ "extern struct Lisp_Symbol lispsym[%td];\n"
+ "#ifdef DEFINE_SYMBOLS\n"
+ "struct Lisp_Symbol lispsym[%td];\n"
+ "#endif\n"),
+ num_symbols, num_symbols);
}
static void
diff --git a/lib/acl.h b/lib/acl.h
index a3aeb8fc86a..0bf78a654d2 100644
--- a/lib/acl.h
+++ b/lib/acl.h
@@ -28,6 +28,11 @@
#include <sys/types.h>
#include <sys/stat.h>
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
bool acl_errno_valid (int) _GL_ATTRIBUTE_CONST;
int file_has_acl (char const *, struct stat const *);
int qset_acl (char const *, int, mode_t);
@@ -36,4 +41,9 @@ int qcopy_acl (char const *, int, char const *, int, mode_t);
int copy_acl (char const *, int, char const *, int, mode_t);
int chmod_or_fchmod (char const *, int, mode_t);
+
+#ifdef __cplusplus
+}
+#endif
+
#endif
diff --git a/lib/allocator.h b/lib/allocator.h
index bb30a3440c2..53c8dfcacdf 100644
--- a/lib/allocator.h
+++ b/lib/allocator.h
@@ -22,6 +22,11 @@
#include <stddef.h>
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
/* An object describing a memory allocator family. */
struct allocator
@@ -55,4 +60,9 @@ struct allocator
/* An allocator using the stdlib functions and a null DIE function. */
extern struct allocator const stdlib_allocator;
+
+#ifdef __cplusplus
+}
+#endif
+
#endif /* _GL_ALLOCATOR_H */
diff --git a/lib/binary-io.h b/lib/binary-io.h
index 0cc5c11748c..1da018fad85 100644
--- a/lib/binary-io.h
+++ b/lib/binary-io.h
@@ -55,6 +55,11 @@ __gl_setmode (_GL_UNUSED int fd, _GL_UNUSED int mode)
}
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
/* Set FD's mode to MODE, which should be either O_TEXT or O_BINARY.
Return the old mode if successful, -1 (setting errno) on failure.
Ordinarily this function would be called 'setmode', since that is
@@ -74,6 +79,11 @@ set_binary_mode (int fd, int mode)
/* This macro is obsolescent. */
#define SET_BINARY(fd) ((void) set_binary_mode (fd, O_BINARY))
+
+#ifdef __cplusplus
+}
+#endif
+
_GL_INLINE_HEADER_END
#endif /* _BINARY_H */
diff --git a/lib/boot-time-aux.h b/lib/boot-time-aux.h
index 8b966fe691f..7f8c5405e4c 100644
--- a/lib/boot-time-aux.h
+++ b/lib/boot-time-aux.h
@@ -304,18 +304,35 @@ get_windows_boot_time (struct timespec *p_boot_time)
Instead, on Windows, the boot time can be retrieved by looking at the
time stamp of a file that (normally) gets touched only during the boot
process, namely C:\pagefile.sys. */
- const char * const boot_touched_file =
- #if defined __CYGWIN__ && !defined _WIN32
- "/cygdrive/c/pagefile.sys"
- #else
- "C:\\pagefile.sys"
- #endif
- ;
- struct stat statbuf;
- if (stat (boot_touched_file, &statbuf) >= 0)
+ const char * const boot_touched_files[] =
{
- *p_boot_time = get_stat_mtime (&statbuf);
- return 0;
+ #if defined __CYGWIN__ && !defined _WIN32
+ /* It is more portable to use /proc/cygdrive/c than /cygdrive/c. */
+ "/proc/cygdrive/c/pagefile.sys",
+ /* A fallback, working around a Cygwin 3.5.3 bug. It has a modification
+ time about 1.5 minutes after the last boot; but that's better than
+ nothing. */
+
"/proc/cygdrive/c/ProgramData/Microsoft/Windows/DeviceMetadataCache/dmrc.idx"
+ #else
+ "C:\\pagefile.sys"
+ #endif
+ };
+ for (idx_t i = 0; i < SIZEOF (boot_touched_files); i++)
+ {
+ const char *filename = boot_touched_files[i];
+ struct stat statbuf;
+ if (stat (filename, &statbuf) >= 0)
+ {
+# if defined __CYGWIN__ && !defined _WIN32
+ /* Work around a Cygwin 3.5.3 bug.
+ <https://cygwin.com/pipermail/cygwin/2024-May/255931.html> */
+ if (!S_ISDIR (statbuf.st_mode))
+# endif
+ {
+ *p_boot_time = get_stat_mtime (&statbuf);
+ return 0;
+ }
+ }
}
return -1;
}
diff --git a/lib/count-trailing-zeros.c b/lib/byteswap.c
similarity index 78%
copy from lib/count-trailing-zeros.c
copy to lib/byteswap.c
index e13f77788da..6e3dad74eaa 100644
--- a/lib/count-trailing-zeros.c
+++ b/lib/byteswap.c
@@ -1,6 +1,6 @@
-/* Count the number of trailing 0 bits in a word.
+/* Inline functions for <byteswap.h>.
- Copyright 2013-2024 Free Software Foundation, Inc.
+ Copyright 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
@@ -17,5 +17,5 @@
#include <config.h>
-#define COUNT_TRAILING_ZEROS_INLINE _GL_EXTERN_INLINE
-#include "count-trailing-zeros.h"
+#define _GL_BYTESWAP_INLINE _GL_EXTERN_INLINE
+#include <byteswap.h>
diff --git a/lib/byteswap.in.h b/lib/byteswap.in.h
index 8e49efad05a..4be335d9158 100644
--- a/lib/byteswap.in.h
+++ b/lib/byteswap.in.h
@@ -16,29 +16,100 @@
along with this program. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _GL_BYTESWAP_H
-#define _GL_BYTESWAP_H
+#define _GL_BYTESWAP_H 1
+
+/* This file uses _GL_INLINE. */
+#if !_GL_CONFIG_H_INCLUDED
+ #error "Please include config.h first."
+#endif
+
+#include <stdint.h>
+
+_GL_INLINE_HEADER_BEGIN
+#ifndef _GL_BYTESWAP_INLINE
+# define _GL_BYTESWAP_INLINE _GL_INLINE
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 8)
+# define _GL_BYTESWAP_HAS_BUILTIN_BSWAP16 true
+#elif defined __has_builtin
+# if __has_builtin (__builtin_bswap16)
+# define _GL_BYTESWAP_HAS_BUILTIN_BSWAP16 true
+# endif
+#endif
+
+#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)
+# define _GL_BYTESWAP_HAS_BUILTIN_BSWAP32 true
+# define _GL_BYTESWAP_HAS_BUILTIN_BSWAP64 true
+#elif defined __has_builtin
+# if __has_builtin (__builtin_bswap32)
+# define _GL_BYTESWAP_HAS_BUILTIN_BSWAP32 true
+# endif
+# if __has_builtin (__builtin_bswap64)
+# define _GL_BYTESWAP_HAS_BUILTIN_BSWAP64 true
+# endif
+#endif
/* Given an unsigned 16-bit argument X, return the value corresponding to
X with reversed byte order. */
-#define bswap_16(x) ((((x) & 0x00FF) << 8) | \
- (((x) & 0xFF00) >> 8))
+_GL_BYTESWAP_INLINE uint_least16_t
+bswap_16 (uint_least16_t x)
+{
+#ifdef _GL_BYTESWAP_HAS_BUILTIN_BSWAP16
+ return __builtin_bswap16 (x);
+#else
+ uint_fast16_t mask = 0xff;
+ return ( (x & mask << 8 * 1) >> 8 * 1
+ | (x & mask << 8 * 0) << 8 * 1);
+#endif
+}
/* Given an unsigned 32-bit argument X, return the value corresponding to
X with reversed byte order. */
-#define bswap_32(x) ((((x) & 0x000000FF) << 24) | \
- (((x) & 0x0000FF00) << 8) | \
- (((x) & 0x00FF0000) >> 8) | \
- (((x) & 0xFF000000) >> 24))
+_GL_BYTESWAP_INLINE uint_least32_t
+bswap_32 (uint_least32_t x)
+{
+#ifdef _GL_BYTESWAP_HAS_BUILTIN_BSWAP32
+ return __builtin_bswap32 (x);
+#else
+ uint_fast32_t mask = 0xff;
+ return ( (x & mask << 8 * 3) >> 8 * 3
+ | (x & mask << 8 * 2) >> 8 * 1
+ | (x & mask << 8 * 1) << 8 * 1
+ | (x & mask << 8 * 0) << 8 * 3);
+#endif
+}
+#ifdef UINT_LEAST64_MAX
/* Given an unsigned 64-bit argument X, return the value corresponding to
X with reversed byte order. */
-#define bswap_64(x) ((((x) & 0x00000000000000FFULL) << 56) | \
- (((x) & 0x000000000000FF00ULL) << 40) | \
- (((x) & 0x0000000000FF0000ULL) << 24) | \
- (((x) & 0x00000000FF000000ULL) << 8) | \
- (((x) & 0x000000FF00000000ULL) >> 8) | \
- (((x) & 0x0000FF0000000000ULL) >> 24) | \
- (((x) & 0x00FF000000000000ULL) >> 40) | \
- (((x) & 0xFF00000000000000ULL) >> 56))
+_GL_BYTESWAP_INLINE uint_least64_t
+bswap_64 (uint_least64_t x)
+{
+# ifdef _GL_BYTESWAP_HAS_BUILTIN_BSWAP64
+ return __builtin_bswap64 (x);
+# else
+ uint_fast64_t mask = 0xff;
+ return ( (x & mask << 8 * 7) >> 8 * 7
+ | (x & mask << 8 * 6) >> 8 * 5
+ | (x & mask << 8 * 5) >> 8 * 3
+ | (x & mask << 8 * 4) >> 8 * 1
+ | (x & mask << 8 * 3) << 8 * 1
+ | (x & mask << 8 * 2) << 8 * 3
+ | (x & mask << 8 * 1) << 8 * 5
+ | (x & mask << 8 * 0) << 8 * 7);
+# endif
+}
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+_GL_INLINE_HEADER_END
#endif /* _GL_BYTESWAP_H */
diff --git a/lib/careadlinkat.h b/lib/careadlinkat.h
index 473e6531e67..2c552b692af 100644
--- a/lib/careadlinkat.h
+++ b/lib/careadlinkat.h
@@ -28,6 +28,11 @@
#include <fcntl.h>
#include <unistd.h>
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
struct allocator;
/* Assuming the current directory is FD, get the symbolic link value
@@ -69,4 +74,9 @@ char *careadlinkat (int fd, char const *filename,
# endif
#endif
+
+#ifdef __cplusplus
+}
+#endif
+
#endif /* _GL_CAREADLINKAT_H */
diff --git a/lib/cloexec.h b/lib/cloexec.h
index f52e5f2ec0f..a7944d6dd5d 100644
--- a/lib/cloexec.h
+++ b/lib/cloexec.h
@@ -15,6 +15,11 @@
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 __cplusplus
+extern "C" {
+#endif
+
+
/* Set the 'FD_CLOEXEC' flag of DESC if VALUE is true,
or clear the flag if VALUE is false.
Return 0 on success, or -1 on error with 'errno' set.
@@ -32,3 +37,8 @@ int set_cloexec_flag (int desc, bool value);
be duplicated. */
int dup_cloexec (int fd);
+
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/lib/close-stream.h b/lib/close-stream.h
index 8a1b3c7ac2c..3c421dce513 100644
--- a/lib/close-stream.h
+++ b/lib/close-stream.h
@@ -17,4 +17,14 @@
#include <stdio.h>
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
int close_stream (FILE *stream);
+
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h
deleted file mode 100644
index 545749d6d27..00000000000
--- a/lib/count-leading-zeros.h
+++ /dev/null
@@ -1,138 +0,0 @@
-/* count-leading-zeros.h -- counts the number of leading 0 bits in a word.
- Copyright (C) 2012-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
- published by the Free Software Foundation; either version 2.1 of the
- License, or (at your option) any later version.
-
- This file is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public License
- along with this program. If not, see <https://www.gnu.org/licenses/>. */
-
-/* Written by Eric Blake. */
-
-#ifndef COUNT_LEADING_ZEROS_H
-#define COUNT_LEADING_ZEROS_H 1
-
-/* This file uses _GL_INLINE_HEADER_BEGIN, _GL_INLINE. */
-#if !_GL_CONFIG_H_INCLUDED
- #error "Please include config.h first."
-#endif
-
-#include <limits.h>
-#include <stdlib.h>
-
-_GL_INLINE_HEADER_BEGIN
-#ifndef COUNT_LEADING_ZEROS_INLINE
-# define COUNT_LEADING_ZEROS_INLINE _GL_INLINE
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* Assuming the GCC builtin is BUILTIN and the MSC builtin is MSC_BUILTIN,
- expand to code that computes the number of leading zeros of the local
- variable 'x' of type TYPE (an unsigned integer type) and return it
- from the current function. */
-#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) \
- || (__clang_major__ >= 4)
-# define COUNT_LEADING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
- return x ? BUILTIN (x) : CHAR_BIT * sizeof x;
-#elif _MSC_VER
-# pragma intrinsic (_BitScanReverse)
-# if defined _M_X64
-# pragma intrinsic (_BitScanReverse64)
-# endif
-# define COUNT_LEADING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
- do \
- { \
- unsigned long result; \
- if (MSC_BUILTIN (&result, x)) \
- return CHAR_BIT * sizeof x - 1 - result; \
- return CHAR_BIT * sizeof x; \
- } \
- while (0)
-#else
-# define COUNT_LEADING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
- do \
- { \
- int count; \
- unsigned int leading_32; \
- if (! x) \
- return CHAR_BIT * sizeof x; \
- for (count = 0; \
- (leading_32 = ((x >> (sizeof (TYPE) * CHAR_BIT - 32)) \
- & 0xffffffffU), \
- count < CHAR_BIT * sizeof x - 32 && !leading_32); \
- count += 32) \
- x = x << 31 << 1; \
- return count + count_leading_zeros_32 (leading_32); \
- } \
- while (0)
-
-/* Compute and return the number of leading zeros in X,
- where 0 < X < 2**32. */
-COUNT_LEADING_ZEROS_INLINE int
-count_leading_zeros_32 (unsigned int x)
-{
- /* <https://github.com/gibsjose/BitHacks>
- <https://www.fit.vutbr.cz/~ibarina/pub/bithacks.pdf> */
- static const char de_Bruijn_lookup[32] = {
- 31, 22, 30, 21, 18, 10, 29, 2, 20, 17, 15, 13, 9, 6, 28, 1,
- 23, 19, 11, 3, 16, 14, 7, 24, 12, 4, 8, 25, 5, 26, 27, 0
- };
-
- x |= x >> 1;
- x |= x >> 2;
- x |= x >> 4;
- x |= x >> 8;
- x |= x >> 16;
- return de_Bruijn_lookup[((x * 0x07c4acddU) & 0xffffffffU) >> 27];
-}
-#endif
-
-/* Compute and return the number of leading zeros in X. */
-COUNT_LEADING_ZEROS_INLINE int
-count_leading_zeros (unsigned int x)
-{
- COUNT_LEADING_ZEROS (__builtin_clz, _BitScanReverse, unsigned int);
-}
-
-/* Compute and return the number of leading zeros in X. */
-COUNT_LEADING_ZEROS_INLINE int
-count_leading_zeros_l (unsigned long int x)
-{
- COUNT_LEADING_ZEROS (__builtin_clzl, _BitScanReverse, unsigned long int);
-}
-
-/* Compute and return the number of leading zeros in X. */
-COUNT_LEADING_ZEROS_INLINE int
-count_leading_zeros_ll (unsigned long long int x)
-{
-#if (defined _MSC_VER && !defined __clang__) && !defined _M_X64
- /* 32-bit MSVC does not have _BitScanReverse64, only _BitScanReverse. */
- unsigned long result;
- if (_BitScanReverse (&result, (unsigned long) (x >> 32)))
- return CHAR_BIT * sizeof x - 1 - 32 - result;
- if (_BitScanReverse (&result, (unsigned long) x))
- return CHAR_BIT * sizeof x - 1 - result;
- return CHAR_BIT * sizeof x;
-#else
- COUNT_LEADING_ZEROS (__builtin_clzll, _BitScanReverse64,
- unsigned long long int);
-#endif
-}
-
-#ifdef __cplusplus
-}
-#endif
-
-_GL_INLINE_HEADER_END
-
-#endif /* COUNT_LEADING_ZEROS_H */
diff --git a/lib/count-one-bits.h b/lib/count-one-bits.h
deleted file mode 100644
index 8d67f8718a4..00000000000
--- a/lib/count-one-bits.h
+++ /dev/null
@@ -1,166 +0,0 @@
-/* count-one-bits.h -- counts the number of 1-bits in a word.
- Copyright (C) 2007-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
- published by the Free Software Foundation; either version 2.1 of the
- License, or (at your option) any later version.
-
- This file is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public License
- along with this program. If not, see <https://www.gnu.org/licenses/>. */
-
-/* Written by Ben Pfaff. */
-
-#ifndef COUNT_ONE_BITS_H
-#define COUNT_ONE_BITS_H 1
-
-/* This file uses _GL_INLINE_HEADER_BEGIN, _GL_INLINE. */
-#if !_GL_CONFIG_H_INCLUDED
- #error "Please include config.h first."
-#endif
-
-#include <limits.h>
-#include <stdlib.h>
-
-_GL_INLINE_HEADER_BEGIN
-#ifndef COUNT_ONE_BITS_INLINE
-# define COUNT_ONE_BITS_INLINE _GL_INLINE
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* Assuming the GCC builtin is GCC_BUILTIN and the MSC builtin is MSC_BUILTIN,
- expand to code that computes the number of 1-bits of the local
- variable 'x' of type TYPE (an unsigned integer type) and return it
- from the current function. */
-#if (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) \
- || (__clang_major__ >= 4)
-# define COUNT_ONE_BITS(GCC_BUILTIN, MSC_BUILTIN, TYPE) \
- return GCC_BUILTIN (x)
-#else
-
-/* Compute and return the number of 1-bits set in the least
- significant 32 bits of X. */
-COUNT_ONE_BITS_INLINE int
-count_one_bits_32 (unsigned int x)
-{
- x = ((x & 0xaaaaaaaaU) >> 1) + (x & 0x55555555U);
- x = ((x & 0xccccccccU) >> 2) + (x & 0x33333333U);
- x = (x >> 16) + (x & 0xffff);
- x = ((x & 0xf0f0) >> 4) + (x & 0x0f0f);
- return (x >> 8) + (x & 0x00ff);
-}
-
-/* Expand to code that computes the number of 1-bits of the local
- variable 'x' of type TYPE (an unsigned integer type) and return it
- from the current function. */
-# define COUNT_ONE_BITS_GENERIC(TYPE) \
- do \
- { \
- int count = 0; \
- int bits; \
- for (bits = 0; bits < sizeof (TYPE) * CHAR_BIT; bits += 32) \
- { \
- count += count_one_bits_32 (x); \
- x = x >> 31 >> 1; \
- } \
- return count; \
- } \
- while (0)
-
-# if 1500 <= _MSC_VER && (defined _M_IX86 || defined _M_X64)
-
-/* While gcc falls back to its own generic code if the machine
- on which it's running doesn't support popcount, with Microsoft's
- compiler we need to detect and fallback ourselves. */
-
-# if 0
-# include <intrin.h>
-# else
- /* Don't pollute the namespace with too many MSVC intrinsics. */
-# pragma intrinsic (__cpuid)
-# pragma intrinsic (__popcnt)
-# if defined _M_X64
-# pragma intrinsic (__popcnt64)
-# endif
-# endif
-
-# if !defined _M_X64
-static inline __popcnt64 (unsigned long long x)
-{
- return __popcnt ((unsigned int) (x >> 32)) + __popcnt ((unsigned int) x);
-}
-# endif
-
-/* Return nonzero if popcount is supported. */
-
-/* 1 if supported, 0 if not supported, -1 if unknown. */
-extern int popcount_support;
-
-COUNT_ONE_BITS_INLINE int
-popcount_supported (void)
-{
- if (popcount_support < 0)
- {
- /* Do as described in
-
<https://docs.microsoft.com/en-us/cpp/intrinsics/popcnt16-popcnt-popcnt64> */
- int cpu_info[4];
- __cpuid (cpu_info, 1);
- popcount_support = (cpu_info[2] >> 23) & 1;
- }
- return popcount_support;
-}
-
-# define COUNT_ONE_BITS(GCC_BUILTIN, MSC_BUILTIN, TYPE) \
- do \
- { \
- if (popcount_supported ()) \
- return MSC_BUILTIN (x); \
- else \
- COUNT_ONE_BITS_GENERIC (TYPE); \
- } \
- while (0)
-
-# else
-
-# define COUNT_ONE_BITS(GCC_BUILTIN, MSC_BUILTIN, TYPE) \
- COUNT_ONE_BITS_GENERIC (TYPE)
-
-# endif
-#endif
-
-/* Compute and return the number of 1-bits set in X. */
-COUNT_ONE_BITS_INLINE int
-count_one_bits (unsigned int x)
-{
- COUNT_ONE_BITS (__builtin_popcount, __popcnt, unsigned int);
-}
-
-/* Compute and return the number of 1-bits set in X. */
-COUNT_ONE_BITS_INLINE int
-count_one_bits_l (unsigned long int x)
-{
- COUNT_ONE_BITS (__builtin_popcountl, __popcnt, unsigned long int);
-}
-
-/* Compute and return the number of 1-bits set in X. */
-COUNT_ONE_BITS_INLINE int
-count_one_bits_ll (unsigned long long int x)
-{
- COUNT_ONE_BITS (__builtin_popcountll, __popcnt64, unsigned long long int);
-}
-
-#ifdef __cplusplus
-}
-#endif
-
-_GL_INLINE_HEADER_END
-
-#endif /* COUNT_ONE_BITS_H */
diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h
deleted file mode 100644
index ed1e0131147..00000000000
--- a/lib/count-trailing-zeros.h
+++ /dev/null
@@ -1,128 +0,0 @@
-/* count-trailing-zeros.h -- counts the number of trailing 0 bits in a word.
- Copyright 2013-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
- published by the Free Software Foundation; either version 2.1 of the
- License, or (at your option) any later version.
-
- This file is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public License
- along with this program. If not, see <https://www.gnu.org/licenses/>. */
-
-/* Written by Paul Eggert. */
-
-#ifndef COUNT_TRAILING_ZEROS_H
-#define COUNT_TRAILING_ZEROS_H 1
-
-/* This file uses _GL_INLINE_HEADER_BEGIN, _GL_INLINE. */
-#if !_GL_CONFIG_H_INCLUDED
- #error "Please include config.h first."
-#endif
-
-#include <limits.h>
-#include <stdlib.h>
-
-_GL_INLINE_HEADER_BEGIN
-#ifndef COUNT_TRAILING_ZEROS_INLINE
-# define COUNT_TRAILING_ZEROS_INLINE _GL_INLINE
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* Assuming the GCC builtin is BUILTIN and the MSC builtin is MSC_BUILTIN,
- expand to code that computes the number of trailing zeros of the local
- variable 'x' of type TYPE (an unsigned integer type) and return it
- from the current function. */
-#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) \
- || (__clang_major__ >= 4)
-# define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
- return x ? BUILTIN (x) : CHAR_BIT * sizeof x;
-#elif _MSC_VER
-# pragma intrinsic (_BitScanForward)
-# if defined _M_X64
-# pragma intrinsic (_BitScanForward64)
-# endif
-# define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
- do \
- { \
- unsigned long result; \
- return MSC_BUILTIN (&result, x) ? result : CHAR_BIT * sizeof x; \
- } \
- while (0)
-#else
-# define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
- do \
- { \
- int count = 0; \
- if (! x) \
- return CHAR_BIT * sizeof x; \
- for (count = 0; \
- (count < CHAR_BIT * sizeof x - 32 \
- && ! (x & 0xffffffffU)); \
- count += 32) \
- x = x >> 31 >> 1; \
- return count + count_trailing_zeros_32 (x); \
- } \
- while (0)
-
-/* Compute and return the number of trailing zeros in the least
- significant 32 bits of X. One of these bits must be nonzero. */
-COUNT_TRAILING_ZEROS_INLINE int
-count_trailing_zeros_32 (unsigned int x)
-{
- /* <https://github.com/gibsjose/BitHacks>
- <https://www.fit.vutbr.cz/~ibarina/pub/bithacks.pdf> */
- static const char de_Bruijn_lookup[32] = {
- 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8,
- 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9
- };
- return de_Bruijn_lookup[(((x & -x) * 0x077cb531U) & 0xffffffffU) >> 27];
-}
-#endif
-
-/* Compute and return the number of trailing zeros in X. */
-COUNT_TRAILING_ZEROS_INLINE int
-count_trailing_zeros (unsigned int x)
-{
- COUNT_TRAILING_ZEROS (__builtin_ctz, _BitScanForward, unsigned int);
-}
-
-/* Compute and return the number of trailing zeros in X. */
-COUNT_TRAILING_ZEROS_INLINE int
-count_trailing_zeros_l (unsigned long int x)
-{
- COUNT_TRAILING_ZEROS (__builtin_ctzl, _BitScanForward, unsigned long int);
-}
-
-/* Compute and return the number of trailing zeros in X. */
-COUNT_TRAILING_ZEROS_INLINE int
-count_trailing_zeros_ll (unsigned long long int x)
-{
-#if (defined _MSC_VER && !defined __clang__) && !defined _M_X64
- /* 32-bit MSVC does not have _BitScanForward64, only _BitScanForward. */
- unsigned long result;
- if (_BitScanForward (&result, (unsigned long) x))
- return result;
- if (_BitScanForward (&result, (unsigned long) (x >> 32)))
- return result + 32;
- return CHAR_BIT * sizeof x;
-#else
- COUNT_TRAILING_ZEROS (__builtin_ctzll, _BitScanForward64,
- unsigned long long int);
-#endif
-}
-
-#ifdef __cplusplus
-}
-#endif
-
-_GL_INLINE_HEADER_END
-
-#endif
diff --git a/lib/execinfo.in.h b/lib/execinfo.in.h
index 0ffb2c386e7..e017947bca4 100644
--- a/lib/execinfo.in.h
+++ b/lib/execinfo.in.h
@@ -30,6 +30,11 @@ _GL_INLINE_HEADER_BEGIN
# define _GL_EXECINFO_INLINE _GL_INLINE
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
_GL_EXECINFO_INLINE int
backtrace (void **buffer, int size)
{
@@ -54,6 +59,11 @@ backtrace_symbols_fd (void *const *buffer, int size, int fd)
(void) fd;
}
+
+#ifdef __cplusplus
+}
+#endif
+
_GL_INLINE_HEADER_END
#endif
diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h
index eea3b9542a5..1465ce594d7 100644
--- a/lib/fcntl.in.h
+++ b/lib/fcntl.in.h
@@ -51,7 +51,8 @@
#ifndef _@GUARD_PREFIX@_FCNTL_H
/* Needed before <sys/stat.h>.
- May also define off_t to a 64-bit type on native Windows. */
+ May also define off_t to a 64-bit type on native Windows.
+ Also defines off64_t on macOS, NetBSD, OpenBSD, MSVC, Cygwin, Haiku. */
#include <sys/types.h>
/* On some systems other than glibc, <sys/stat.h> is a prerequisite of
<fcntl.h>. On glibc systems, we would like to avoid namespace pollution.
diff --git a/lib/filevercmp.h b/lib/filevercmp.h
index 8c549fcda00..81f821d5267 100644
--- a/lib/filevercmp.h
+++ b/lib/filevercmp.h
@@ -27,6 +27,11 @@
#include <stddef.h>
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
/* Compare strings A and B as file names containing version numbers,
and return an integer that is negative, zero, or positive depending
on whether A compares less than, equal to, or greater than B.
@@ -80,4 +85,9 @@ int filevercmp (char const *a, char const *b)
_GL_ATTRIBUTE_PURE;
int filenvercmp (char const *a, ptrdiff_t alen, char const *b, ptrdiff_t blen)
_GL_ATTRIBUTE_PURE;
+
+#ifdef __cplusplus
+}
+#endif
+
#endif /* FILEVERCMP_H */
diff --git a/lib/fpending.h b/lib/fpending.h
index 28db3b403d9..345c0bc71d9 100644
--- a/lib/fpending.h
+++ b/lib/fpending.h
@@ -30,6 +30,16 @@
# include <stdio_ext.h>
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
#if !HAVE_DECL___FPENDING
size_t __fpending (FILE *) _GL_ATTRIBUTE_PURE;
#endif
+
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/lib/fsusage.h b/lib/fsusage.h
index d7ae5f63a36..da87859060c 100644
--- a/lib/fsusage.h
+++ b/lib/fsusage.h
@@ -19,9 +19,14 @@
/* Space usage statistics for a file system. Blocks are 512-byte. */
#if !defined FSUSAGE_H_
-# define FSUSAGE_H_
+#define FSUSAGE_H_
+
+#include <stdint.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
-# include <stdint.h>
struct fs_usage
{
@@ -36,4 +41,9 @@ struct fs_usage
int get_fs_usage (char const *file, char const *disk, struct fs_usage *fsp);
+
+#ifdef __cplusplus
+}
+#endif
+
#endif
diff --git a/lib/ftoastr.h b/lib/ftoastr.h
index ed43c961a04..94554863a1e 100644
--- a/lib/ftoastr.h
+++ b/lib/ftoastr.h
@@ -24,6 +24,11 @@
#include <float.h>
#include <stddef.h>
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
/* Store into BUF (of size BUFSIZE) an accurate minimal-precision
string representation of a floating point number. FLAGS affect the
formatting of the number. Pad the output string with spaces as
@@ -149,4 +154,9 @@ enum
#define DBL_BUFSIZE_BOUND ( DBL_STRLEN_BOUND + 1)
#define LDBL_BUFSIZE_BOUND (LDBL_STRLEN_BOUND + 1)
+
+#ifdef __cplusplus
+}
+#endif
+
#endif /* _GL_FTOASTR_H */
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 711ddcf1260..358d58d5015 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -86,9 +86,6 @@
# careadlinkat \
# close-stream \
# copy-file-range \
-# count-leading-zeros \
-# count-one-bits \
-# count-trailing-zeros \
# crypto/md5 \
# crypto/md5-buffer \
# crypto/sha1-buffer \
@@ -156,6 +153,9 @@
# stat-time \
# std-gnu11 \
# stdbool \
+# stdc_bit_width \
+# stdc_count_ones \
+# stdc_trailing_zeros \
# stdckdint \
# stddef \
# stdio \
@@ -358,9 +358,11 @@ GL_GENERATE_GMP_H_CONDITION = @GL_GENERATE_GMP_H_CONDITION@
GL_GENERATE_IEEE754_H_CONDITION = @GL_GENERATE_IEEE754_H_CONDITION@
GL_GENERATE_LIMITS_H_CONDITION = @GL_GENERATE_LIMITS_H_CONDITION@
GL_GENERATE_MINI_GMP_H_CONDITION = @GL_GENERATE_MINI_GMP_H_CONDITION@
+GL_GENERATE_STDBIT_H_CONDITION = @GL_GENERATE_STDBIT_H_CONDITION@
GL_GENERATE_STDCKDINT_H_CONDITION = @GL_GENERATE_STDCKDINT_H_CONDITION@
GL_GENERATE_STDDEF_H_CONDITION = @GL_GENERATE_STDDEF_H_CONDITION@
GL_GENERATE_STDINT_H_CONDITION = @GL_GENERATE_STDINT_H_CONDITION@
+GL_GNULIB_ABORT_DEBUG = @GL_GNULIB_ABORT_DEBUG@
GL_GNULIB_ACCESS = @GL_GNULIB_ACCESS@
GL_GNULIB_ALIGNED_ALLOC = @GL_GNULIB_ALIGNED_ALLOC@
GL_GNULIB_ALPHASORT = @GL_GNULIB_ALPHASORT@
@@ -618,6 +620,7 @@ GL_GNULIB_STRSEP = @GL_GNULIB_STRSEP@
GL_GNULIB_STRSIGNAL = @GL_GNULIB_STRSIGNAL@
GL_GNULIB_STRSTR = @GL_GNULIB_STRSTR@
GL_GNULIB_STRTOD = @GL_GNULIB_STRTOD@
+GL_GNULIB_STRTOF = @GL_GNULIB_STRTOF@
GL_GNULIB_STRTOIMAX = @GL_GNULIB_STRTOIMAX@
GL_GNULIB_STRTOK_R = @GL_GNULIB_STRTOK_R@
GL_GNULIB_STRTOL = @GL_GNULIB_STRTOL@
@@ -662,6 +665,20 @@ GL_GNULIB_VSPRINTF_POSIX = @GL_GNULIB_VSPRINTF_POSIX@
GL_GNULIB_WCTOMB = @GL_GNULIB_WCTOMB@
GL_GNULIB_WRITE = @GL_GNULIB_WRITE@
GL_GNULIB__EXIT = @GL_GNULIB__EXIT@
+GL_STDC_BIT_CEIL = @GL_STDC_BIT_CEIL@
+GL_STDC_BIT_FLOOR = @GL_STDC_BIT_FLOOR@
+GL_STDC_BIT_WIDTH = @GL_STDC_BIT_WIDTH@
+GL_STDC_COUNT_ONES = @GL_STDC_COUNT_ONES@
+GL_STDC_COUNT_ZEROS = @GL_STDC_COUNT_ZEROS@
+GL_STDC_FIRST_LEADING_ONE = @GL_STDC_FIRST_LEADING_ONE@
+GL_STDC_FIRST_LEADING_ZERO = @GL_STDC_FIRST_LEADING_ZERO@
+GL_STDC_FIRST_TRAILING_ONE = @GL_STDC_FIRST_TRAILING_ONE@
+GL_STDC_FIRST_TRAILING_ZERO = @GL_STDC_FIRST_TRAILING_ZERO@
+GL_STDC_HAS_SINGLE_BIT = @GL_STDC_HAS_SINGLE_BIT@
+GL_STDC_LEADING_ONES = @GL_STDC_LEADING_ONES@
+GL_STDC_LEADING_ZEROS = @GL_STDC_LEADING_ZEROS@
+GL_STDC_TRAILING_ONES = @GL_STDC_TRAILING_ONES@
+GL_STDC_TRAILING_ZEROS = @GL_STDC_TRAILING_ZEROS@
GMALLOC_OBJ = @GMALLOC_OBJ@
GMP_H = @GMP_H@
GNULIBHEADERS_OVERRIDE_WINT_T = @GNULIBHEADERS_OVERRIDE_WINT_T@
@@ -809,6 +826,7 @@ HAVE_MKSTEMPS = @HAVE_MKSTEMPS@
HAVE_MODULES = @HAVE_MODULES@
HAVE_NANOSLEEP = @HAVE_NANOSLEEP@
HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@
+HAVE_OFF64_T = @HAVE_OFF64_T@
HAVE_OPENAT = @HAVE_OPENAT@
HAVE_OPENDIR = @HAVE_OPENDIR@
HAVE_OS_H = @HAVE_OS_H@
@@ -872,6 +890,7 @@ HAVE_STRPBRK = @HAVE_STRPBRK@
HAVE_STRPTIME = @HAVE_STRPTIME@
HAVE_STRSEP = @HAVE_STRSEP@
HAVE_STRTOD = @HAVE_STRTOD@
+HAVE_STRTOF = @HAVE_STRTOF@
HAVE_STRTOL = @HAVE_STRTOL@
HAVE_STRTOLD = @HAVE_STRTOLD@
HAVE_STRTOLL = @HAVE_STRTOLL@
@@ -922,12 +941,10 @@ INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INT32_MAX_LT_INTMAX_MAX = @INT32_MAX_LT_INTMAX_MAX@
INT64_MAX_EQ_LONG_MAX = @INT64_MAX_EQ_LONG_MAX@
+IS_D8_R8 = @IS_D8_R8@
JARSIGNER = @JARSIGNER@
JAVAC = @JAVAC@
JPEG_CFLAGS = @JPEG_CFLAGS@
-JSON_CFLAGS = @JSON_CFLAGS@
-JSON_LIBS = @JSON_LIBS@
-JSON_OBJ = @JSON_OBJ@
KQUEUE_CFLAGS = @KQUEUE_CFLAGS@
KQUEUE_LIBS = @KQUEUE_LIBS@
KRB4LIB = @KRB4LIB@
@@ -1017,9 +1034,12 @@ NDK_BUILD_ARCH = @NDK_BUILD_ARCH@
NDK_BUILD_CC = @NDK_BUILD_CC@
NDK_BUILD_CFLAGS = @NDK_BUILD_CFLAGS@
NDK_BUILD_CXX = @NDK_BUILD_CXX@
+NDK_BUILD_CXX_LDFLAGS = @NDK_BUILD_CXX_LDFLAGS@
NDK_BUILD_CXX_SHARED = @NDK_BUILD_CXX_SHARED@
+NDK_BUILD_CXX_STL = @NDK_BUILD_CXX_STL@
NDK_BUILD_MODULES = @NDK_BUILD_MODULES@
NDK_BUILD_NASM = @NDK_BUILD_NASM@
+NDK_BUILD_READELF = @NDK_BUILD_READELF@
NDK_BUILD_SDK = @NDK_BUILD_SDK@
NEXT_ASSERT_H = @NEXT_ASSERT_H@
NEXT_AS_FIRST_DIRECTIVE_ASSERT_H = @NEXT_AS_FIRST_DIRECTIVE_ASSERT_H@
@@ -1068,6 +1088,7 @@ NS_OBJ = @NS_OBJ@
NS_OBJC_OBJ = @NS_OBJC_OBJ@
NTDIR = @NTDIR@
NTLIB = @NTLIB@
+NULLPTR_T_NEEDS_STDDEF = @NULLPTR_T_NEEDS_STDDEF@
OBJC = @OBJC@
OBJCFLAGS = @OBJCFLAGS@
OBJEXT = @OBJEXT@
@@ -1101,6 +1122,8 @@ PTRDIFF_T_SUFFIX = @PTRDIFF_T_SUFFIX@
QCOPY_ACL_LIB = @QCOPY_ACL_LIB@
RALLOC_OBJ = @RALLOC_OBJ@
RANLIB = @RANLIB@
+READELF = @READELF@
+REPLACE_ABORT = @REPLACE_ABORT@
REPLACE_ACCESS = @REPLACE_ACCESS@
REPLACE_ALIGNED_ALLOC = @REPLACE_ALIGNED_ALLOC@
REPLACE_CALLOC_FOR_CALLOC_GNU = @REPLACE_CALLOC_FOR_CALLOC_GNU@
@@ -1258,6 +1281,7 @@ REPLACE_STRNLEN = @REPLACE_STRNLEN@
REPLACE_STRSIGNAL = @REPLACE_STRSIGNAL@
REPLACE_STRSTR = @REPLACE_STRSTR@
REPLACE_STRTOD = @REPLACE_STRTOD@
+REPLACE_STRTOF = @REPLACE_STRTOF@
REPLACE_STRTOIMAX = @REPLACE_STRTOIMAX@
REPLACE_STRTOK_R = @REPLACE_STRTOK_R@
REPLACE_STRTOL = @REPLACE_STRTOL@
@@ -1306,8 +1330,10 @@ SIZE_T_SUFFIX = @SIZE_T_SUFFIX@
SMALL_JA_DIC = @SMALL_JA_DIC@
SQLITE3_CFLAGS = @SQLITE3_CFLAGS@
SQLITE3_LIBS = @SQLITE3_LIBS@
+STDBIT_H = @STDBIT_H@
STDCKDINT_H = @STDCKDINT_H@
STDDEF_H = @STDDEF_H@
+STDDEF_NOT_IDEMPOTENT = @STDDEF_NOT_IDEMPOTENT@
STDINT_H = @STDINT_H@
SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@
SYSTEM_TYPE = @SYSTEM_TYPE@
@@ -1434,6 +1460,7 @@ gl_GNULIB_ENABLED_open_CONDITION =
@gl_GNULIB_ENABLED_open_CONDITION@
gl_GNULIB_ENABLED_rawmemchr_CONDITION = @gl_GNULIB_ENABLED_rawmemchr_CONDITION@
gl_GNULIB_ENABLED_strtoll_CONDITION = @gl_GNULIB_ENABLED_strtoll_CONDITION@
gl_GNULIB_ENABLED_utimens_CONDITION = @gl_GNULIB_ENABLED_utimens_CONDITION@
+gl_GNULIB_ENABLED_verify_CONDITION = @gl_GNULIB_ENABLED_verify_CONDITION@
gl_LIBOBJDEPS = @gl_LIBOBJDEPS@
gl_LIBOBJS = @gl_LIBOBJS@
gl_LTLIBOBJS = @gl_LTLIBOBJS@
@@ -1631,6 +1658,7 @@ ifneq (,$(GL_GENERATE_BYTESWAP_H_CONDITION))
byteswap.h: byteswap.in.h $(top_builddir)/config.status
$(gl_V_at)$(SED_HEADER_TO_AT_t) $(srcdir)/byteswap.in.h
$(AM_V_at)mv $@-t $@
+libgnu_a_SOURCES += byteswap.c
else
byteswap.h: $(top_builddir)/config.status
rm -f $@
@@ -1710,36 +1738,6 @@ endif
endif
## end gnulib module copy-file-range
-## begin gnulib module count-leading-zeros
-ifeq (,$(OMIT_GNULIB_MODULE_count-leading-zeros))
-
-libgnu_a_SOURCES += count-leading-zeros.c
-
-EXTRA_DIST += count-leading-zeros.h
-
-endif
-## end gnulib module count-leading-zeros
-
-## begin gnulib module count-one-bits
-ifeq (,$(OMIT_GNULIB_MODULE_count-one-bits))
-
-libgnu_a_SOURCES += count-one-bits.c
-
-EXTRA_DIST += count-one-bits.h
-
-endif
-## end gnulib module count-one-bits
-
-## begin gnulib module count-trailing-zeros
-ifeq (,$(OMIT_GNULIB_MODULE_count-trailing-zeros))
-
-libgnu_a_SOURCES += count-trailing-zeros.c
-
-EXTRA_DIST += count-trailing-zeros.h
-
-endif
-## end gnulib module count-trailing-zeros
-
## begin gnulib module crypto/md5
ifeq (,$(OMIT_GNULIB_MODULE_crypto/md5))
@@ -2195,6 +2193,7 @@ SED_HEADER_STDOUT = sed -e 1h -e '1$(SED_HEADER_NOEDIT)'
-e 1G
SED_HEADER_TO_AT_t = $(SED_HEADER_STDOUT) -n -e 'w $@-t'
# Use $(gl_V_at) instead of $(AM_V_GEN) or $(AM_V_at) on a line that
+# is its recipe's first line if and only if @NMD@ lines are absent.
gl_V_at = $(AM_V_GEN)
endif
@@ -3040,6 +3039,84 @@ EXTRA_DIST += stat-time.h
endif
## end gnulib module stat-time
+## begin gnulib module stdbit-h
+ifeq (,$(OMIT_GNULIB_MODULE_stdbit-h))
+
+BUILT_SOURCES += $(STDBIT_H)
+
+# We need the following in order to create <stdbit.h> when the system
+# doesn't have one that works with the given compiler.
+ifneq (,$(GL_GENERATE_STDBIT_H_CONDITION))
+stdbit.h: stdbit.in.h $(top_builddir)/config.status
+ $(gl_V_at)$(SED_HEADER_STDOUT) \
+ -e 's/@''GL_STDC_LEADING_ZEROS''@/$(GL_STDC_LEADING_ZEROS)/g' \
+ -e 's/@''GL_STDC_LEADING_ONES''@/$(GL_STDC_LEADING_ONES)/g' \
+ -e 's/@''GL_STDC_TRAILING_ZEROS''@/$(GL_STDC_TRAILING_ZEROS)/g' \
+ -e 's/@''GL_STDC_TRAILING_ONES''@/$(GL_STDC_TRAILING_ONES)/g' \
+ -e
's/@''GL_STDC_FIRST_LEADING_ZERO''@/$(GL_STDC_FIRST_LEADING_ZERO)/g' \
+ -e 's/@''GL_STDC_FIRST_LEADING_ONE''@/$(GL_STDC_FIRST_LEADING_ONE)/g'
\
+ -e
's/@''GL_STDC_FIRST_TRAILING_ZERO''@/$(GL_STDC_FIRST_TRAILING_ZERO)/g' \
+ -e
's/@''GL_STDC_FIRST_TRAILING_ONE''@/$(GL_STDC_FIRST_TRAILING_ONE)/g' \
+ -e 's/@''GL_STDC_COUNT_ZEROS''@/$(GL_STDC_COUNT_ZEROS)/g' \
+ -e 's/@''GL_STDC_COUNT_ONES''@/$(GL_STDC_COUNT_ONES)/g' \
+ -e 's/@''GL_STDC_HAS_SINGLE_BIT''@/$(GL_STDC_HAS_SINGLE_BIT)/g' \
+ -e 's/@''GL_STDC_BIT_WIDTH''@/$(GL_STDC_BIT_WIDTH)/g' \
+ -e 's/@''GL_STDC_BIT_FLOOR''@/$(GL_STDC_BIT_FLOOR)/g' \
+ -e 's/@''GL_STDC_BIT_CEIL''@/$(GL_STDC_BIT_CEIL)/g' \
+ $(srcdir)/stdbit.in.h > $@-t
+ $(AM_V_at)mv $@-t $@
+libgnu_a_SOURCES += stdbit.c
+else
+stdbit.h: $(top_builddir)/config.status
+ rm -f $@
+endif
+MOSTLYCLEANFILES += stdbit.h stdbit.h-t
+
+EXTRA_DIST += stdbit.in.h
+
+endif
+## end gnulib module stdbit-h
+
+## begin gnulib module stdc_bit_width
+ifeq (,$(OMIT_GNULIB_MODULE_stdc_bit_width))
+
+ifneq (,$(GL_GENERATE_STDBIT_H_CONDITION))
+libgnu_a_SOURCES += stdc_bit_width.c
+endif
+
+endif
+## end gnulib module stdc_bit_width
+
+## begin gnulib module stdc_count_ones
+ifeq (,$(OMIT_GNULIB_MODULE_stdc_count_ones))
+
+ifneq (,$(GL_GENERATE_STDBIT_H_CONDITION))
+libgnu_a_SOURCES += stdc_count_ones.c
+endif
+
+endif
+## end gnulib module stdc_count_ones
+
+## begin gnulib module stdc_leading_zeros
+ifeq (,$(OMIT_GNULIB_MODULE_stdc_leading_zeros))
+
+ifneq (,$(GL_GENERATE_STDBIT_H_CONDITION))
+libgnu_a_SOURCES += stdc_leading_zeros.c
+endif
+
+endif
+## end gnulib module stdc_leading_zeros
+
+## begin gnulib module stdc_trailing_zeros
+ifeq (,$(OMIT_GNULIB_MODULE_stdc_trailing_zeros))
+
+ifneq (,$(GL_GENERATE_STDBIT_H_CONDITION))
+libgnu_a_SOURCES += stdc_trailing_zeros.c
+endif
+
+endif
+## end gnulib module stdc_trailing_zeros
+
## begin gnulib module stdckdint
ifeq (,$(OMIT_GNULIB_MODULE_stdckdint))
@@ -3078,9 +3155,11 @@ stddef.h: stddef.in.h $(top_builddir)/config.status
-e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_STDDEF_H''@|$(NEXT_STDDEF_H)|g' \
+ -e 's|@''NULLPTR_T_NEEDS_STDDEF''@|$(NULLPTR_T_NEEDS_STDDEF)|g' \
+ -e 's|@''STDDEF_NOT_IDEMPOTENT''@|$(STDDEF_NOT_IDEMPOTENT)|g' \
+ -e 's|@''REPLACE_NULL''@|$(REPLACE_NULL)|g' \
-e 's|@''HAVE_MAX_ALIGN_T''@|$(HAVE_MAX_ALIGN_T)|g' \
-e 's|@''HAVE_WCHAR_T''@|$(HAVE_WCHAR_T)|g' \
- -e 's|@''REPLACE_NULL''@|$(REPLACE_NULL)|g' \
$(srcdir)/stddef.in.h > $@-t
$(AM_V_at)mv $@-t $@
else
@@ -3311,6 +3390,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status
$(CXXDEFS_H) \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_STDLIB_H''@|$(NEXT_STDLIB_H)|g' \
-e 's/@''GNULIB__EXIT''@/$(GL_GNULIB__EXIT)/g' \
+ -e 's/@''GNULIB_ABORT_DEBUG''@/$(GL_GNULIB_ABORT_DEBUG)/g' \
-e 's/@''GNULIB_ALIGNED_ALLOC''@/$(GL_GNULIB_ALIGNED_ALLOC)/g' \
-e 's/@''GNULIB_ATOLL''@/$(GL_GNULIB_ATOLL)/g' \
-e 's/@''GNULIB_CALLOC_GNU''@/$(GL_GNULIB_CALLOC_GNU)/g' \
@@ -3347,6 +3427,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status
$(CXXDEFS_H) \
-e 's/@''GNULIB_SECURE_GETENV''@/$(GL_GNULIB_SECURE_GETENV)/g' \
-e 's/@''GNULIB_SETENV''@/$(GL_GNULIB_SETENV)/g' \
-e 's/@''GNULIB_STRTOD''@/$(GL_GNULIB_STRTOD)/g' \
+ -e 's/@''GNULIB_STRTOF''@/$(GL_GNULIB_STRTOF)/g' \
-e 's/@''GNULIB_STRTOL''@/$(GL_GNULIB_STRTOL)/g' \
-e 's/@''GNULIB_STRTOLD''@/$(GL_GNULIB_STRTOLD)/g' \
-e 's/@''GNULIB_STRTOLL''@/$(GL_GNULIB_STRTOLL)/g' \
@@ -3399,6 +3480,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status
$(CXXDEFS_H) \
-e 's|@''HAVE_SETSTATE''@|$(HAVE_SETSTATE)|g' \
-e 's|@''HAVE_DECL_SETSTATE''@|$(HAVE_DECL_SETSTATE)|g' \
-e 's|@''HAVE_STRTOD''@|$(HAVE_STRTOD)|g' \
+ -e 's|@''HAVE_STRTOF''@|$(HAVE_STRTOF)|g' \
-e 's|@''HAVE_STRTOL''@|$(HAVE_STRTOL)|g' \
-e 's|@''HAVE_STRTOLD''@|$(HAVE_STRTOLD)|g' \
-e 's|@''HAVE_STRTOLL''@|$(HAVE_STRTOLL)|g' \
@@ -3411,6 +3493,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status
$(CXXDEFS_H) \
< $@-t1 > $@-t2
$(AM_V_at)sed \
-e 's|@''REPLACE__EXIT''@|$(REPLACE__EXIT)|g' \
+ -e 's|@''REPLACE_ABORT''@|$(REPLACE_ABORT)|g' \
-e 's|@''REPLACE_ALIGNED_ALLOC''@|$(REPLACE_ALIGNED_ALLOC)|g' \
-e
's|@''REPLACE_CALLOC_FOR_CALLOC_GNU''@|$(REPLACE_CALLOC_FOR_CALLOC_GNU)|g' \
-e
's|@''REPLACE_CALLOC_FOR_CALLOC_POSIX''@|$(REPLACE_CALLOC_FOR_CALLOC_POSIX)|g' \
@@ -3444,6 +3527,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status
$(CXXDEFS_H) \
-e 's|@''REPLACE_SETENV''@|$(REPLACE_SETENV)|g' \
-e 's|@''REPLACE_SETSTATE''@|$(REPLACE_SETSTATE)|g' \
-e 's|@''REPLACE_STRTOD''@|$(REPLACE_STRTOD)|g' \
+ -e 's|@''REPLACE_STRTOF''@|$(REPLACE_STRTOF)|g' \
-e 's|@''REPLACE_STRTOL''@|$(REPLACE_STRTOL)|g' \
-e 's|@''REPLACE_STRTOLD''@|$(REPLACE_STRTOLD)|g' \
-e 's|@''REPLACE_STRTOLL''@|$(REPLACE_STRTOLL)|g' \
@@ -3833,6 +3917,7 @@ sys/types.h: sys_types.in.h $(top_builddir)/config.status
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_SYS_TYPES_H''@|$(NEXT_SYS_TYPES_H)|g' \
-e 's|@''WINDOWS_64_BIT_OFF_T''@|$(WINDOWS_64_BIT_OFF_T)|g' \
+ -e 's|@''HAVE_OFF64_T''@|$(HAVE_OFF64_T)|g' \
-e 's|@''WINDOWS_STAT_INODES''@|$(WINDOWS_STAT_INODES)|g' \
$(srcdir)/sys_types.in.h > $@-t
$(AM_V_at)mv $@-t $@
@@ -4254,7 +4339,9 @@ endif
## begin gnulib module verify
ifeq (,$(OMIT_GNULIB_MODULE_verify))
+ifneq (,$(gl_GNULIB_ENABLED_verify_CONDITION))
+endif
EXTRA_DIST += verify.h
endif
diff --git a/lib/idx.h b/lib/idx.h
index f9ce0acd57d..43793f2d625 100644
--- a/lib/idx.h
+++ b/lib/idx.h
@@ -111,6 +111,11 @@
help producing good code and good warnings. The type 'idx_t' could
then be typedef'ed to a range type that is signed after promotion. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
/* In the future, idx_t could be typedef'ed to a signed range type.
The clang "extended integer types", supported in Clang 11 or newer
<https://clang.llvm.org/docs/LanguageExtensions.html#extended-integer-types>,
@@ -131,4 +136,9 @@ typedef ptrdiff_t idx_t;
Perhaps there should be another macro IDX_VALUE_BITS that does not
count the sign bit and is therefore one less than PTRDIFF_WIDTH. */
+
+#ifdef __cplusplus
+}
+#endif
+
#endif /* _IDX_H */
diff --git a/lib/intprops-internal.h b/lib/intprops-internal.h
index c8a87d2bb27..443024c6657 100644
--- a/lib/intprops-internal.h
+++ b/lib/intprops-internal.h
@@ -169,7 +169,9 @@
/* Work around GCC bug 91450. */
# define _GL_INT_MULTIPLY_WRAPV(a, b, r) \
((!_GL_SIGNED_TYPE_OR_EXPR (*(r)) && _GL_EXPR_SIGNED (a) &&
_GL_EXPR_SIGNED (b) \
- && _GL_INT_MULTIPLY_RANGE_OVERFLOW (a, b, 0, (__typeof__ (*(r))) -1)) \
+ && _GL_INT_MULTIPLY_RANGE_OVERFLOW (a, b, \
+ (__typeof__ (*(r))) 0, \
+ (__typeof__ (*(r))) -1)) \
? ((void) __builtin_mul_overflow (a, b, r), 1) \
: __builtin_mul_overflow (a, b, r))
# endif
@@ -183,10 +185,10 @@
/* Nonzero if this compiler has GCC bug 68193 or Clang bug 25390. See:
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=68193
https://llvm.org/bugs/show_bug.cgi?id=25390
- For now, assume all versions of GCC-like compilers generate bogus
+ For now, assume GCC < 14 and all Clang versions generate bogus
warnings for _Generic. This matters only for compilers that
lack relevant builtins. */
-#if __GNUC__ || defined __clang__
+#if (__GNUC__ && __GNUC__ < 14) || defined __clang__
# define _GL__GENERIC_BOGUS 1
#else
# define _GL__GENERIC_BOGUS 0
diff --git a/lib/memset_explicit.c b/lib/memset_explicit.c
index cf6cc647847..33c09873482 100644
--- a/lib/memset_explicit.c
+++ b/lib/memset_explicit.c
@@ -16,11 +16,7 @@
#include <config.h>
-/* memset_s need this define */
-#if HAVE_MEMSET_S
-# define __STDC_WANT_LIB_EXT1__ 1
-#endif
-
+/* Specification. */
#include <string.h>
/* Set S's bytes to C, where S has LEN bytes. The compiler will not
diff --git a/lib/mini-gmp.c b/lib/mini-gmp.c
index 69a72bfd460..c580a8fc025 100644
--- a/lib/mini-gmp.c
+++ b/lib/mini-gmp.c
@@ -2809,6 +2809,7 @@ mpz_gcdext (mpz_t g, mpz_t s, mpz_t t, const mpz_t u,
const mpz_t v)
mpz_t tu, tv, s0, s1, t0, t1;
mp_bitcnt_t uz, vz, gz;
mp_bitcnt_t power;
+ int cmp;
if (u->_mp_size == 0)
{
@@ -2960,12 +2961,21 @@ mpz_gcdext (mpz_t g, mpz_t s, mpz_t t, const mpz_t u,
const mpz_t v)
mpz_tdiv_q_2exp (t0, t0, 1);
}
- /* Arrange so that |s| < |u| / 2g */
+ /* Choose small cofactors (they should generally satify
+
+ |s| < |u| / 2g and |t| < |v| / 2g,
+
+ with some documented exceptions). Always choose the smallest s,
+ if there are two choices for s with same absolute value, choose
+ the one with smallest corresponding t (this asymmetric condition
+ is needed to prefer s = 0, |t| = 1 when g = |a| = |b|). */
mpz_add (s1, s0, s1);
- if (mpz_cmpabs (s0, s1) > 0)
+ mpz_sub (t1, t0, t1);
+ cmp = mpz_cmpabs (s0, s1);
+ if (cmp > 0 || (cmp == 0 && mpz_cmpabs (t0, t1) > 0))
{
mpz_swap (s0, s1);
- mpz_sub (t0, t0, t1);
+ mpz_swap (t0, t1);
}
if (u->_mp_size < 0)
mpz_neg (s0, s0);
diff --git a/lib/openat-priv.h b/lib/openat-priv.h
index 7fd4beb5a73..63093f4597e 100644
--- a/lib/openat-priv.h
+++ b/lib/openat-priv.h
@@ -24,6 +24,11 @@
#include <limits.h>
#include <stdlib.h>
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
/* Maximum number of bytes that it is safe to allocate as a single
array on the stack, and that is known as a compile-time constant.
The assumption is that we'll touch the array very quickly, or a
@@ -61,4 +66,9 @@ int at_func2 (int fd1, char const *file1,
int fd2, char const *file2,
int (*func) (char const *file1, char const *file2));
+
+#ifdef __cplusplus
+}
+#endif
+
#endif /* _GL_HEADER_OPENAT_PRIV */
diff --git a/lib/openat.h b/lib/openat.h
index dc34092bb3f..b6b94f68c75 100644
--- a/lib/openat.h
+++ b/lib/openat.h
@@ -33,6 +33,11 @@
_GL_INLINE_HEADER_BEGIN
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
#if !HAVE_OPENAT
int openat_permissive (int fd, char const *file, int flags, mode_t mode,
@@ -122,6 +127,11 @@ lstatat (int fd, char const *name, struct stat *st)
wrappers are not provided for accessat or euidaccessat, so as to
avoid dragging in -lgen on some platforms. */
+
+#ifdef __cplusplus
+}
+#endif
+
_GL_INLINE_HEADER_END
#endif /* _GL_HEADER_OPENAT */
diff --git a/lib/save-cwd.h b/lib/save-cwd.h
index 692e4b97be2..9d314c2cf45 100644
--- a/lib/save-cwd.h
+++ b/lib/save-cwd.h
@@ -19,7 +19,12 @@
/* Written by Jim Meyering. */
#ifndef SAVE_CWD_H
-# define SAVE_CWD_H 1
+#define SAVE_CWD_H 1
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
struct saved_cwd
{
@@ -31,4 +36,9 @@ int save_cwd (struct saved_cwd *cwd);
int restore_cwd (const struct saved_cwd *cwd);
void free_cwd (struct saved_cwd *cwd);
+
+#ifdef __cplusplus
+}
+#endif
+
#endif /* SAVE_CWD_H */
diff --git a/lib/sha512.c b/lib/sha512.c
index 9eb036fb327..6750041bc7b 100644
--- a/lib/sha512.c
+++ b/lib/sha512.c
@@ -35,7 +35,7 @@
#ifdef WORDS_BIGENDIAN
# define SWAP(n) (n)
#else
-# define SWAP(n) bswap_64 (n)
+# define SWAP(n) u64bswap (n)
#endif
#if ! HAVE_OPENSSL_SHA512
diff --git a/lib/count-leading-zeros.c b/lib/stdbit.c
similarity index 77%
copy from lib/count-leading-zeros.c
copy to lib/stdbit.c
index 2bbfd674849..4801e74d281 100644
--- a/lib/count-leading-zeros.c
+++ b/lib/stdbit.c
@@ -1,6 +1,6 @@
-/* Count the number of leading 0 bits in a word.
+/* Support C23 bit and byte utilities on non-C23 platforms.
- Copyright (C) 2012-2024 Free Software Foundation, Inc.
+ Copyright 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
@@ -15,7 +15,9 @@
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/>. */
+/* Written by Paul Eggert. */
+
#include <config.h>
-#define COUNT_LEADING_ZEROS_INLINE _GL_EXTERN_INLINE
-#include "count-leading-zeros.h"
+#define _GL_STDBIT_INLINE _GL_EXTERN_INLINE
+#include <stdbit.h>
diff --git a/lib/stdbit.in.h b/lib/stdbit.in.h
new file mode 100644
index 00000000000..9f9e60a5d38
--- /dev/null
+++ b/lib/stdbit.in.h
@@ -0,0 +1,1077 @@
+/* stdbit.h - C23 bit and byte utilities for non-C23 platforms
+
+ Copyright 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
+ published by the Free Software Foundation; either version 2.1 of the
+ License, or (at your option) any later version.
+
+ This file is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert. */
+
+#ifndef STDBIT_H
+#define STDBIT_H 1
+
+/* This file uses _GL_INLINE, WORDS_BIGENDIAN. */
+#if !_GL_CONFIG_H_INCLUDED
+ #error "Please include config.h first."
+#endif
+
+_GL_INLINE_HEADER_BEGIN
+
+#ifndef _GL_STDBIT_INLINE
+# define _GL_STDBIT_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_LEADING_ZEROS_INLINE
+# define _GL_STDC_LEADING_ZEROS_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_LEADING_ONES_INLINE
+# define _GL_STDC_LEADING_ONES_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_TRAILING_ZEROS_INLINE
+# define _GL_STDC_TRAILING_ZEROS_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_TRAILING_ONES_INLINE
+# define _GL_STDC_TRAILING_ONES_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_FIRST_LEADING_ZERO_INLINE
+# define _GL_STDC_FIRST_LEADING_ZERO_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_FIRST_LEADING_ONE_INLINE
+# define _GL_STDC_FIRST_LEADING_ONE_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_FIRST_TRAILING_ZERO_INLINE
+# define _GL_STDC_FIRST_TRAILING_ZERO_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_FIRST_TRAILING_ONE_INLINE
+# define _GL_STDC_FIRST_TRAILING_ONE_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_COUNT_ZEROS_INLINE
+# define _GL_STDC_COUNT_ZEROS_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_COUNT_ONES_INLINE
+# define _GL_STDC_COUNT_ONES_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_HAS_SINGLE_BIT_INLINE
+# define _GL_STDC_HAS_SINGLE_BIT_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_BIT_WIDTH_INLINE
+# define _GL_STDC_BIT_WIDTH_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_BIT_FLOOR_INLINE
+# define _GL_STDC_BIT_FLOOR_INLINE _GL_INLINE
+#endif
+#ifndef _GL_STDC_BIT_CEIL_INLINE
+# define _GL_STDC_BIT_CEIL_INLINE _GL_INLINE
+#endif
+
+/* An expression, preferably with the type of A, that has the value of B. */
+#if ((defined __GNUC__ && 2 <= __GNUC__) \
+ || (defined __clang_major__ && 4 <= __clang_major__) \
+ || (defined __IBMC__ && 1210 <= __IBMC__ && defined __IBM__TYPEOF__) \
+ || (defined __SUNPRO_C && 0x5110 <= __SUNPRO_C && !__STDC__))
+# define _GL_STDBIT_TYPEOF_CAST(a, b) ((__typeof__ (a)) (b))
+#elif 202311 <= __STDC_VERSION__
+# define _GL_STDBIT_TYPEOF_CAST(a, b) ((typeof (a)) (b))
+#else
+/* This platform is so old that it lacks typeof, so _Generic is likely
+ missing or unreliable. The C23 standard seems to allow yielding B
+ (which is always unsigned long long int), so do that. */
+# define _GL_STDBIT_TYPEOF_CAST(a, b) (b)
+#endif
+
+
+/* ISO C 23 § 7.18.1 General */
+
+#define __STDC_VERSION_STDBIT_H__ 202311L
+
+
+/* ISO C 23 § 7.18.2 Endian */
+
+#define __STDC_ENDIAN_BIG__ 4321
+#define __STDC_ENDIAN_LITTLE__ 1234
+#ifdef WORDS_BIGENDIAN
+# define __STDC_ENDIAN_NATIVE__ __STDC_ENDIAN_BIG__
+#else
+# define __STDC_ENDIAN_NATIVE__ __STDC_ENDIAN_LITTLE__
+#endif
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#if 3 < __GNUC__ + (4 <= __GNUC_MINOR__) || 4 <= __clang_major__
+# define _GL_STDBIT_HAS_BUILTIN_CLZ true
+# define _GL_STDBIT_HAS_BUILTIN_CTZ true
+# define _GL_STDBIT_HAS_BUILTIN_POPCOUNT true
+#elif defined __has_builtin
+# if (__has_builtin (__builtin_clz) \
+ && __has_builtin (__builtin_clzl) \
+ && __has_builtin (__builtin_clzll))
+# define _GL_STDBIT_HAS_BUILTIN_CLZ true
+# endif
+# if (__has_builtin (__builtin_ctz) \
+ && __has_builtin (__builtin_ctzl) \
+ && __has_builtin (__builtin_ctzll))
+# define _GL_STDBIT_HAS_BUILTIN_CTZ true
+# endif
+# if (__has_builtin (__builtin_popcount) \
+ && __has_builtin (__builtin_popcountl) \
+ && __has_builtin (__builtin_popcountll))
+# define _GL_STDBIT_HAS_BUILTIN_POPCOUNT true
+# endif
+#endif
+
+/* Count leading 0 bits of N, even if N is 0. */
+#ifdef _GL_STDBIT_HAS_BUILTIN_CLZ
+_GL_STDBIT_INLINE int
+__gl_stdbit_clz (unsigned int n)
+{
+ return n ? __builtin_clz (n) : 8 * sizeof n;
+}
+_GL_STDBIT_INLINE int
+__gl_stdbit_clzl (unsigned long int n)
+{
+ return n ? __builtin_clzl (n) : 8 * sizeof n;
+}
+_GL_STDBIT_INLINE int
+__gl_stdbit_clzll (unsigned long long int n)
+{
+ return n ? __builtin_clzll (n) : 8 * sizeof n;
+}
+#elif defined _MSC_VER
+
+/* Declare the few MSVC intrinsics that we need. We prefer not to include
+ <intrin.h> because it would pollute the namespace. */
+extern unsigned char _BitScanReverse (unsigned long *, unsigned long);
+# pragma intrinsic (_BitScanReverse)
+# ifdef _M_X64
+extern unsigned char _BitScanReverse64 (unsigned long *, unsigned long long);
+# pragma intrinsic (_BitScanReverse64)
+# endif
+
+_GL_STDBIT_INLINE int
+__gl_stdbit_clzl (unsigned long int n)
+{
+ unsigned long int r;
+ return 8 * sizeof n - (_BitScanReverse (&r, n) ? r + 1 : 0);
+}
+_GL_STDBIT_INLINE int
+__gl_stdbit_clz (unsigned int n)
+{
+ return __gl_stdbit_clzl (n) - 8 * (sizeof 0ul - sizeof n);
+}
+_GL_STDBIT_INLINE int
+__gl_stdbit_clzll (unsigned long long int n)
+{
+# ifdef _M_X64
+ unsigned long int r;
+ return 8 * sizeof n - (_BitScanReverse64 (&r, n) ? r + 1 : 0);
+# else
+ unsigned long int hi = n >> 32;
+ return __gl_stdbit_clzl (hi ? hi : n) + (hi ? 0 : 32);
+# endif
+}
+
+#else /* !_MSC_VER */
+
+_GL_STDBIT_INLINE int
+__gl_stdbit_clzll (unsigned long long int n)
+{
+ int r = 0;
+ for (int i = 8 * sizeof n >> 1; 1 << 6 <= i; i >>= 1)
+ {
+ int a = (1ull << i <= n) * i; n >>= a; r += a;
+ }
+ int a5 = (0x00000000ffffffff < n) << 5; n >>= a5; r += a5;
+ int a4 = (0x000000000000ffff < n) << 4; n >>= a4; r += a4;
+ int a3 = (0x00000000000000ff < n) << 3; n >>= a3; r += a3;
+ int a2 = (0x000000000000000f < n) << 2; n >>= a2; r += a2;
+ return (8 * sizeof n - (1 << 2) - r) + ((0x11112234ull >> (n << 2)) & 0xf);
+}
+_GL_STDBIT_INLINE int
+__gl_stdbit_clz (unsigned int n)
+{
+ return __gl_stdbit_clzll (n) - 8 * (sizeof 0ull - sizeof 0u);
+}
+_GL_STDBIT_INLINE int
+__gl_stdbit_clzl (unsigned long int n)
+{
+ return __gl_stdbit_clzll (n) - 8 * (sizeof 0ull - sizeof 0ul);
+}
+#endif
+
+/* Count trailing 0 bits of N, even if N is 0. */
+#ifdef _GL_STDBIT_HAS_BUILTIN_CTZ
+_GL_STDBIT_INLINE int
+__gl_stdbit_ctz (unsigned int n)
+{
+ return n ? __builtin_ctz (n) : 8 * sizeof n;
+}
+_GL_STDBIT_INLINE int
+__gl_stdbit_ctzl (unsigned long int n)
+{
+ return n ? __builtin_ctzl (n) : 8 * sizeof n;
+}
+_GL_STDBIT_INLINE int
+__gl_stdbit_ctzll (unsigned long long int n)
+{
+ return n ? __builtin_ctzll (n) : 8 * sizeof n;
+}
+#elif defined _MSC_VER
+
+/* Declare the few MSVC intrinsics that we need. We prefer not to include
+ <intrin.h> because it would pollute the namespace. */
+extern unsigned char _BitScanForward (unsigned long *, unsigned long);
+# pragma intrinsic (_BitScanForward)
+# ifdef _M_X64
+extern unsigned char _BitScanForward64 (unsigned long *, unsigned long long);
+# pragma intrinsic (_BitScanForward64)
+# endif
+
+_GL_STDBIT_INLINE int
+__gl_stdbit_ctzl (unsigned long int n)
+{
+ unsigned long int r;
+ return _BitScanForward (&r, n) ? r : 8 * sizeof n;
+}
+_GL_STDBIT_INLINE int
+__gl_stdbit_ctz (unsigned int n)
+{
+ return __gl_stdbit_ctzl (n | (1ul << (8 * sizeof n - 1) << 1));
+}
+_GL_STDBIT_INLINE int
+__gl_stdbit_ctzll (unsigned long long int n)
+{
+# ifdef _M_X64
+ unsigned long int r;
+ return _BitScanForward64 (&r, n) ? r : 8 * sizeof n;
+# else
+ unsigned int lo = n;
+ return __gl_stdbit_ctzl (lo ? lo : n >> 32) + (lo ? 0 : 32);
+# endif
+}
+
+#else /* !_MSC_VER */
+
+_GL_STDBIT_INLINE int
+__gl_stdbit_ctz (unsigned int n)
+{
+ return 8 * sizeof n - (n ? __gl_stdbit_clz (n & -n) + 1 : 0);
+}
+_GL_STDBIT_INLINE int
+__gl_stdbit_ctzl (unsigned long int n)
+{
+ return 8 * sizeof n - (n ? __gl_stdbit_clzl (n & -n) + 1 : 0);
+}
+_GL_STDBIT_INLINE int
+__gl_stdbit_ctzll (unsigned long long int n)
+{
+ return 8 * sizeof n - (n ? __gl_stdbit_clzll (n & -n) + 1 : 0);
+}
+#endif
+
+#if @GL_STDC_COUNT_ONES@
+/* Count 1 bits in N. */
+# ifdef _GL_STDBIT_HAS_BUILTIN_POPCOUNT
+# define __gl_stdbit_popcount __builtin_popcount
+# define __gl_stdbit_popcountl __builtin_popcountl
+# define __gl_stdbit_popcountll __builtin_popcountll
+# else
+_GL_STDC_COUNT_ONES_INLINE int
+__gl_stdbit_popcount_wide (unsigned long long int n)
+{
+ if (sizeof n & (sizeof n - 1))
+ {
+ /* Use a simple O(log N) loop on theoretical platforms where N's
+ width is not a power of 2. */
+ int count = 0;
+ for (int i = 0; i < 8 * sizeof n; i++, n >>= 1)
+ count += n & 1;
+ return count;
+ }
+ else
+ {
+ /* N's width is a power of 2; count in parallel. */
+ unsigned long long int
+ max = -1ull,
+ x555555 = max / (1 << 1 | 1), /* 0x555555... */
+ x333333 = max / (1 << 2 | 1), /* 0x333333... */
+ x0f0f0f = max / (1 << 4 | 1), /* 0x0f0f0f... */
+ x010101 = max / ((1 << 8) - 1), /* 0x010101... */
+ x000_7f = max / 0xffffffffffffffff * 0x7f; /* 0x000000000000007f... */
+ n -= (n >> 1) & x555555;
+ n = (n & x333333) + ((n >> 2) & x333333);
+ n = (n + (n >> 4)) & x0f0f0f;
+
+ /* If the popcount always fits in 8 bits, multiply so that the
+ popcount is in the leading 8 bits of the product; these days
+ this is typically faster than the alternative below. */
+ if (8 * sizeof n < 1 << 8)
+ return n * x010101 >> 8 * (sizeof n - 1);
+
+ /* N is at least 256 bits wide! Fall back on an O(log log N)
+ loop that a compiler could unroll. Unroll the first three
+ iterations by hand, to skip some division and masking. This
+ is the most we can easily do without hassling with constants
+ that a typical-platform compiler would reject. */
+ n += n >> (1 << 3);
+ n += n >> (1 << 4);
+ n += n >> (1 << 5);
+ n &= x000_7f;
+ for (int i = 64; i < 8 * sizeof n; i <<= 1)
+ n = (n + (n >> i)) & max / (1ull << i | 1);
+ return n;
+ }
+}
+
+# ifdef _MSC_VER
+# if 1500 <= _MSC_VER && (defined _M_IX86 || defined _M_X64)
+/* Declare the few MSVC intrinsics that we need. We prefer not to include
+ <intrin.h> because it would pollute the namespace. */
+extern void __cpuid (int[4], int);
+# pragma intrinsic (__cpuid)
+extern unsigned int __popcnt (unsigned int);
+# pragma intrinsic (__popcnt)
+# ifdef _M_X64
+extern unsigned long long __popcnt64 (unsigned long long);
+# pragma intrinsic (__popcnt64)
+# else
+_GL_STDC_COUNT_ONES_INLINE int
+__popcnt64 (unsigned long long int n)
+{
+ return __popcnt (n >> 32) + __popcnt (n);
+}
+# endif
+# endif
+
+/* 1 if supported, -1 if not, 0 if unknown. */
+extern signed char __gl_stdbit_popcount_support;
+
+_GL_STDC_COUNT_ONES_INLINE bool
+__gl_stdbit_popcount_supported (void)
+{
+ if (!__gl_stdbit_popcount_support)
+ {
+ /* Do as described in
+
<https://docs.microsoft.com/en-us/cpp/intrinsics/popcnt16-popcnt-popcnt64>
+ Although Microsoft started requiring POPCNT in MS-Windows 11 24H2,
+ we'll be more cautious. */
+ int cpu_info[4];
+ __cpuid (cpu_info, 1);
+ __gl_stdbit_popcount_support = cpu_info[2] & 1 << 23 ? 1 : -1;
+ }
+ return 0 < __gl_stdbit_popcount_support;
+}
+_GL_STDC_COUNT_ONES_INLINE int
+__gl_stdbit_popcount (unsigned int n)
+{
+ return (__gl_stdbit_popcount_supported ()
+ ? __popcnt (n)
+ : __gl_stdbit_popcount_wide (n));
+}
+_GL_STDC_COUNT_ONES_INLINE int
+__gl_stdbit_popcountl (unsigned long int n)
+{
+ return (__gl_stdbit_popcount_supported ()
+ ? __popcnt (n)
+ : __gl_stdbit_popcount_wide (n));
+}
+_GL_STDC_COUNT_ONES_INLINE int
+__gl_stdbit_popcountll (unsigned long long int n)
+{
+ return (__gl_stdbit_popcount_supported ()
+ ? __popcnt64 (n)
+ : __gl_stdbit_popcount_wide (n));
+}
+# else /* !_MSC_VER */
+# define __gl_stdbit_popcount __gl_stdbit_popcount_wide
+# define __gl_stdbit_popcountl __gl_stdbit_popcount_wide
+# define __gl_stdbit_popcountll __gl_stdbit_popcount_wide
+# endif
+# endif
+#endif
+
+
+/* ISO C 23 § 7.18.3 Count Leading Zeros */
+
+#if @GL_STDC_LEADING_ZEROS@
+
+_GL_STDC_LEADING_ZEROS_INLINE unsigned int
+stdc_leading_zeros_ui (unsigned int n)
+{
+ return __gl_stdbit_clz (n);
+}
+
+_GL_STDC_LEADING_ZEROS_INLINE unsigned int
+stdc_leading_zeros_uc (unsigned char n)
+{
+ return stdc_leading_zeros_ui (n) - 8 * (sizeof 0u - sizeof n);
+}
+
+_GL_STDC_LEADING_ZEROS_INLINE unsigned int
+stdc_leading_zeros_us (unsigned short int n)
+{
+ return stdc_leading_zeros_ui (n) - 8 * (sizeof 0u - sizeof n);
+}
+
+_GL_STDC_LEADING_ZEROS_INLINE unsigned int
+stdc_leading_zeros_ul (unsigned long int n)
+{
+ return __gl_stdbit_clzl (n);
+}
+
+_GL_STDC_LEADING_ZEROS_INLINE unsigned int
+stdc_leading_zeros_ull (unsigned long long int n)
+{
+ return __gl_stdbit_clzll (n);
+}
+
+# define stdc_leading_zeros(n) \
+ (sizeof (n) == 1 ? stdc_leading_zeros_uc (n) \
+ : sizeof (n) == sizeof (unsigned short int) ? stdc_leading_zeros_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_leading_zeros_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_leading_zeros_ul (n) \
+ : stdc_leading_zeros_ull (n))
+
+#endif
+
+
+/* ISO C 23 § 7.18.4 Count Leading Ones */
+
+#if @GL_STDC_LEADING_ONES@
+
+_GL_STDC_LEADING_ONES_INLINE unsigned int
+stdc_leading_ones_uc (unsigned char n)
+{
+ return stdc_leading_zeros_uc (~n);
+}
+
+_GL_STDC_LEADING_ONES_INLINE unsigned int
+stdc_leading_ones_us (unsigned short int n)
+{
+ return stdc_leading_zeros_us (~n);
+}
+
+_GL_STDC_LEADING_ONES_INLINE unsigned int
+stdc_leading_ones_ui (unsigned int n)
+{
+ return stdc_leading_zeros_ui (~n);
+}
+
+_GL_STDC_LEADING_ONES_INLINE unsigned int
+stdc_leading_ones_ul (unsigned long int n)
+{
+ return stdc_leading_zeros_ul (~n);
+}
+
+_GL_STDC_LEADING_ONES_INLINE unsigned int
+stdc_leading_ones_ull (unsigned long long int n)
+{
+ return stdc_leading_zeros_ull (~n);
+}
+
+# define stdc_leading_ones(n) \
+ (sizeof (n) == 1 ? stdc_leading_ones_uc (n) \
+ : sizeof (n) == sizeof (unsigned short int) ? stdc_leading_ones_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_leading_ones_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_leading_ones_ul (n) \
+ : stdc_leading_ones_ull (n))
+
+#endif
+
+
+/* ISO C 23 § 7.18.5 Count Trailing Zeros */
+
+#if @GL_STDC_TRAILING_ZEROS@
+
+_GL_STDC_TRAILING_ZEROS_INLINE unsigned int
+stdc_trailing_zeros_ui (unsigned int n)
+{
+ return __gl_stdbit_ctz (n);
+}
+
+_GL_STDC_TRAILING_ZEROS_INLINE unsigned int
+stdc_trailing_zeros_uc (unsigned char n)
+{
+ return stdc_trailing_zeros_ui (n | (1 + (unsigned char) -1));
+}
+
+_GL_STDC_TRAILING_ZEROS_INLINE unsigned int
+stdc_trailing_zeros_us (unsigned short int n)
+{
+ return stdc_trailing_zeros_ui (n | (1 + (unsigned short int) -1));
+}
+
+_GL_STDC_TRAILING_ZEROS_INLINE unsigned int
+stdc_trailing_zeros_ul (unsigned long int n)
+{
+ return __gl_stdbit_ctzl (n);
+}
+
+_GL_STDC_TRAILING_ZEROS_INLINE unsigned int
+stdc_trailing_zeros_ull (unsigned long long int n)
+{
+ return __gl_stdbit_ctzll (n);
+}
+
+# define stdc_trailing_zeros(n) \
+ (sizeof (n) == 1 ? stdc_trailing_zeros_uc (n) \
+ : sizeof (n) == sizeof (unsigned short int) ? stdc_trailing_zeros_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_trailing_zeros_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_trailing_zeros_ul (n) \
+ : stdc_trailing_zeros_ull (n))
+
+#endif
+
+
+/* ISO C 23 § 7.18.6 Count Trailing Ones */
+
+#if @GL_STDC_TRAILING_ONES@
+
+_GL_STDC_TRAILING_ONES_INLINE unsigned int
+stdc_trailing_ones_uc (unsigned char n)
+{
+ return stdc_trailing_zeros_uc (~n);
+}
+
+_GL_STDC_TRAILING_ONES_INLINE unsigned int
+stdc_trailing_ones_us (unsigned short int n)
+{
+ return stdc_trailing_zeros_us (~n);
+}
+
+_GL_STDC_TRAILING_ONES_INLINE unsigned int
+stdc_trailing_ones_ui (unsigned int n)
+{
+ return stdc_trailing_zeros_ui (~n);
+}
+
+_GL_STDC_TRAILING_ONES_INLINE unsigned int
+stdc_trailing_ones_ul (unsigned long int n)
+{
+ return stdc_trailing_zeros_ul (~n);
+}
+
+_GL_STDC_TRAILING_ONES_INLINE unsigned int
+stdc_trailing_ones_ull (unsigned long long int n)
+{
+ return stdc_trailing_zeros_ull (~n);
+}
+
+# define stdc_trailing_ones(n) \
+ (sizeof (n) == 1 ? stdc_trailing_ones_uc (n) \
+ : sizeof (n) == sizeof (unsigned short int) ? stdc_trailing_ones_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_trailing_ones_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_trailing_ones_ul (n) \
+ : stdc_trailing_ones_ull (n))
+
+#endif
+
+
+/* ISO C 23 § 7.18.7 First Leading Zero */
+
+#if @GL_STDC_FIRST_LEADING_ZERO@
+
+_GL_STDC_FIRST_LEADING_ZERO_INLINE unsigned int
+stdc_first_leading_zero_uc (unsigned char n)
+{
+ unsigned int count = stdc_leading_ones_uc (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_LEADING_ZERO_INLINE unsigned int
+stdc_first_leading_zero_us (unsigned short int n)
+{
+ unsigned int count = stdc_leading_ones_us (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_LEADING_ZERO_INLINE unsigned int
+stdc_first_leading_zero_ui (unsigned int n)
+{
+ unsigned int count = stdc_leading_ones_ui (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_LEADING_ZERO_INLINE unsigned int
+stdc_first_leading_zero_ul (unsigned long int n)
+{
+ unsigned int count = stdc_leading_ones_ul (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_LEADING_ZERO_INLINE unsigned int
+stdc_first_leading_zero_ull (unsigned long long int n)
+{
+ unsigned int count = stdc_leading_ones_ull (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+# define stdc_first_leading_zero(n) \
+ (sizeof (n) == 1 ? stdc_first_leading_zero_uc (n) \
+ : sizeof (n) == sizeof (unsigned short) ? stdc_first_leading_zero_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_first_leading_zero_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_first_leading_zero_ul (n) \
+ : stdc_first_leading_zero_ull (n))
+
+#endif
+
+
+/* ISO C 23 § 7.18.8 First Leading One */
+
+#if @GL_STDC_FIRST_LEADING_ONE@
+
+_GL_STDC_FIRST_LEADING_ONE_INLINE unsigned int
+stdc_first_leading_one_uc (unsigned char n)
+{
+ unsigned int count = stdc_leading_zeros_uc (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_LEADING_ONE_INLINE unsigned int
+stdc_first_leading_one_us (unsigned short int n)
+{
+ unsigned int count = stdc_leading_zeros_us (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_LEADING_ONE_INLINE unsigned int
+stdc_first_leading_one_ui (unsigned int n)
+{
+ unsigned int count = stdc_leading_zeros_ui (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_LEADING_ONE_INLINE unsigned int
+stdc_first_leading_one_ul (unsigned long int n)
+{
+ unsigned int count = stdc_leading_zeros_ul (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_LEADING_ONE_INLINE unsigned int
+stdc_first_leading_one_ull (unsigned long long int n)
+{
+ unsigned int count = stdc_leading_zeros_ull (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+# define stdc_first_leading_one(n) \
+ (sizeof (n) == 1 ? stdc_first_leading_one_uc (n) \
+ : sizeof (n) == sizeof (unsigned short) ? stdc_first_leading_one_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_first_leading_one_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_first_leading_one_ul (n) \
+ : stdc_first_leading_one_ull (n))
+
+#endif
+
+
+/* ISO C 23 § 7.18.9 First Trailing Zero */
+
+#if @GL_STDC_FIRST_TRAILING_ZERO@
+
+_GL_STDC_FIRST_TRAILING_ZERO_INLINE unsigned int
+stdc_first_trailing_zero_uc (unsigned char n)
+{
+ unsigned int count = stdc_trailing_ones_uc (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_TRAILING_ZERO_INLINE unsigned int
+stdc_first_trailing_zero_us (unsigned short int n)
+{
+ unsigned int count = stdc_trailing_ones_us (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_TRAILING_ZERO_INLINE unsigned int
+stdc_first_trailing_zero_ui (unsigned int n)
+{
+ unsigned int count = stdc_trailing_ones_ui (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_TRAILING_ZERO_INLINE unsigned int
+stdc_first_trailing_zero_ul (unsigned long int n)
+{
+ unsigned int count = stdc_trailing_ones_ul (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_TRAILING_ZERO_INLINE unsigned int
+stdc_first_trailing_zero_ull (unsigned long long int n)
+{
+ unsigned int count = stdc_trailing_ones_ull (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+# define stdc_first_trailing_zero(n) \
+ (sizeof (n) == 1 ? stdc_first_trailing_zero_uc (n) \
+ : sizeof (n) == sizeof (unsigned short) ? stdc_first_trailing_zero_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_first_trailing_zero_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_first_trailing_zero_ul (n) \
+ : stdc_first_trailing_zero_ull (n))
+
+#endif
+
+
+/* ISO C 23 § 7.18.10 First Trailing One */
+
+#if @GL_STDC_FIRST_TRAILING_ONE@
+
+_GL_STDC_FIRST_TRAILING_ONE_INLINE unsigned int
+stdc_first_trailing_one_uc (unsigned char n)
+{
+ unsigned int count = stdc_trailing_zeros_uc (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_TRAILING_ONE_INLINE unsigned int
+stdc_first_trailing_one_us (unsigned short int n)
+{
+ unsigned int count = stdc_trailing_zeros_us (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_TRAILING_ONE_INLINE unsigned int
+stdc_first_trailing_one_ui (unsigned int n)
+{
+ unsigned int count = stdc_trailing_zeros_ui (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_TRAILING_ONE_INLINE unsigned int
+stdc_first_trailing_one_ul (unsigned long int n)
+{
+ unsigned int count = stdc_trailing_zeros_ul (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+_GL_STDC_FIRST_TRAILING_ONE_INLINE unsigned int
+stdc_first_trailing_one_ull (unsigned long long int n)
+{
+ unsigned int count = stdc_trailing_zeros_ull (n);
+ unsigned int bits = 8 * sizeof n;
+ return count % bits + (count < bits);
+}
+
+#define stdc_first_trailing_one(n) \
+ (sizeof (n) == 1 ? stdc_first_trailing_one_uc (n) \
+ : sizeof (n) == sizeof (unsigned short) ? stdc_first_trailing_one_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_first_trailing_one_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_first_trailing_one_ul (n) \
+ : stdc_first_trailing_one_ull (n))
+
+#endif
+
+
+/* ISO C 23 § 7.18.12 Count Ones */
+
+#if @GL_STDC_COUNT_ONES@
+
+_GL_STDC_COUNT_ONES_INLINE unsigned int
+stdc_count_ones_ui (unsigned int n)
+{
+ return __gl_stdbit_popcount (n);
+}
+
+_GL_STDC_COUNT_ONES_INLINE unsigned int
+stdc_count_ones_uc (unsigned char n)
+{
+ return stdc_count_ones_ui (n);
+}
+
+_GL_STDC_COUNT_ONES_INLINE unsigned int
+stdc_count_ones_us (unsigned short int n)
+{
+ return stdc_count_ones_ui (n);
+}
+
+_GL_STDC_COUNT_ONES_INLINE unsigned int
+stdc_count_ones_ul (unsigned long int n)
+{
+ return __gl_stdbit_popcountl (n);
+}
+
+_GL_STDC_COUNT_ONES_INLINE unsigned int
+stdc_count_ones_ull (unsigned long long int n)
+{
+ return __gl_stdbit_popcountll (n);
+}
+
+# define stdc_count_ones(n) \
+ (sizeof (n) == 1 ? stdc_count_ones_uc (n) \
+ : sizeof (n) == sizeof (unsigned short int) ? stdc_count_ones_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_count_ones_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_count_ones_ul (n) \
+ : stdc_count_ones_ull (n))
+
+#endif
+
+
+/* ISO C 23 § 7.18.11 Count Zeros */
+
+#if @GL_STDC_COUNT_ZEROS@
+
+_GL_STDC_COUNT_ZEROS_INLINE unsigned int
+stdc_count_zeros_uc (unsigned char n)
+{
+ return stdc_count_ones_uc (~n);
+}
+
+_GL_STDC_COUNT_ZEROS_INLINE unsigned int
+stdc_count_zeros_us (unsigned short int n)
+{
+ return stdc_count_ones_us (~n);
+}
+
+_GL_STDC_COUNT_ZEROS_INLINE unsigned int
+stdc_count_zeros_ui (unsigned int n)
+{
+ return stdc_count_ones_ui (~n);
+}
+
+_GL_STDC_COUNT_ZEROS_INLINE unsigned int
+stdc_count_zeros_ul (unsigned long int n)
+{
+ return stdc_count_ones_ul (~n);
+}
+
+_GL_STDC_COUNT_ZEROS_INLINE unsigned int
+stdc_count_zeros_ull (unsigned long long int n)
+{
+ return stdc_count_ones_ull (~n);
+}
+
+# define stdc_count_zeros(n) \
+ (sizeof (n) == 1 ? stdc_count_zeros_uc (n) \
+ : sizeof (n) == sizeof (unsigned short int) ? stdc_count_zeros_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_count_zeros_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_count_zeros_ul (n) \
+ : stdc_count_zeros_ull (n))
+
+#endif
+
+
+/* ISO C 23 § 7.18.13 Single-bit Check */
+
+#if @GL_STDC_HAS_SINGLE_BIT@
+
+_GL_STDC_HAS_SINGLE_BIT_INLINE bool
+stdc_has_single_bit_uc (unsigned char n)
+{
+ unsigned char n_1 = n - 1, nx = n_1 ^ n;
+ return n_1 < nx;
+}
+
+_GL_STDC_HAS_SINGLE_BIT_INLINE bool
+stdc_has_single_bit_us (unsigned short int n)
+{
+ unsigned short int n_1 = n - 1, nx = n_1 ^ n;
+ return n_1 < nx;
+}
+
+_GL_STDC_HAS_SINGLE_BIT_INLINE bool
+stdc_has_single_bit_ui (unsigned int n)
+{
+ unsigned int n_1 = n - 1, nx = n_1 ^ n;
+ return n_1 < nx;
+}
+
+_GL_STDC_HAS_SINGLE_BIT_INLINE bool
+stdc_has_single_bit_ul (unsigned long int n)
+{
+ unsigned long int n_1 = n - 1, nx = n_1 ^ n;
+ return n_1 < nx;
+}
+
+_GL_STDC_HAS_SINGLE_BIT_INLINE bool
+stdc_has_single_bit_ull (unsigned long long int n)
+{
+ unsigned long long int n_1 = n - 1, nx = n_1 ^ n;
+ return n_1 < nx;
+}
+
+# define stdc_has_single_bit(n) \
+ ((bool) \
+ (sizeof (n) == 1 ? stdc_has_single_bit_uc (n) \
+ : sizeof (n) == sizeof (unsigned short int) ? stdc_has_single_bit_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_has_single_bit_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_has_single_bit_ul (n) \
+ : stdc_has_single_bit_ull (n)))
+
+#endif
+
+
+/* ISO C 23 § 7.18.14 Bit Width */
+
+#if @GL_STDC_BIT_WIDTH@
+
+_GL_STDC_BIT_WIDTH_INLINE unsigned int
+stdc_bit_width_uc (unsigned char n)
+{
+ return 8 * sizeof n - stdc_leading_zeros_uc (n);
+}
+
+_GL_STDC_BIT_WIDTH_INLINE unsigned int
+stdc_bit_width_us (unsigned short int n)
+{
+ return 8 * sizeof n - stdc_leading_zeros_us (n);
+}
+
+_GL_STDC_BIT_WIDTH_INLINE unsigned int
+stdc_bit_width_ui (unsigned int n)
+{
+ return 8 * sizeof n - stdc_leading_zeros_ui (n);
+}
+
+_GL_STDC_BIT_WIDTH_INLINE unsigned int
+stdc_bit_width_ul (unsigned long int n)
+{
+ return 8 * sizeof n - stdc_leading_zeros_ul (n);
+}
+
+_GL_STDC_BIT_WIDTH_INLINE unsigned int
+stdc_bit_width_ull (unsigned long long int n)
+{
+ return 8 * sizeof n - stdc_leading_zeros_ull (n);
+}
+
+# define stdc_bit_width(n) \
+ (sizeof (n) == 1 ? stdc_bit_width_uc (n) \
+ : sizeof (n) == sizeof (unsigned short int) ? stdc_bit_width_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_bit_width_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_bit_width_ul (n) \
+ : stdc_bit_width_ull (n))
+
+#endif
+
+
+/* ISO C 23 § 7.18.15 Bit Floor */
+
+#if @GL_STDC_BIT_FLOOR@
+
+_GL_STDC_BIT_FLOOR_INLINE unsigned char
+stdc_bit_floor_uc (unsigned char n)
+{
+ return n ? 1u << (stdc_bit_width_uc (n) - 1) : 0;
+}
+
+_GL_STDC_BIT_FLOOR_INLINE unsigned short int
+stdc_bit_floor_us (unsigned short int n)
+{
+ return n ? 1u << (stdc_bit_width_us (n) - 1) : 0;
+}
+
+_GL_STDC_BIT_FLOOR_INLINE unsigned int
+stdc_bit_floor_ui (unsigned int n)
+{
+ return n ? 1u << (stdc_bit_width_ui (n) - 1) : 0;
+}
+
+_GL_STDC_BIT_FLOOR_INLINE unsigned long int
+stdc_bit_floor_ul (unsigned long int n)
+{
+ return n ? 1ul << (stdc_bit_width_ul (n) - 1) : 0;
+}
+
+_GL_STDC_BIT_FLOOR_INLINE unsigned long long int
+stdc_bit_floor_ull (unsigned long long int n)
+{
+ return n ? 1ull << (stdc_bit_width_ull (n) - 1) : 0;
+}
+
+# define stdc_bit_floor(n) \
+ (_GL_STDBIT_TYPEOF_CAST \
+ (n, \
+ (sizeof (n) == 1 ? stdc_bit_floor_uc (n) \
+ : sizeof (n) == sizeof (unsigned short int) ? stdc_bit_floor_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_bit_floor_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_bit_floor_ul (n) \
+ : stdc_bit_floor_ull (n))))
+
+#endif
+
+
+/* ISO C 23 § 7.18.16 Bit Ceiling */
+
+#if @GL_STDC_BIT_CEIL@
+
+_GL_STDC_BIT_CEIL_INLINE unsigned char
+stdc_bit_ceil_uc (unsigned char n)
+{
+ return n <= 1 ? 1 : 2u << (stdc_bit_width_uc (n - 1) - 1);
+}
+
+_GL_STDC_BIT_CEIL_INLINE unsigned short int
+stdc_bit_ceil_us (unsigned short int n)
+{
+ return n <= 1 ? 1 : 2u << (stdc_bit_width_us (n - 1) - 1);
+}
+
+_GL_STDC_BIT_CEIL_INLINE unsigned int
+stdc_bit_ceil_ui (unsigned int n)
+{
+ return n <= 1 ? 1 : 2u << (stdc_bit_width_ui (n - 1) - 1);
+}
+
+_GL_STDC_BIT_CEIL_INLINE unsigned long int
+stdc_bit_ceil_ul (unsigned long int n)
+{
+ return n <= 1 ? 1 : 2ul << (stdc_bit_width_ul (n - 1) - 1);
+}
+
+_GL_STDC_BIT_CEIL_INLINE unsigned long long int
+stdc_bit_ceil_ull (unsigned long long int n)
+{
+ return n <= 1 ? 1 : 2ull << (stdc_bit_width_ull (n - 1) - 1);
+}
+
+# define stdc_bit_ceil(n) \
+ (_GL_STDBIT_TYPEOF_CAST \
+ (n, \
+ (sizeof (n) == 1 ? stdc_bit_ceil_uc (n) \
+ : sizeof (n) == sizeof (unsigned short int) ? stdc_bit_ceil_us (n) \
+ : sizeof (n) == sizeof 0u ? stdc_bit_ceil_ui (n) \
+ : sizeof (n) == sizeof 0ul ? stdc_bit_ceil_ul (n) \
+ : stdc_bit_ceil_ull (n))))
+
+#endif
+
+
+#ifdef __cplusplus
+}
+#endif
+
+_GL_INLINE_HEADER_END
+
+#endif /* STDBIT_H */
diff --git a/lib/count-leading-zeros.c b/lib/stdc_bit_width.c
similarity index 77%
rename from lib/count-leading-zeros.c
rename to lib/stdc_bit_width.c
index 2bbfd674849..a0dc8de3b5f 100644
--- a/lib/count-leading-zeros.c
+++ b/lib/stdc_bit_width.c
@@ -1,6 +1,5 @@
-/* Count the number of leading 0 bits in a word.
-
- Copyright (C) 2012-2024 Free Software Foundation, Inc.
+/* stdc_bit_width_* functions.
+ 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
@@ -17,5 +16,5 @@
#include <config.h>
-#define COUNT_LEADING_ZEROS_INLINE _GL_EXTERN_INLINE
-#include "count-leading-zeros.h"
+#define _GL_STDC_BIT_WIDTH_INLINE _GL_EXTERN_INLINE
+#include <stdbit.h>
diff --git a/lib/count-one-bits.c b/lib/stdc_count_ones.c
similarity index 78%
rename from lib/count-one-bits.c
rename to lib/stdc_count_ones.c
index 54b87088028..7421178adf0 100644
--- a/lib/count-one-bits.c
+++ b/lib/stdc_count_ones.c
@@ -1,6 +1,5 @@
-/* Count the number of 1-bits in a word.
-
- Copyright (C) 2012-2024 Free Software Foundation, Inc.
+/* stdc_count_ones_* functions.
+ 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
@@ -17,9 +16,9 @@
#include <config.h>
-#define COUNT_ONE_BITS_INLINE _GL_EXTERN_INLINE
-#include "count-one-bits.h"
+#define _GL_STDC_COUNT_ONES_INLINE _GL_EXTERN_INLINE
+#include <stdbit.h>
#if 1500 <= _MSC_VER && (defined _M_IX86 || defined _M_X64)
-int popcount_support = -1;
+signed char __gl_stdbit_popcount_support;
#endif
diff --git a/lib/count-trailing-zeros.c b/lib/stdc_leading_zeros.c
similarity index 78%
copy from lib/count-trailing-zeros.c
copy to lib/stdc_leading_zeros.c
index e13f77788da..45695e51aa8 100644
--- a/lib/count-trailing-zeros.c
+++ b/lib/stdc_leading_zeros.c
@@ -1,6 +1,5 @@
-/* Count the number of trailing 0 bits in a word.
-
- Copyright 2013-2024 Free Software Foundation, Inc.
+/* stdc_leading_zeros_* functions.
+ 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
@@ -17,5 +16,5 @@
#include <config.h>
-#define COUNT_TRAILING_ZEROS_INLINE _GL_EXTERN_INLINE
-#include "count-trailing-zeros.h"
+#define _GL_STDC_LEADING_ZEROS_INLINE _GL_EXTERN_INLINE
+#include <stdbit.h>
diff --git a/lib/count-trailing-zeros.c b/lib/stdc_trailing_zeros.c
similarity index 78%
rename from lib/count-trailing-zeros.c
rename to lib/stdc_trailing_zeros.c
index e13f77788da..f4bc43ac6ba 100644
--- a/lib/count-trailing-zeros.c
+++ b/lib/stdc_trailing_zeros.c
@@ -1,6 +1,5 @@
-/* Count the number of trailing 0 bits in a word.
-
- Copyright 2013-2024 Free Software Foundation, Inc.
+/* stdc_trailing_zeros_* functions.
+ 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
@@ -17,5 +16,5 @@
#include <config.h>
-#define COUNT_TRAILING_ZEROS_INLINE _GL_EXTERN_INLINE
-#include "count-trailing-zeros.h"
+#define _GL_STDC_TRAILING_ZEROS_INLINE _GL_EXTERN_INLINE
+#include <stdbit.h>
diff --git a/lib/stddef.in.h b/lib/stddef.in.h
index fa8998d9b72..63bb500e262 100644
--- a/lib/stddef.in.h
+++ b/lib/stddef.in.h
@@ -27,13 +27,21 @@
#endif
@PRAGMA_COLUMNS@
-#if defined __need_wchar_t || defined __need_size_t \
- || defined __need_ptrdiff_t || defined __need_NULL \
- || defined __need_wint_t
+#if (defined __need_wchar_t || defined __need_size_t \
+ || defined __need_ptrdiff_t || defined __need_NULL \
+ || defined __need_wint_t) \
+ /* Avoid warning triggered by "gcc -std=gnu23 -Wsystem-headers" \
+ in Fedora 40 with gcc 14.0.1. \
+ <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114870>. */ \
+ && !@STDDEF_NOT_IDEMPOTENT@
/* Special invocation convention inside gcc header files. In
- particular, gcc provides a version of <stddef.h> that blindly
- redefines NULL even when __need_wint_t was defined, even though
- wint_t is not normally provided by <stddef.h>. Hence, we must
+ particular, <stddef.h> in some ancient versions of GCC blindly
+ redefined NULL when __need_wint_t was defined, even though wint_t
+ is not normally provided by <stddef.h>.
+ (FIXME: It's not clear what GCC versions those were - perhaps so
+ ancient that we can stop worrying about this?)
+ Although glibc 2.26 (2017) and later do not use __need_wint_t,
+ for portability to macOS, Cygwin, Haiku, and older Glibc + GCC,
remember if special invocation has ever been used to obtain wint_t,
in which case we need to clean up NULL yet again. */
@@ -52,6 +60,13 @@
# endif
#else
+/* For @STDDEF_NOT_IDEMPOTENT@. */
+# undef __need_wchar_t
+# undef __need_size_t
+# undef __need_ptrdiff_t
+# undef __need_NULL
+# undef __need_wint_t
+
/* Normal invocation convention. */
# ifndef _@GUARD_PREFIX@_STDDEF_H
@@ -74,6 +89,12 @@ typedef long max_align_t;
# endif
# endif
+# if !defined _GCC_NULLPTR_T && !@NULLPTR_T_NEEDS_STDDEF@
+ /* Suppress unwanted nullptr_t typedef. See
+ <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114869>. */
+# define _GCC_NULLPTR_T
+# endif
+
/* The include_next requires a split double-inclusion guard. */
# @INCLUDE_NEXT@ @NEXT_STDDEF_H@
diff --git a/lib/stdio.in.h b/lib/stdio.in.h
index 4947307e578..1c0c9661bfe 100644
--- a/lib/stdio.in.h
+++ b/lib/stdio.in.h
@@ -77,7 +77,8 @@
/* Get off_t and ssize_t. Needed on many systems, including glibc 2.8
and eglibc 2.11.2.
- May also define off_t to a 64-bit type on native Windows. */
+ May also define off_t to a 64-bit type on native Windows.
+ Also defines off64_t on macOS, NetBSD, OpenBSD, MSVC, Cygwin, Haiku. */
#include <sys/types.h>
/* Solaris 10 and NetBSD 7.0 declare renameat in <unistd.h>, not in <stdio.h>.
*/
@@ -907,14 +908,14 @@ _GL_CXXALIAS_SYS (fwrite, size_t,
&& !defined __cplusplus)
# undef fwrite
# undef fwrite_unlocked
-extern size_t __REDIRECT (rpl_fwrite,
- (const void *__restrict, size_t, size_t,
- FILE *__restrict),
- fwrite);
-extern size_t __REDIRECT (rpl_fwrite_unlocked,
- (const void *__restrict, size_t, size_t,
- FILE *__restrict),
- fwrite_unlocked);
+_GL_EXTERN_C size_t __REDIRECT (rpl_fwrite,
+ (const void *__restrict, size_t, size_t,
+ FILE *__restrict),
+ fwrite);
+_GL_EXTERN_C size_t __REDIRECT (rpl_fwrite_unlocked,
+ (const void *__restrict, size_t, size_t,
+ FILE *__restrict),
+ fwrite_unlocked);
# define fwrite rpl_fwrite
# define fwrite_unlocked rpl_fwrite_unlocked
# endif
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
index b901d175aeb..ef9fde30eb2 100644
--- a/lib/stdlib.in.h
+++ b/lib/stdlib.in.h
@@ -216,6 +216,31 @@ _GL_WARN_ON_USE (_Exit, "_Exit is unportable - "
#endif
+#if @GNULIB_ABORT_DEBUG@
+# if @REPLACE_ABORT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef abort
+# define abort rpl_abort
+# endif
+_GL_FUNCDECL_RPL (abort, _Noreturn void, (void));
+_GL_CXXALIAS_RPL (abort, void, (void));
+# else
+_GL_CXXALIAS_SYS (abort, void, (void));
+# endif
+# if __GLIBC__ >= 2
+_GL_CXXALIASWARN (abort);
+# endif
+#endif
+#if @GNULIB_ABORT_DEBUG@ && @REPLACE_ABORT@
+_GL_EXTERN_C void _gl_pre_abort (void);
+#else
+# if !GNULIB_defined_gl_pre_abort
+# define _gl_pre_abort() /* nothing */
+# define GNULIB_defined_gl_pre_abort 1
+# endif
+#endif
+
+
#if @GNULIB_FREE_POSIX@
# if @REPLACE_FREE@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
@@ -1591,6 +1616,38 @@ _GL_WARN_ON_USE (strtod, "strtod is unportable - "
# endif
#endif
+#if @GNULIB_STRTOF@
+ /* Parse a float from STRING, updating ENDP if appropriate. */
+# if @REPLACE_STRTOF@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# define strtof rpl_strtof
+# endif
+# define GNULIB_defined_strtof_function 1
+_GL_FUNCDECL_RPL (strtof, float,
+ (const char *restrict str, char **restrict endp)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (strtof, float,
+ (const char *restrict str, char **restrict endp));
+# else
+# if !@HAVE_STRTOF@
+_GL_FUNCDECL_SYS (strtof, float,
+ (const char *restrict str, char **restrict endp)
+ _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (strtof, float,
+ (const char *restrict str, char **restrict endp));
+# endif
+# if __GLIBC__ >= 2
+_GL_CXXALIASWARN (strtof);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strtof
+# if HAVE_RAW_DECL_STRTOF
+_GL_WARN_ON_USE (strtof, "strtof is unportable - "
+ "use gnulib module strtof for portability");
+# endif
+#endif
+
#if @GNULIB_STRTOLD@
/* Parse a 'long double' from STRING, updating ENDP if appropriate. */
# if @REPLACE_STRTOLD@
diff --git a/lib/strftime.c b/lib/strftime.c
index 128176cad40..834f3a79f46 100644
--- a/lib/strftime.c
+++ b/lib/strftime.c
@@ -141,6 +141,15 @@ extern char *tzname[];
? (a) >> (b) \
: ((a) + ((a) < 0)) / (1 << (b)) - ((a) < 0))
+enum pad_style
+{
+ ZERO_PAD, /* (default) Pad with 0 unless format says otherwise. */
+ ALWAYS_ZERO_PAD, /* '0' Always pad with 0. */
+ SIGN_PAD, /* '+' Always output a sign. */
+ SPACE_PAD, /* '_' Pad with space. */
+ NO_PAD /* '-' Do not pad. */
+};
+
#define TM_YEAR_BASE 1900
#ifndef __isleap
@@ -193,7 +202,7 @@ extern char *tzname[];
do \
{ \
size_t _n = (n); \
- size_t _w = pad == L_('-') || width < 0 ? 0 : width; \
+ size_t _w = pad == NO_PAD || width < 0 ? 0 : width; \
size_t _incr = _n < _w ? _w : _n; \
if (_incr >= maxsize - i) \
{ \
@@ -205,7 +214,7 @@ extern char *tzname[];
if (_n < _w) \
{ \
size_t _delta = _w - _n; \
- if (pad == L_('0') || pad == L_('+')) \
+ if (pad == ALWAYS_ZERO_PAD || pad == SIGN_PAD) \
memset_zero (p, _delta); \
else \
memset_space (p, _delta); \
@@ -825,7 +834,7 @@ static CHAR_T const c_month_names[][sizeof "September"] =
static size_t __strftime_internal (STREAM_OR_CHAR_T *, STRFTIME_ARG (size_t)
const CHAR_T *, const struct tm *,
- bool, int, int, bool *
+ bool, enum pad_style, int, bool *
extra_args_spec LOCALE_PARAM);
/* Write information from TP into S according to the format
@@ -841,7 +850,8 @@ my_strftime (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t
maxsize)
{
bool tzset_called = false;
return __strftime_internal (s, STRFTIME_ARG (maxsize) format, tp, false,
- 0, -1, &tzset_called extra_args LOCALE_ARG);
+ ZERO_PAD, -1,
+ &tzset_called extra_args LOCALE_ARG);
}
libc_hidden_def (my_strftime)
@@ -853,7 +863,7 @@ 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
+ enum pad_style yr_spec, int width, bool *tzset_called
extra_args_spec LOCALE_PARAM)
{
#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL
@@ -977,7 +987,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
for (f = format; *f != '\0'; width = -1, f++)
{
- int pad = 0; /* Padding for number ('_', '-', '+', '0', or 0). */
+ enum pad_style pad = ZERO_PAD;
int modifier; /* Field modifier ('E', 'O', or 0). */
int digits = 0; /* Max digits for numeric format. */
int number_value; /* Numeric value to be printed. */
@@ -1095,12 +1105,10 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
switch (*++f)
{
/* This influences the number formats. */
- case L_('_'):
- case L_('-'):
- case L_('+'):
- case L_('0'):
- pad = *f;
- continue;
+ case L_('_'): pad = SPACE_PAD; continue;
+ case L_('-'): pad = NO_PAD; continue;
+ case L_('+'): pad = SIGN_PAD; continue;
+ case L_('0'): pad = ALWAYS_ZERO_PAD; continue;
/* This changes textual output. */
case L_('^'):
@@ -1336,7 +1344,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
# endif
if (len != 0)
{
-# if defined __NetBSD__ || defined __sun /* NetBSD, Solaris */
+# if (__GLIBC__ == 2 && __GLIBC_MINOR__ < 31) || defined __NetBSD__ || defined
__sun /* glibc < 2.31, NetBSD, Solaris */
if (format_char == L_('c'))
{
/* The output of the strftime %c directive consists of the
@@ -1374,7 +1382,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
}
}
}
-# if REQUIRE_GNUISH_STRFTIME_AM_PM
+# if (defined __NetBSD__ || defined __sun) && 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. */
@@ -1483,17 +1491,17 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
goto do_number_body;
do_yearish:
- if (pad == 0)
+ if (pad == ZERO_PAD)
pad = yr_spec;
always_output_a_sign
- = (pad == L_('+')
+ = (pad == SIGN_PAD
&& ((digits == 2 ? 99 : 9999) < u_number_value
|| digits < width));
goto do_maybe_signed_number;
do_number_spacepad:
- if (pad == 0)
- pad = L_('_');
+ if (pad == ZERO_PAD)
+ pad = SPACE_PAD;
do_number:
/* Format NUMBER_VALUE according to the MODIFIER flag. */
@@ -1551,8 +1559,8 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
while (u_number_value != 0 || tz_colon_mask != 0);
do_number_sign_and_padding:
- if (pad == 0)
- pad = L_('0');
+ if (pad == ZERO_PAD)
+ pad = ALWAYS_ZERO_PAD;
if (width < 0)
width = digits;
@@ -1562,11 +1570,11 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
: 0);
int numlen = buf + sizeof buf / sizeof buf[0] - bufp;
int shortage = width - !!sign_char - numlen;
- int padding = pad == L_('-') || shortage <= 0 ? 0 : shortage;
+ int padding = pad == NO_PAD || shortage <= 0 ? 0 : shortage;
if (sign_char)
{
- if (pad == L_('_'))
+ if (pad == SPACE_PAD)
{
if (p)
memset_space (p, padding);
@@ -1584,9 +1592,9 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
case L_('F'):
if (modifier != 0)
goto bad_format;
- if (pad == 0 && width < 0)
+ if (pad == ZERO_PAD && width < 0)
{
- pad = L_('+');
+ pad = SIGN_PAD;
subwidth = 4;
}
else
@@ -1653,8 +1661,8 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
ndigs--, n /= 10;
for (int j = ndigs; 0 < j; j--)
buf[j - 1] = n % 10 + L_('0'), n /= 10;
- if (!pad)
- pad = L_('0');
+ if (pad == ZERO_PAD)
+ pad = ALWAYS_ZERO_PAD;
width_cpy (0, ndigs, buf);
width_add (width - ndigs, 0, (void) 0);
}
@@ -1864,7 +1872,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
# else
subfmt = era->era_format;
# endif
- if (pad == 0)
+ if (pad == ZERO_PAD)
pad = yr_spec;
goto subformat;
}
@@ -1887,7 +1895,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
if (era)
{
int delta = tp->tm_year - era->start_date[0];
- if (pad == 0)
+ if (pad == ZERO_PAD)
pad = yr_spec;
DO_NUMBER (2, (era->offset
+ delta * era->absolute_direction));
@@ -1916,7 +1924,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
{
/* 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;
+ size_t w = pad == NO_PAD || width < 0 ? 0 : width;
char const *z = zone;
mbstate_t st = {0};
size_t len = __mbsrtowcs_l (p, &z, maxsize - i, &st, loc);
@@ -1934,7 +1942,8 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
{
size_t delta = w - len;
__wmemmove (p + delta, p, len);
- wchar_t wc = pad == L_('0') || pad == L_('+') ? L'0' : L'
';
+ wchar_t wc = (pad == ALWAYS_ZERO_PAD || pad == SIGN_PAD
+ ? L'0' : L' ');
wmemset (p, wc, delta);
}
p += incr;
diff --git a/lib/sys_select.in.h b/lib/sys_select.in.h
index de29c77949a..ddf25d1de4c 100644
--- a/lib/sys_select.in.h
+++ b/lib/sys_select.in.h
@@ -328,7 +328,9 @@ _GL_CXXALIAS_SYS (select, int,
(int, fd_set *restrict, fd_set *restrict, fd_set *restrict,
timeval *restrict));
# endif
+# if __GLIBC__ >= 2
_GL_CXXALIASWARN (select);
+# endif
#elif @HAVE_WINSOCK2_H@
# undef select
# define select select_used_without_requesting_gnulib_module_select
diff --git a/lib/sys_types.in.h b/lib/sys_types.in.h
index 0a0ccc3c379..4eb2e926960 100644
--- a/lib/sys_types.in.h
+++ b/lib/sys_types.in.h
@@ -60,6 +60,15 @@
# define _GL_WINDOWS_64_BIT_OFF_T 1
#endif
+/* Define the off64_t type. */
+#if !@HAVE_OFF64_T@
+# if !GNULIB_defined_off64_t
+/* Define off64_t to int64_t always. */
+typedef long long off64_t;
+# define GNULIB_defined_off64_t 1
+# endif
+#endif
+
/* Override dev_t and ino_t if distinguishable inodes support is requested
on native Windows. */
#if @WINDOWS_STAT_INODES@
diff --git a/lib/u64.h b/lib/u64.h
index 63339cca0fc..cfb55887578 100644
--- a/lib/u64.h
+++ b/lib/u64.h
@@ -22,15 +22,20 @@
#error "Please include config.h first."
#endif
+#include <stddef.h>
#include <stdint.h>
+#include <byteswap.h>
+
_GL_INLINE_HEADER_BEGIN
#ifndef _GL_U64_INLINE
# define _GL_U64_INLINE _GL_INLINE
#endif
-/* Return X rotated left by N bits, where 0 < N < 64. */
-#define u64rol(x, n) u64or (u64shl (x, n), u64shr (x, 64 - n))
+#ifdef __cplusplus
+extern "C" {
+#endif
+
#ifdef UINT64_MAX
@@ -48,24 +53,30 @@ typedef uint64_t u64;
# define u64plus(x, y) ((x) + (y))
# define u64shl(x, n) ((x) << (n))
# define u64shr(x, n) ((x) >> (n))
+# define u64bswap(x) bswap_64 (x)
#else
-/* u64 is a 64-bit unsigned integer value.
+# define _GL_U64_MASK32 0xfffffffful /* 2**32 - 1. */
+
+/* u64 represents a 64-bit unsigned integer value equal to (HI << 32) + LO.
+ Implement it with unsigned int, which the GNU coding standards say
+ is wide enough to hold 32 bits, and which does not signal an error
+ when adding (theoretically possible with types like uint_fast32_t).
u64init (HI, LO), is like u64hilo (HI, LO), but for use in
initializer contexts. */
# ifdef WORDS_BIGENDIAN
-typedef struct { uint32_t hi, lo; } u64;
+typedef struct { unsigned int hi, lo; } u64;
# define u64init(hi, lo) { hi, lo }
# else
-typedef struct { uint32_t lo, hi; } u64;
+typedef struct { unsigned int lo, hi; } u64;
# define u64init(hi, lo) { lo, hi }
# endif
/* Given the high and low-order 32-bit quantities HI and LO, return a u64
value representing (HI << 32) + LO. */
_GL_U64_INLINE u64
-u64hilo (uint32_t hi, uint32_t lo)
+u64hilo (unsigned int hi, unsigned int lo)
{
u64 r;
r.hi = hi;
@@ -73,9 +84,9 @@ u64hilo (uint32_t hi, uint32_t lo)
return r;
}
-/* Return a u64 value representing LO. */
+/* Return a u64 value representing the 32-bit quantity LO. */
_GL_U64_INLINE u64
-u64lo (uint32_t lo)
+u64lo (unsigned int lo)
{
u64 r;
r.hi = 0;
@@ -83,18 +94,18 @@ u64lo (uint32_t lo)
return r;
}
-/* Return a u64 value representing SIZE. */
+/* Return a u64 value representing SIZE, where 0 <= SIZE < 2**64. */
_GL_U64_INLINE u64
u64size (size_t size)
{
u64 r;
r.hi = size >> 31 >> 1;
- r.lo = size;
+ r.lo = size & _GL_U64_MASK32;
return r;
}
/* Return X < Y. */
-_GL_U64_INLINE int
+_GL_U64_INLINE bool
u64lt (u64 x, u64 y)
{
return x.hi < y.hi || (x.hi == y.hi && x.lo < y.lo);
@@ -130,29 +141,29 @@ u64xor (u64 x, u64 y)
return r;
}
-/* Return X + Y. */
+/* Return X + Y, wrapping around on overflow. */
_GL_U64_INLINE u64
u64plus (u64 x, u64 y)
{
u64 r;
- r.lo = x.lo + y.lo;
- r.hi = x.hi + y.hi + (r.lo < x.lo);
+ r.lo = (x.lo + y.lo) & _GL_U64_MASK32;
+ r.hi = (x.hi + y.hi + (r.lo < x.lo)) & _GL_U64_MASK32;
return r;
}
-/* Return X << N. */
+/* Return X << N, where 0 <= N < 64. */
_GL_U64_INLINE u64
u64shl (u64 x, int n)
{
u64 r;
if (n < 32)
{
- r.hi = (x.hi << n) | (x.lo >> (32 - n));
- r.lo = x.lo << n;
+ r.hi = (x.hi << n & _GL_U64_MASK32) | x.lo >> (32 - n);
+ r.lo = x.lo << n & _GL_U64_MASK32;
}
else
{
- r.hi = x.lo << (n - 32);
+ r.hi = x.lo << (n - 32) & _GL_U64_MASK32;
r.lo = 0;
}
return r;
@@ -166,7 +177,7 @@ u64shr (u64 x, int n)
if (n < 32)
{
r.hi = x.hi >> n;
- r.lo = (x.hi << (32 - n)) | (x.lo >> n);
+ r.lo = (x.hi << (32 - n) & _GL_U64_MASK32) | x.lo >> n;
}
else
{
@@ -176,6 +187,25 @@ u64shr (u64 x, int n)
return r;
}
+/* Return X with bytes in reverse order. */
+_GL_U64_INLINE u64
+u64bswap (u64 x)
+{
+ return u64hilo (bswap_32 (x.lo), bswap_32 (x.hi));
+}
+
+#endif
+
+/* Return X rotated left by N bits, where 0 < N < 64. */
+_GL_U64_INLINE u64
+u64rol (u64 x, int n)
+{
+ return u64or (u64shl (x, n), u64shr (x, 64 - n));
+}
+
+
+#ifdef __cplusplus
+}
#endif
_GL_INLINE_HEADER_END
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index b412966367d..7dbed38969b 100644
--- a/lib/unistd.in.h
+++ b/lib/unistd.in.h
@@ -159,8 +159,9 @@
#endif
/* MSVC defines off_t in <sys/types.h>.
- May also define off_t to a 64-bit type on native Windows. */
-/* Get off_t, ssize_t, mode_t. */
+ May also define off_t to a 64-bit type on native Windows.
+ Also defines off64_t on macOS, NetBSD, OpenBSD, MSVC, Cygwin, Haiku. */
+/* Get off_t, off64_t, ssize_t, mode_t. */
#include <sys/types.h>
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
@@ -1933,11 +1934,7 @@ _GL_CXXALIASWARN (read);
# undef read
# define read _read
# endif
-# ifdef __MINGW32__
-_GL_CXXALIAS_MDA (read, int, (int fd, void *buf, unsigned int count));
-# else
-_GL_CXXALIAS_MDA (read, ssize_t, (int fd, void *buf, unsigned int count));
-# endif
+_GL_CXXALIAS_MDA_CAST (read, ssize_t, (int fd, void *buf, unsigned int count));
# else
_GL_CXXALIAS_SYS (read, ssize_t, (int fd, void *buf, size_t count));
# endif
@@ -2401,11 +2398,7 @@ _GL_CXXALIASWARN (write);
# undef write
# define write _write
# endif
-# ifdef __MINGW32__
-_GL_CXXALIAS_MDA (write, int, (int fd, const void *buf, unsigned int count));
-# else
-_GL_CXXALIAS_MDA (write, ssize_t, (int fd, const void *buf, unsigned int
count));
-# endif
+_GL_CXXALIAS_MDA_CAST (write, ssize_t, (int fd, const void *buf, unsigned int
count));
# else
_GL_CXXALIAS_SYS (write, ssize_t, (int fd, const void *buf, size_t count));
# endif
diff --git a/lib/utimens.h b/lib/utimens.h
index 7c740afd36d..b20d4f4f7ee 100644
--- a/lib/utimens.h
+++ b/lib/utimens.h
@@ -23,11 +23,22 @@
#endif
#include <time.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
int fdutimens (int, char const *, struct timespec const [2]);
int utimens (char const *, struct timespec const [2]);
int lutimens (char const *, struct timespec const [2]);
+#ifdef __cplusplus
+}
+#endif
+
+
#if GNULIB_FDUTIMENSAT
+
# include <fcntl.h>
# include <sys/stat.h>
@@ -36,6 +47,10 @@ _GL_INLINE_HEADER_BEGIN
# define _GL_UTIMENS_INLINE _GL_INLINE
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
int fdutimensat (int fd, int dir, char const *name, struct timespec const [2],
int atflag);
@@ -46,6 +61,10 @@ lutimensat (int dir, char const *file, struct timespec const
times[2])
return utimensat (dir, file, times, AT_SYMLINK_NOFOLLOW);
}
+#ifdef __cplusplus
+}
+#endif
+
_GL_INLINE_HEADER_END
#endif
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 9a8dd6679e3..bf9def681c3 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -563,6 +563,8 @@ Its value is an `archive--file-desc'.")
(defvar-local archive-files nil
"Vector of `archive--file-desc' objects.")
+(defvar tar-archive-from-tar nil)
+
;; -------------------------------------------------------------------------
;;; Section: Support functions.
@@ -754,7 +756,8 @@ archive.
;; on local filesystem. Treat such archives as remote.
(or archive-remote
(setq archive-remote
- (or (string-match archive-remote-regexp (buffer-file-name))
+ (or tar-archive-from-tar ; was included in a tar archive
+ (string-match archive-remote-regexp (buffer-file-name))
(string-match file-name-invalid-regexp
(buffer-file-name)))))
@@ -920,6 +923,9 @@ If FNAME can be uniquely created in DIR, it is returned
unaltered.
If FNAME is something our underlying filesystem can't grok, or if another
file by that name already exists in DIR, a unique new name is generated
using `make-temp-file', and the generated name is returned."
+ (if (file-name-absolute-p fname)
+ ;; We need a file name relative to the filesystem root.
+ (setq fname (substring fname (1+ (string-search "/" fname)))))
(let ((fullname (expand-file-name fname dir))
(alien (string-match file-name-invalid-regexp fname))
(tmpfile
@@ -1179,6 +1185,9 @@ NEW-NAME."
(buffer (get-buffer bufname))
(just-created nil)
(file-name-coding archive-file-name-coding-system))
+ (or archive-remote
+ (and (local-variable-p 'tar-archive-from-tar)
+ (setq archive-remote tar-archive-from-tar)))
(if (and buffer
(string= (buffer-file-name buffer) arcfilename))
nil
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index e6dbead7476..2de78c5ae55 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -2489,22 +2489,30 @@ point is moved into the passwords (see
`authinfo-hide-elements').
"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))
+ (let ((win (active-minibuffer-window)))
+ (unless win (error "No active minibuffer"))
+ ;; FIXME: In case of a recursive minibuffer, this may select the wrong
+ ;; mini-buffer.
+ (with-current-buffer (window-buffer win)
+ (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
+ keymap
+ ,(eval-when-compile
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line mouse-1]
+ #'read-passwd-toggle-visibility)
+ map))))
+ (force-mode-line-update))
+ (read-passwd--hide-password))))
(defvar read-passwd-map
;; BEWARE: `defconst' would purecopy it, breaking the sharing with
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 50af32076a3..5a8c7cfafd7 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -381,7 +381,7 @@ the symbol `mode-line-format-right-align' is processed by
`(space :align-to (,(- (window-pixel-width)
(window-scroll-bar-width)
(window-right-divider-width)
- (* (or (cdr (window-margins)) 1)
+ (* (or (car (window-margins)) 0)
(frame-char-width))
;; Manually account for value of
;; `mode-line-right-align-edge' even
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index bf2357207d8..06f8e24b518 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -515,18 +515,45 @@ See user option `bookmark-fringe-mark'."
(non-essential t)
overlays found temp)
(when (and pos filename)
- (setq filename (abbreviate-file-name (expand-file-name filename)))
(dolist (buf (buffer-list))
(with-current-buffer buf
- (when (equal filename
- (ignore-errors (bookmark-buffer-file-name)))
- (setq overlays
- (save-excursion
- (goto-char pos)
- (overlays-in (pos-bol) (1+ (pos-bol)))))
- (while (and (not found) (setq temp (pop overlays)))
- (when (eq 'bookmark (overlay-get temp 'category))
- (delete-overlay (setq found temp))))))))))
+ (let ((bkmk-fname (ignore-errors (bookmark-buffer-file-name))))
+ (when bkmk-fname
+ ;; Normalize both filenames before comparing, because the
+ ;; filename we receive from the bookmark wasn't
+ ;; necessarily generated by `bookmark-buffer-file-name'.
+ ;; For example, bookmarks set in Info nodes get a filename
+ ;; based on `Info-current-file', and under certain
+ ;; circumstances that can be an unexpanded path (e.g.,
+ ;; when the Info page was under your home directory).
+ (let ((this-fname-normalized (expand-file-name filename))
+ (bkmk-fname-normalized (expand-file-name bkmk-fname)))
+ (when (equal this-fname-normalized bkmk-fname-normalized)
+ (setq overlays
+ (save-excursion
+ (save-restriction
+ ;; Suppose bookmark "foo" was earlier set at
+ ;; location X in a file, but now the file is
+ ;; narrowed such that X is outside the
+ ;; restriction. Then the `goto-char' below
+ ;; would go to the wrong place and thus the
+ ;; wrong overlays would be fetched. This is
+ ;; why we temporarily `widen' before
+ ;; fetching.
+ ;;
+ ;; (This circumstance can easily arise when
+ ;; a bookmark was set on Info node X but now
+ ;; the "*info*" buffer is showing some other
+ ;; node Y, with X and Y physically located
+ ;; in the same file, as is often the case
+ ;; with Info nodes. See bug #70019, for
+ ;; example.)
+ (widen)
+ (goto-char pos)
+ (overlays-in (pos-bol) (1+ (pos-bol))))))
+ (while (and (not found) (setq temp (pop overlays)))
+ (when (eq 'bookmark (overlay-get temp 'category))
+ (delete-overlay (setq found temp)))))))))))))
(defun bookmark-maybe-sort-alist ()
"Return `bookmark-alist' for display.
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 12287299a7f..77f0ee7e565 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -5702,6 +5702,11 @@ of each other."
Passed by `todo-insert-item' to `todo-insert-item--next-param' to
dynamically create item insertion commands.")
+;; As the following function uses this variable, define it here without
+;; a value to avoid a byte-compiler warning. The real definition with
+;; value is provided below with the other todo-mode key bindings.
+(defvar todo-mode-map)
+
(defun todo-insert-item--next-param (args params last keys-so-far)
"Generate and invoke an item insertion command.
Dynamically generate the command, its arguments ARGS and its key
@@ -5794,7 +5799,24 @@ keys already entered and those still available."
(apply #'todo-insert-item--basic (nconc arg parlist)))))
;; Operate on a copy of the parameter list so the original is
;; not consumed, thus available for the next key typed.
- (params0 params))
+ (params0 params)
+ (tm-keys (let (l)
+ (map-keymap (lambda (key _binding)
+ (push key l))
+ todo-mode-map)
+ l)))
+ ;; Initially assign each key in todo-mode-map a function identifying
+ ;; it as invalid for item insertion, thus preventing mistakenly
+ ;; pressing a key from executing an unwanted different todo-mode
+ ;; command (bug#70937); the actual item insertion keys are redefined
+ ;; when looping over the item insertion parameters.
+ (dolist (k tm-keys)
+ (when (characterp k)
+ (define-key map (string k)
+ (lambda ()
+ (interactive)
+ (message (concat "`%s' is not a valid remaining item insertion
key")
+ (string k))))))
(when last
(if (memq last '(default copy))
(progn
diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el
index 41030aa6944..db6b3988562 100644
--- a/lisp/cedet/srecode/find.el
+++ b/lisp/cedet/srecode/find.el
@@ -233,8 +233,8 @@ templates."
(when (or (not predicate)
(funcall predicate temp))
(puthash key temp mhash)))
- (oref tab namehash))))
- mhash))))
+ (oref tab namehash))))))
+ mhash))
(defun srecode-calculate-default-template-string (hash)
"Calculate the name of the template to use as a DEFAULT.
diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
index c84a1809322..d4316fb1175 100644
--- a/lisp/cmuscheme.el
+++ b/lisp/cmuscheme.el
@@ -238,7 +238,8 @@ is run).
(inferior-scheme-mode)))
(setq scheme-program-name cmd)
(setq scheme-buffer "*scheme*")
- (pop-to-buffer "*scheme*" display-comint-buffer-action))
+ (with-suppressed-warnings ((obsolete display-comint-buffer-action))
+ (pop-to-buffer "*scheme*" display-comint-buffer-action)))
(defun scheme-start-file (prog)
"Return the name of the start file corresponding to PROG.
@@ -358,7 +359,8 @@ With argument, position cursor at end of buffer."
(interactive "P")
(if (or (and scheme-buffer (get-buffer scheme-buffer))
(scheme-interactively-start-process))
- (pop-to-buffer scheme-buffer display-comint-buffer-action)
+ (with-suppressed-warnings ((obsolete display-comint-buffer-action))
+ (pop-to-buffer scheme-buffer display-comint-buffer-action))
(error "No current process buffer. See variable `scheme-buffer'"))
(when eob-p
(push-mark)
diff --git a/lisp/color.el b/lisp/color.el
index 078c12fbf47..79dced4e3d7 100644
--- a/lisp/color.el
+++ b/lisp/color.el
@@ -29,7 +29,8 @@
;;
;; Supported color representations include RGB (red, green, blue), HSV
;; (hue, saturation, value), HSL (hue, saturation, luminance), sRGB,
-;; CIE XYZ, and CIE L*a*b* color components.
+;; CIE XYZ, CIE L*a*b* color components, and the Oklab perceptual color
+;; space.
;;; Code:
@@ -368,6 +369,44 @@ returned by `color-srgb-to-lab' or `color-xyz-to-lab'."
(expt (/ ΔH′ (* Sh kH)) 2.0)
(* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH)))))))
+(defun color-oklab-to-xyz (l a b)
+ "Convert the OkLab color represented by L A B to CIE XYZ.
+Oklab is a perceptual color space created by Björn Ottosson
+<https://bottosson.github.io/posts/oklab/>. It has the property that
+changes in the hue and saturation of a color can be made while maintaining
+the same perceived lightness."
+ (let ((ll (expt (+ (* 1.0 l) (* 0.39633779 a) (* 0.21580376 b)) 3))
+ (mm (expt (+ (* 1.00000001 l) (* -0.10556134 a) (* -0.06385417 b)) 3))
+ (ss (expt (+ (* 1.00000005 l) (* -0.08948418 a) (* -1.29148554 b)) 3)))
+ (list (+ (* ll 1.22701385) (* mm -0.55779998) (* ss 0.28125615))
+ (+ (* ll -0.04058018) (* mm 1.11225687) (* ss -0.07167668))
+ (+ (* ll -0.07638128) (* mm -0.42148198) (* ss 1.58616322)))))
+
+(defun color-xyz-to-oklab (x y z)
+ "Convert the CIE XYZ color represented by X Y Z to Oklab."
+ (let ((ll (+ (* x 0.8189330101) (* y 0.3618667424) (* z -0.1288597137)))
+ (mm (+ (* x 0.0329845436) (* y 0.9293118715) (* z 0.0361456387)))
+ (ss (+ (* x 0.0482003018) (* y 0.2643662691) (* z 0.6338517070))))
+ (let*
+ ((cube-root (lambda (f)
+ (if (< f 0)
+ (- (expt (- f) (/ 1.0 3.0)))
+ (expt f (/ 1.0 3.0)))))
+ (lll (funcall cube-root ll))
+ (mmm (funcall cube-root mm))
+ (sss (funcall cube-root ss)))
+ (list (+ (* lll 0.2104542553) (* mmm 0.7936177850) (* sss -0.0040720468))
+ (+ (* lll 1.9779984951) (* mmm -2.4285922050) (* sss 0.4505937099))
+ (+ (* lll 0.0259040371) (* mmm 0.7827717662) (* sss
-0.8086757660))))))
+
+(defun color-oklab-to-srgb (l a b)
+ "Convert the Oklab color represented by L A B to sRGB."
+ (apply #'color-xyz-to-srgb (color-oklab-to-xyz l a b)))
+
+(defun color-srgb-to-oklab (r g b)
+ "Convert the sRGB color R G B to Oklab."
+ (apply #'color-xyz-to-oklab (color-srgb-to-xyz r g b)))
+
(defun color-clamp (value)
"Make sure VALUE is a number between 0.0 and 1.0 inclusive."
(min 1.0 (max 0.0 value)))
diff --git a/lisp/comint.el b/lisp/comint.el
index a8fe095e99c..3804932e01c 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1122,7 +1122,7 @@ See also `comint-read-input-ring'."
(defun comint-dynamic-list-input-ring-select ()
"Choose the input history entry that point is in or next to."
- (interactive)
+ (interactive nil completion-list-mode)
(let ((buffer completion-reference-buffer)
beg end completion)
(if (and (not (eobp)) (get-text-property (point) 'mouse-face))
@@ -1139,7 +1139,7 @@ See also `comint-read-input-ring'."
(defun comint-dynamic-list-input-ring ()
"Display a list of recent inputs entered into the current buffer."
- (interactive)
+ (interactive nil comint-mode)
(if (or (not (ring-p comint-input-ring))
(ring-empty-p comint-input-ring))
(message "No history")
@@ -1203,7 +1203,7 @@ See also `comint-read-input-ring'."
(defun comint-restore-input ()
"Restore unfinished input."
- (interactive)
+ (interactive nil comint)
(when comint-input-ring-index
(comint-delete-input)
(when (> (length comint-stored-incomplete-input) 0)
@@ -1232,7 +1232,7 @@ Moves relative to `comint-input-ring-index'."
(defun comint-previous-input (arg)
"Cycle backwards through input history, saving input."
- (interactive "*p")
+ (interactive "*p" comint-mode)
(if (and comint-input-ring-index
(or ;; leaving the "end" of the ring
(and (< arg 0) ; going down
@@ -1246,7 +1246,7 @@ Moves relative to `comint-input-ring-index'."
(defun comint-next-input (arg)
"Cycle forwards through input history."
- (interactive "*p")
+ (interactive "*p" comint-mode)
(comint-previous-input (- arg)))
(defun comint-previous-matching-input-string (regexp arg)
@@ -1295,7 +1295,7 @@ Moves relative to START, or `comint-input-ring-index'."
\(Previous history elements are earlier commands.)
With prefix argument N, search for Nth previous match.
If N is negative, find the next or Nth next match."
- (interactive (comint-regexp-arg "Previous input matching (regexp): "))
+ (interactive (comint-regexp-arg "Previous input matching (regexp): ")
comint-mode)
(setq n (comint-search-arg n))
(let ((pos (comint-previous-matching-input-string-position regexp n)))
;; Has a match been found?
@@ -1325,7 +1325,7 @@ If N is negative, find the next or Nth next match."
\(Later history elements are more recent commands.)
With prefix argument N, search for Nth following match.
If N is negative, find the previous or Nth previous match."
- (interactive (comint-regexp-arg "Next input matching (regexp): "))
+ (interactive (comint-regexp-arg "Next input matching (regexp): ")
comint-mode)
(comint-previous-matching-input regexp (- n)))
(defun comint-previous-matching-input-from-input (n)
@@ -1333,7 +1333,7 @@ If N is negative, find the previous or Nth previous
match."
\(Previous history elements are earlier commands.)
With prefix argument N, search for Nth previous match.
If N is negative, search forwards for the -Nth following match."
- (interactive "p")
+ (interactive "p" comint-mode)
(let ((opoint (point)))
(unless (memq last-command '(comint-previous-matching-input-from-input
comint-next-matching-input-from-input))
@@ -1355,7 +1355,7 @@ If N is negative, search forwards for the -Nth following
match."
\(Following history elements are more recent commands.)
With prefix argument N, search for Nth following match.
If N is negative, search backwards for the -Nth previous match."
- (interactive "p")
+ (interactive "p" comint-mode)
(comint-previous-matching-input-from-input (- n)))
@@ -1380,7 +1380,7 @@ than the logical beginning of line.
See `comint-magic-space' and `comint-replace-by-expanded-history-before-point'.
Returns t if successful."
- (interactive)
+ (interactive nil comint-mode)
(let ((f (comint-c-a-p-replace-by-expanded-history silent start)))
(if f (funcall f))))
@@ -1510,7 +1510,7 @@ actual side-effect."
(defun comint-magic-space (arg)
"Expand input history references before point and insert ARG spaces.
A useful command to bind to SPC. See `comint-replace-by-expanded-history'."
- (interactive "p")
+ (interactive "p" comint-mode)
(comint-replace-by-expanded-history)
(self-insert-command arg))
@@ -1532,13 +1532,13 @@ If nil, Isearch operates on the whole comint buffer."
(defun comint-history-isearch-backward ()
"Search for a string backward in input history using Isearch."
- (interactive)
+ (interactive nil comint-mode)
(setq comint-history-isearch t)
(isearch-backward nil t))
(defun comint-history-isearch-backward-regexp ()
"Search for a regular expression backward in input history using Isearch."
- (interactive)
+ (interactive nil comint-mode)
(setq comint-history-isearch t)
(isearch-backward-regexp nil t))
@@ -1927,7 +1927,7 @@ If the Comint is Lucid Common Lisp,
which matches (1) all whitespace (2) :a, :c, etc.
Similarly for Soar, Scheme, etc."
- (interactive)
+ (interactive nil comint-mode)
;; If we're currently completing, stop. We're definitely done
;; completing, and by sending the input, we might cause side effects
;; that will confuse the code running in the completion
@@ -2376,7 +2376,7 @@ SELECTED is the window that was originally selected."
(defun comint-truncate-buffer (&optional _string)
"Truncate the buffer to `comint-buffer-maximum-size'.
This function could be on `comint-output-filter-functions' or bound to a key."
- (interactive)
+ (interactive nil comint-mode)
(save-excursion
(goto-char (process-mark (get-buffer-process (current-buffer))))
(forward-line (- comint-buffer-maximum-size))
@@ -2387,7 +2387,7 @@ This function could be on
`comint-output-filter-functions' or bound to a key."
(defun comint-strip-ctrl-m (&optional _string interactive)
"Strip trailing `^M' characters from the current output group.
This function could be on `comint-output-filter-functions' or bound to a key."
- (interactive (list nil t))
+ (interactive (list nil t) comint-mode)
(let ((process (get-buffer-process (current-buffer))))
(if (not process)
;; This function may be used in
@@ -2409,7 +2409,7 @@ This function could be on
`comint-output-filter-functions' or bound to a key."
(defun comint-show-maximum-output ()
"Put the end of the buffer at the bottom of the window."
- (interactive)
+ (interactive nil comint-mode)
(goto-char (point-max))
(recenter (- -1 scroll-margin)))
@@ -2437,7 +2437,7 @@ the current line with any initial string matching the
regexp
(defun comint-copy-old-input ()
"Insert after prompt old input at point as new input to be edited.
Calls `comint-get-old-input' to get old input."
- (interactive)
+ (interactive nil comint-mode)
(let ((input (funcall comint-get-old-input))
(process (get-buffer-process (current-buffer))))
(if (not process)
@@ -2503,7 +2503,7 @@ If prefix argument is given (\\[universal-argument]) the
prompt is not skipped.
If `comint-use-prompt-regexp' is non-nil, then the prompt skip is done
by skipping text matching the regular expression `comint-prompt-regexp',
a buffer local variable."
- (interactive "P")
+ (interactive "P" comint-mode)
(if arg
;; Unlike `beginning-of-line', forward-line ignores field boundaries
(forward-line 0)
@@ -2530,7 +2530,7 @@ Then send it to the process running in the current buffer.
The string is sent using `comint-input-sender'.
Security bug: your string can still be temporarily recovered with
\\[view-lossage]; `clear-this-command-keys' can fix that."
- (interactive "P") ; Defeat snooping via C-x ESC ESC
+ (interactive "P" comint-mode) ; Defeat snooping via
C-x ESC ESC
(let ((proc (get-buffer-process (current-buffer)))
(prefix
(if (eq (window-buffer) (current-buffer))
@@ -2612,7 +2612,7 @@ If KILL (interactively, the prefix), save the killed text
in the
kill ring.
This command does not delete the prompt."
- (interactive "P")
+ (interactive "P" comint-mode)
(let ((proc (get-buffer-process (current-buffer)))
(replacement nil)
(inhibit-read-only t))
@@ -2650,7 +2650,8 @@ otherwise."
"Append output to file: "
"Write output to file: "))
current-prefix-arg
- (not current-prefix-arg)))
+ (not current-prefix-arg))
+ comint-mode)
(save-excursion
(goto-char (process-mark (get-buffer-process (current-buffer))))
(forward-line 0)
@@ -2662,13 +2663,13 @@ otherwise."
(defun comint-append-output-to-file (filename)
"Append output from interpreter since last input to FILENAME.
Any prompt at the end of the output is not written."
- (interactive "fAppend output to file: ")
+ (interactive "fAppend output to file: " comint-mode)
(comint-write-output filename t))
(defun comint-show-output ()
"Display start of this batch of interpreter output at top of window.
Sets mark to the value of point when this command is run."
- (interactive)
+ (interactive nil comint-mode)
(push-mark)
(let ((pos (or (marker-position comint-last-input-end) (point-max))))
(cond (comint-use-prompt-regexp
@@ -2682,13 +2683,13 @@ Sets mark to the value of point when this command is
run."
(defun comint-clear-buffer ()
"Clear the comint buffer."
- (interactive)
+ (interactive nil comint-mode)
(let ((comint-buffer-maximum-size 0))
(comint-truncate-buffer)))
(defun comint-interrupt-subjob ()
"Interrupt the current subjob."
- (interactive)
+ (interactive nil comint-mode)
(comint-skip-input)
(interrupt-process nil comint-ptyp)
;; (process-send-string nil "\n")
@@ -2696,13 +2697,13 @@ Sets mark to the value of point when this command is
run."
(defun comint-kill-subjob ()
"Send kill signal to the current subjob."
- (interactive)
+ (interactive nil comint-mode)
(comint-skip-input)
(kill-process nil comint-ptyp))
(defun comint-quit-subjob ()
"Send quit signal to the current subjob."
- (interactive)
+ (interactive nil comint-mode)
(comint-skip-input)
(quit-process nil comint-ptyp))
@@ -2713,14 +2714,14 @@ WARNING: if there is no current subjob, you can end up
suspending
the top-level process running in the buffer. If you accidentally do
this, use \\[comint-continue-subjob] to resume the process. (This
is not a problem with most shells, since they ignore this signal.)"
- (interactive)
+ (interactive nil comint-mode)
(comint-skip-input)
(stop-process nil comint-ptyp))
(defun comint-continue-subjob ()
"Send CONT signal to process buffer's process group.
Useful if you accidentally suspend the top-level process."
- (interactive)
+ (interactive nil comint-mode)
(continue-process nil comint-ptyp))
(defun comint-skip-input ()
@@ -2741,7 +2742,7 @@ called this function are inserted into the buffer."
(defun comint-kill-input ()
"Kill all text from last stuff output by interpreter to point."
- (interactive)
+ (interactive nil comint-mode)
(let ((pmark (process-mark (get-buffer-process (current-buffer)))))
(if (> (point) (marker-position pmark))
(kill-region pmark (point)))))
@@ -2749,7 +2750,7 @@ called this function are inserted into the buffer."
(defun comint-delchar-or-maybe-eof (arg)
"Delete ARG characters forward or send an EOF to subprocess.
Sends an EOF only if point is at the end of the buffer and there is no input."
- (interactive "p")
+ (interactive "p" comint-mode)
(let ((proc (get-buffer-process (current-buffer))))
(if (and (eobp) proc (= (point) (marker-position (process-mark proc))))
(comint-send-eof)
@@ -2757,7 +2758,7 @@ Sends an EOF only if point is at the end of the buffer
and there is no input."
(defun comint-send-eof ()
"Send an EOF to the current buffer's process."
- (interactive)
+ (interactive nil comint-mode)
(comint-send-input t t)
(process-send-eof))
@@ -2769,7 +2770,7 @@ by lines that match `comint-prompt-regexp'.
With prefix argument N, search for Nth previous match.
If N is negative, find the next or Nth next match."
- (interactive (comint-regexp-arg "Backward input matching (regexp): "))
+ (interactive (comint-regexp-arg "Backward input matching (regexp): ")
comint-mode)
(if comint-use-prompt-regexp
;; Use comint-prompt-regexp
(let* ((re (concat comint-prompt-regexp ".*" regexp))
@@ -2801,7 +2802,7 @@ by lines that match `comint-prompt-regexp'.
With prefix argument N, search for Nth following match.
If N is negative, find the previous or Nth previous match."
- (interactive (comint-regexp-arg "Forward input matching (regexp): "))
+ (interactive (comint-regexp-arg "Forward input matching (regexp): ")
comint-mode)
(comint-backward-matching-input regexp (- n)))
@@ -2810,7 +2811,7 @@ If N is negative, find the previous or Nth previous
match."
If `comint-use-prompt-regexp' is nil, then this means the beginning of
the Nth next `input' field, otherwise, it means the Nth occurrence of
text matching `comint-prompt-regexp'."
- (interactive "^p")
+ (interactive "^p" comint-mode)
(if comint-use-prompt-regexp
;; Use comint-prompt-regexp
(let ((paragraph-start comint-prompt-regexp))
@@ -2847,7 +2848,7 @@ text matching `comint-prompt-regexp'."
If `comint-use-prompt-regexp' is nil, then this means the beginning of
the Nth previous `input' field, otherwise, it means the Nth occurrence of
text matching `comint-prompt-regexp'."
- (interactive "^p")
+ (interactive "^p" comint-mode)
(comint-next-prompt (- n)))
;; State used by `comint-insert-previous-argument' when cycling.
@@ -2875,7 +2876,7 @@ from progressively earlier commands (using the value of
INDEX specified
with the first command). Values of INDEX < 0 count from the end, so
INDEX = -1 is the last argument. This command is like \"M-.\" in
Bash and zsh."
- (interactive "P")
+ (interactive "P" comint-mode)
(unless (null index)
(setq index (prefix-numeric-value index)))
(cond ((eq last-command this-command)
@@ -2949,7 +2950,7 @@ with negative arguments.)
If COUNT is zero, kill current line but exclude the trailing newline.
The read-only status of newlines is updated with `comint-update-fence',
if necessary."
- (interactive "p")
+ (interactive "p" comint-mode)
(let ((inhibit-read-only t) (inhibit-field-text-motion t))
(kill-whole-line count)
(when (>= count 0) (comint-update-fence))))
@@ -2968,7 +2969,7 @@ prompts should stay at the beginning of a line. If this
is not
the case, this command just calls `kill-region' with all
read-only properties intact. The read-only status of newlines is
updated using `comint-update-fence', if necessary."
- (interactive "r")
+ (interactive "r" comint-mode)
(save-excursion
(let* ((true-beg (min beg end))
(true-end (max beg end))
@@ -3363,7 +3364,7 @@ Completion is dependent on the value of
`comint-completion-addsuffix',
completions listing is dependent on the value of `comint-completion-autolist'.
Returns t if successful."
- (interactive)
+ (interactive nil comint-mode)
(when (comint--match-partial-filename)
(unless (window-minibuffer-p)
(message "Completing file name..."))
@@ -3438,7 +3439,7 @@ variables (e.g. $HOME), `~'s, `..', and `.', and making
the
filename absolute. For expansion see `expand-file-name' and
`substitute-in-file-name'. For completion see
`comint-dynamic-complete-filename'."
- (interactive)
+ (interactive nil comint-mode)
(let ((filename (comint-match-partial-filename)))
(when filename
(replace-match (expand-file-name filename) t t)
@@ -3446,7 +3447,7 @@ filename absolute. For expansion see `expand-file-name'
and
(defun comint-dynamic-list-filename-completions ()
"Display a list of possible completions for the filename at point."
- (interactive)
+ (interactive nil comint-mode)
(let* ((data (comint--complete-file-name-data))
(minibuffer-completion-table (nth 2 data))
(minibuffer-completion-predicate nil)
@@ -3534,7 +3535,7 @@ the completions."
"After fetching a line from input history, this fetches the following line.
In other words, this recalls the input line after the line you recalled last.
You can use this to repeat a sequence of input lines."
- (interactive)
+ (interactive nil comint-mode)
(if comint-save-input-ring-index
(progn
(setq comint-input-ring-index (1+ comint-save-input-ring-index))
@@ -3548,7 +3549,7 @@ to be sent along with this line. Use
\\[comint-send-input]
to send all the accumulated input, at once.
The entire accumulated text becomes one item in the input history
when you send it."
- (interactive)
+ (interactive nil comint-mode)
(when-let* ((proc (get-buffer-process (current-buffer)))
(pmark (process-mark proc))
((or (marker-position comint-accum-marker)
@@ -3573,7 +3574,7 @@ when you send it."
"Move point to the process mark.
The process mark separates output, and input already sent,
from input that has not yet been sent."
- (interactive)
+ (interactive nil comint-mode)
(let ((proc (or (get-buffer-process (current-buffer))
(user-error "Current buffer has no process"))))
(goto-char (process-mark proc))
@@ -3591,14 +3592,14 @@ from input that has not yet been sent. Ordinarily, the
process mark
is at the beginning of the current input line; but if you have
used \\[comint-accumulate] to send multiple lines at once,
the process mark is at the beginning of the accumulated input."
- (interactive)
+ (interactive nil comint-mode)
(if (not (eq last-command 'comint-bol-or-process-mark))
(comint-bol nil)
(comint-goto-process-mark)))
(defun comint-set-process-mark ()
"Set the process mark at point."
- (interactive)
+ (interactive nil comint-mode)
(let ((proc (or (get-buffer-process (current-buffer))
(user-error "Current buffer has no process"))))
(set-marker (process-mark proc) (point))
@@ -3755,7 +3756,7 @@ and does not normally need to be invoked by the end user
or programmer."
(defun comint-redirect-cleanup ()
"End a Comint redirection. See `comint-redirect-send-command'."
- (interactive)
+ (interactive nil comint-mode)
;; Release the last redirected string
(setq comint-redirect-previous-input-string nil)
;; Restore the process filter
@@ -3864,7 +3865,7 @@ This function does not need to be invoked by the end
user."
With prefix arg ECHO, echo output in process buffer.
If NO-DISPLAY is non-nil, do not show the output buffer."
- (interactive "sCommand: \nBOutput Buffer: \nP")
+ (interactive "sCommand: \nBOutput Buffer: \nP" comint-mode)
(let ((process (get-buffer-process (current-buffer))))
(if process
(comint-redirect-send-command-to-process
@@ -3878,7 +3879,7 @@ If NO-DISPLAY is non-nil, do not show the output buffer."
With prefix arg, echo output in process buffer.
If NO-DISPLAY is non-nil, do not show the output buffer."
- (interactive "sCommand: \nBOutput Buffer: \nbProcess Buffer: \nP")
+ (interactive "sCommand: \nBOutput Buffer: \nbProcess Buffer: \nP"
comint-mode)
(let* (;; The process buffer
(process-buffer (if (processp process)
(process-buffer process)
@@ -3961,18 +3962,22 @@ REGEXP-GROUP is the regular expression group in REGEXP
to use."
;;; OSC escape sequences (Operating System Commands)
;;============================================================================
;; Adding `comint-osc-process-output' to
-;; `comint-output-filter-functions' enables the interpretation of OSC
-;; escape sequences. By default, OSC 7 and 8 (for current directory
-;; and hyperlinks respectively) are acted upon. Adding more entries
-;; to `comint-osc-handlers' allows a customized treatment of further
-;; sequences.
+;; `comint-output-filter-functions' enables interpreting of OSC
+;; escape sequences. See `ansi-osc-handlers' for a list of OSC
+;; sequences which are interpreted by default and information on how to
+;; handle new sequences.
;; Aliases defined for reverse compatibility
-(defvaralias 'comint-osc-handlers 'ansi-osc-handlers)
-(defalias 'comint-osc-directory-tracker 'ansi-osc-directory-tracker)
-(defalias 'comint-osc-hyperlink-handler 'ansi-osc-hyperlink-handler)
-(defalias 'comint-osc-hyperlink 'ansi-osc-hyperlink)
-(defvaralias 'comint-osc-hyperlink-map 'ansi-osc-hyperlink-map)
+(define-obsolete-variable-alias
+ 'comint-osc-handlers 'ansi-osc-handlers "30.1")
+(define-obsolete-function-alias
+ 'comint-osc-directory-tracker 'ansi-osc-directory-tracker "30.1")
+(define-obsolete-function-alias
+ 'comint-osc-hyperlink-handler 'ansi-osc-hyperlink-handler "30.1")
+(define-obsolete-function-alias
+ 'comint-osc-hyperlink 'ansi-osc-hyperlink "30.1")
+(define-obsolete-variable-alias
+ 'comint-osc-hyperlink-map 'ansi-osc-hyperlink-map "30.1")
(defun comint-osc-process-output (_)
"Interpret OSC escape sequences in comint output.
@@ -3985,7 +3990,7 @@ sequences of the forms
Specifically, every occurrence of such escape sequences is
removed from the buffer. Then, if `command' is a key of the
-`comint-osc-handlers' alist, the corresponding value, which
+`ansi-osc-handlers' alist, the corresponding value, which
should be a function, is called with `command' and `text' as
arguments, with point where the escape sequence was located."
(let ((start (1- comint-last-output-start))
@@ -4043,6 +4048,7 @@ This function signals an error if
`comint-use-prompt-regexp' is
non-nil. Input fontification isn't compatible with this
setting."
:lighter nil
+ :interactive (comint-mode)
(if comint-fontify-input-mode
(let ((success nil))
(unwind-protect
diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index 4e52aa9b151..17d9ca938a8 100644
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -39,6 +39,16 @@
;; example, to M-n and M-p in `completion-preview-active-mode-map' to
;; have them handy whenever the preview is visible.
;;
+;; When the completion candidate that the preview is showing shares a
+;; common prefix with all other candidates, Completion Preview mode
+;; underlines that common prefix. If you want to insert the common
+;; prefix but with a different suffix than the one the preview is
+;; showing, use the command `completion-preview-complete'. This command
+;; inserts just the common prefix and lets you go on typing as usual.
+;; If you invoke `completion-preview-complete' when there is no common
+;; prefix (so nothing is underlined in the preview), it displays a list
+;; of all matching completion candidates.
+;;
;; If you set the user option `completion-preview-exact-match-only' to
;; non-nil, Completion Preview mode only suggests a completion
;; candidate when its the only possible completion for the (partial)
@@ -73,7 +83,8 @@ first candidate, and you can cycle between the candidates with
insert-char
delete-backward-char
backward-delete-char-untabify
- analyze-text-conversion)
+ analyze-text-conversion
+ completion-preview-complete)
"List of commands that should trigger completion preview."
:type '(repeat (function :tag "Command" :value self-insert-command))
:version "30.1")
@@ -104,16 +115,22 @@ If this option is nil, these commands do not display any
message."
(defface completion-preview
'((t :inherit shadow))
- "Face for completion preview overlay."
+ "Face for completion candidates in the completion preview overlay."
:version "30.1")
-(defface completion-preview-exact
+(defface completion-preview-common
'((((supports :underline t))
:underline t :inherit completion-preview)
(((supports :weight bold))
:weight bold :inherit completion-preview)
(t :background "gray"))
- "Face for exact completion preview overlay."
+ "Face for the longest common prefix in the completion preview."
+ :version "30.1")
+
+(defface completion-preview-exact
+ ;; An exact match is also the longest common prefix of all matches.
+ '((t :underline "#00aa00" :inherit completion-preview-common))
+ "Face for matches in the completion preview overlay."
:version "30.1")
(defface completion-preview-highlight
@@ -124,37 +141,56 @@ If this option is nil, these commands do not display any
message."
(defvar-keymap completion-preview-active-mode-map
:doc "Keymap for Completion Preview Active mode."
"C-i" #'completion-preview-insert
+ ;; FIXME: Should this have another/better binding by default?
+ "M-i" #'completion-preview-complete
;; "M-n" #'completion-preview-next-candidate
;; "M-p" #'completion-preview-prev-candidate
)
+(defun completion-preview--ignore ()
+ "Do nothing, including updating the completion preview.
+
+This is the same as `ignore', except that Completion Preview mode skips
+hiding or updating the completion preview after this command runs."
+ (interactive)
+ nil)
+
+(put 'completion-preview--ignore 'completion-predicate #'ignore)
+
(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
- "<wheel-up>" #'completion-preview-prev-candidate
- "<wheel-down>" #'completion-preview-next-candidate)
+ "<mouse-1>" #'completion-preview-insert
+ ;; Ignore the corresponding button-down event.
+ "<down-mouse-1>" #'completion-preview--ignore
+ "C-<mouse-1>" #'completion-preview-complete
+ "C-<down-mouse-1>" #'completion-preview--ignore
+ "<mouse-2>" #'completion-preview-complete
+ "<down-mouse-2>" #'completion-preview--ignore
+ "<wheel-up>" #'completion-preview-prev-candidate
+ "<wheel-down>" #'completion-preview-next-candidate)
(defvar-local completion-preview--overlay nil)
(defvar completion-preview--internal-commands
'(completion-preview-next-candidate
completion-preview-prev-candidate
+ completion-preview--ignore
;; Don't dismiss or update the preview when the user scrolls.
mwheel-scroll)
"List of commands that manipulate the completion preview.
Completion Preview mode avoids updating the preview after these commands.")
-(defsubst completion-preview--internal-command-p ()
- "Return non-nil if `this-command' manipulates the completion preview."
- (memq this-command completion-preview--internal-commands))
+(defvar-local completion-preview--inhibit-update-p nil
+ "Whether to inhibit updating the completion preview following this command.")
+
+(defsubst completion-preview--inhibit-update ()
+ "Inhibit updating the completion preview following this command."
+ (setq completion-preview--inhibit-update-p t))
(defsubst completion-preview-require-certain-commands ()
"Check if `this-command' is one of `completion-preview-commands'."
- (or (completion-preview--internal-command-p)
- (memq this-command completion-preview-commands)))
+ (memq this-command completion-preview-commands))
(defun completion-preview-require-minimum-symbol-length ()
"Check if the length of symbol at point is at least above a certain
threshold.
@@ -167,7 +203,8 @@ Completion Preview mode avoids updating the preview after
these commands.")
"Hide the completion preview."
(when completion-preview--overlay
(delete-overlay completion-preview--overlay)
- (setq completion-preview--overlay nil)))
+ (setq completion-preview--overlay nil
+ completion-preview--inhibit-update-p nil)))
(defun completion-preview--make-overlay (pos string)
"Make preview overlay showing STRING at POS, or move existing preview there."
@@ -175,13 +212,9 @@ Completion Preview mode avoids updating the preview after
these commands.")
(move-overlay completion-preview--overlay pos pos)
(setq completion-preview--overlay (make-overlay pos pos))
(overlay-put completion-preview--overlay 'window (selected-window)))
- (let ((previous (overlay-get completion-preview--overlay 'after-string)))
- (unless (and previous (string= previous string)
- (eq (get-text-property 0 'face previous)
- (get-text-property 0 'face string)))
- (add-text-properties 0 1 '(cursor 1) string)
- (overlay-put completion-preview--overlay 'after-string string))
- completion-preview--overlay))
+ (add-text-properties 0 1 '(cursor 1) string)
+ (overlay-put completion-preview--overlay 'after-string string)
+ completion-preview--overlay)
(defsubst completion-preview--get (prop)
"Return property PROP of the completion preview overlay."
@@ -221,17 +254,25 @@ See also `completion-styles'.")
PROPS is a property list with additional information about TABLE.
See `completion-at-point-functions' for more details.
-If TABLE contains a matching completion, return a list
-\(PREVIEW BEG END ALL BASE EXIT-FN) where PREVIEW is the text to
-show in the completion preview, ALL is the list of all matching
-completion candidates, BASE is a common prefix that TABLE elided
-from the start of each candidate, and EXIT-FN is either a
-function to call after inserting PREVIEW or nil. If TABLE does
-not contain matching completions, or if there are multiple
-matching completions and `completion-preview-exact-match-only' is
-non-nil, return nil instead."
+If TABLE contains a matching candidate, return a list
+\(BASE COMMON SUFFIXES) where BASE is a prefix of the text
+between BEG and END that TABLE elided from the start of each candidate,
+COMMON is the longest common prefix of all matching candidates,
+SUFFIXES is a list of different suffixes that together with COMMON yield
+the matching candidates. If TABLE does not contain matching
+candidates or if there are multiple matching completions and
+`completion-preview-exact-match-only' is non-nil, return nil instead."
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; ;;
+ ;; | buffer text | preview | ;;
+ ;; | | | ;;
+ ;; beg end | ;;
+ ;; |------+------|--+--------| Each of base, common and suffix ;;
+ ;; | base | common | suffix | <- may be empty, except common and ;;
+ ;; suffix cannot both be empty. ;;
+ ;; ;;
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let* ((pred (plist-get props :predicate))
- (exit-fn (plist-get props :exit-function))
(string (buffer-substring beg end))
(md (completion-metadata string table pred))
(sort-fn (or (completion-metadata-get md 'cycle-sort-function)
@@ -250,16 +291,16 @@ non-nil, return nil instead."
(when last
(setcdr last nil)
(when-let ((sorted (funcall sort-fn
- (delete prefix (all-completions prefix
all)))))
- (unless (and (cdr sorted) completion-preview-exact-match-only)
- (list (propertize (substring (car sorted) (length prefix))
- 'face (if (cdr sorted)
- 'completion-preview
- 'completion-preview-exact)
- 'mouse-face 'completion-preview-highlight
- 'keymap completion-preview--mouse-map)
- (+ beg base) end sorted
- (substring string 0 base) exit-fn))))))
+ (delete prefix (all-completions prefix
all))))
+ (common (try-completion prefix sorted))
+ (lencom (length common))
+ (suffixes sorted))
+ (unless (and (cdr suffixes) completion-preview-exact-match-only)
+ ;; Remove the common prefix from each candidate.
+ (while sorted
+ (setcar sorted (substring (car sorted) lencom))
+ (setq sorted (cdr sorted)))
+ (list (substring string 0 base) common suffixes))))))
(defun completion-preview--capf-wrapper (capf)
"Translate return value of CAPF to properties for completion preview
overlay."
@@ -267,25 +308,41 @@ non-nil, return nil instead."
(and (consp res)
(not (functionp res))
(seq-let (beg end table &rest plist) res
- (or (completion-preview--try-table table beg end plist)
+ (or (when-let ((data (completion-preview--try-table
+ table beg end plist)))
+ `(,(+ beg (length (car data))) ,end ,plist ,@data))
(unless (eq 'no (plist-get plist :exclusive))
;; Return non-nil to exclude other capfs.
'(nil)))))))
(defun completion-preview--update ()
"Update completion preview."
- (seq-let (preview beg end all base exit-fn)
+ (seq-let (beg end props base common suffixes)
(run-hook-wrapped
'completion-at-point-functions
#'completion-preview--capf-wrapper)
- (when preview
- (let ((ov (completion-preview--make-overlay end preview)))
+ (when-let ((suffix (car suffixes)))
+ (set-text-properties 0 (length suffix)
+ (list 'face (if (cdr suffixes)
+ 'completion-preview
+ 'completion-preview-exact))
+ suffix)
+ (set-text-properties 0 (length common)
+ (list 'face (if (cdr suffixes)
+ 'completion-preview-common
+ 'completion-preview-exact))
+ common)
+ (let ((ov (completion-preview--make-overlay
+ end (propertize (concat (substring common (- end beg)) suffix)
+ 'mouse-face 'completion-preview-highlight
+ 'keymap completion-preview--mouse-map))))
(overlay-put ov 'completion-preview-beg beg)
(overlay-put ov 'completion-preview-end end)
(overlay-put ov 'completion-preview-index 0)
- (overlay-put ov 'completion-preview-cands all)
+ (overlay-put ov 'completion-preview-suffixes suffixes)
+ (overlay-put ov 'completion-preview-common common)
(overlay-put ov 'completion-preview-base base)
- (overlay-put ov 'completion-preview-exit-fn exit-fn)
+ (overlay-put ov 'completion-preview-props props)
(completion-preview-active-mode)))))
(defun completion-preview--show ()
@@ -308,17 +365,22 @@ point, otherwise hide it."
;; 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))
+ (sufs (completion-preview--get 'completion-preview-suffixes))
(index (completion-preview--get 'completion-preview-index))
- (cand (nth index cands))
- (after (completion-preview--get 'after-string))
- (face (get-text-property 0 'face after)))
+ (common (completion-preview--get 'completion-preview-common))
+ (suffix (nth index sufs))
+ (cand nil))
+ (set-text-properties 0 (length suffix)
+ (list 'face (if (cdr sufs)
+ 'completion-preview
+ 'completion-preview-exact))
+ suffix)
+ (setq cand (concat common (nth index sufs)))
(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
end (propertize (substring cand (- end beg))
- 'face face
'mouse-face
'completion-preview-highlight
'keymap completion-preview--mouse-map))
'completion-preview-end end)
@@ -329,16 +391,18 @@ point, otherwise hide it."
(defun completion-preview--post-command ()
"Create, update or delete completion preview post last command."
- (if (and (completion-preview-require-certain-commands)
- (completion-preview-require-minimum-symbol-length))
- ;; We should show the preview.
- (or
- ;; If we're called after a command that itself updates the
- ;; preview, don't do anything.
- (completion-preview--internal-command-p)
- ;; Otherwise, show the preview.
- (completion-preview--show))
- (completion-preview-active-mode -1)))
+ (let ((internal-p (or completion-preview--inhibit-update-p
+ (memq this-command
+ completion-preview--internal-commands))))
+ (setq completion-preview--inhibit-update-p nil)
+
+ ;; If we're called after a command that itself updates the
+ ;; preview, don't do anything.
+ (unless internal-p
+ (if (and (completion-preview-require-certain-commands)
+ (completion-preview-require-minimum-symbol-length))
+ (completion-preview--show)
+ (completion-preview-active-mode -1)))))
(defun completion-preview-insert ()
"Insert the completion candidate that the preview is showing."
@@ -347,43 +411,124 @@ point, otherwise hide it."
(let* ((pre (completion-preview--get 'completion-preview-base))
(end (completion-preview--get 'completion-preview-end))
(ind (completion-preview--get 'completion-preview-index))
- (all (completion-preview--get 'completion-preview-cands))
- (efn (completion-preview--get 'completion-preview-exit-fn))
+ (all (completion-preview--get 'completion-preview-suffixes))
+ (com (completion-preview--get 'completion-preview-common))
+ (efn (plist-get (completion-preview--get
'completion-preview-props)
+ :exit-function))
(aft (completion-preview--get 'after-string))
- (str (concat pre (nth ind all))))
+ (str (concat pre com (nth ind all))))
(completion-preview-active-mode -1)
(goto-char end)
(insert (substring-no-properties aft))
(when (functionp efn) (funcall efn str 'finished)))
(user-error "No current completion preview")))
-(defun completion-preview-prev-candidate ()
- "Cycle the candidate that the preview is showing to the previous suggestion."
+(defun completion-preview-complete ()
+ "Complete up to the longest common prefix of all completion candidates.
+
+If you call this command twice in a row, or otherwise if there is no
+common prefix to insert, it displays the list of matching completion
+candidates unless `completion-auto-help' is nil. If you repeat this
+command again when the completions list is visible, it scrolls the
+completions list."
(interactive)
- (completion-preview-next-candidate -1))
+ (unless completion-preview-active-mode
+ (user-error "No current completion preview"))
+ (let* ((beg (completion-preview--get 'completion-preview-beg))
+ (end (completion-preview--get 'completion-preview-end))
+ (com (completion-preview--get 'completion-preview-common))
+ (cur (completion-preview--get 'completion-preview-index))
+ (all (completion-preview--get 'completion-preview-suffixes))
+ (base (completion-preview--get 'completion-preview-base))
+ (props (completion-preview--get 'completion-preview-props))
+ (efn (plist-get props :exit-function))
+ (ins (substring-no-properties com (- end beg))))
+ (goto-char end)
+ (if (string-empty-p ins)
+ ;; If there's nothing to insert, call `completion-at-point' to
+ ;; show the completions list (or just display a message when
+ ;; `completion-auto-help' is nil).
+ (let* ((completion-styles completion-preview-completion-styles)
+ (sub (substring-no-properties com))
+ (col (mapcar (lambda (suf)
+ (concat sub (substring-no-properties suf)))
+ (append (nthcdr cur all) (take cur all))))
+ ;; The candidates are already in order.
+ (props (plist-put props :display-sort-function #'identity))
+ ;; The :exit-function might be slow, e.g. when the
+ ;; backend is Eglot, so we ensure that the preview is
+ ;; hidden before any original :exit-function is called.
+ (props (plist-put props :exit-function
+ (when (functionp efn)
+ (lambda (string status)
+ (completion-preview-active-mode -1)
+ (funcall efn string status)))))
+ ;; The predicate is meant for the original completion
+ ;; candidates, which may be symbols or cons cells, but
+ ;; now we only have strings, so it might be unapplicable.
+ (props (plist-put props :predicate nil))
+ (completion-at-point-functions
+ (list (lambda () `(,beg ,end ,col ,@props)))))
+ (completion-preview--inhibit-update)
+ (completion-at-point))
+ ;; Otherwise, insert the common prefix and update the preview.
+ (insert ins)
+ (let ((suf (nth cur all))
+ (pos (point)))
+ (if (or (string-empty-p suf) (null suf))
+ ;; If we've inserted a full candidate, let the post-command
+ ;; hook update the completion preview in case the candidate
+ ;; can be completed further.
+ (when (functionp efn)
+ (funcall efn (concat base com) (if (cdr all) 'exact 'finished)))
+ ;; Otherwise, remove the common prefix from the preview.
+ (completion-preview--inhibit-update)
+ (overlay-put (completion-preview--make-overlay
+ pos (propertize
+ suf 'mouse-face 'completion-preview-highlight
+ 'keymap completion-preview--mouse-map))
+ 'completion-preview-end pos))))))
+
+(defun completion-preview-prev-candidate (n)
+ "Cycle the candidate the preview is showing N candidates backward.
+
+If N is negative, cycle -N candidates forward. Interactively, N is the
+prefix argument and defaults to 1."
+ (interactive "p")
+ (completion-preview-next-candidate (- n)))
-(defun completion-preview-next-candidate (direction)
- "Cycle the candidate that the preview is showing in direction DIRECTION.
+(defun completion-preview-next-candidate (n)
+ "Cycle the candidate the preview is showing N candidates forward.
-DIRECTION should be either 1 which means cycle forward, or -1
-which means cycle backward. Interactively, DIRECTION is the
+If N is negative, cycle -N candidates backward. Interactively, N is the
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))
+ (all (completion-preview--get 'completion-preview-suffixes))
+ (com (completion-preview--get 'completion-preview-common))
(cur (completion-preview--get 'completion-preview-index))
(len (length all))
- (new (mod (+ cur direction) len))
- (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 (- end beg))
- 'face (if (< 1 len)
- 'completion-preview
- 'completion-preview-exact)
+ (new (mod (+ cur n) len))
+ (suf (nth new all))
+ (lencom (length com)))
+ ;; Skip suffixes that are no longer applicable. This may happen
+ ;; when the user continues typing and immediately runs this
+ ;; command, before the completion backend returns an updated set
+ ;; of completions for the new (longer) prefix, so we still have
+ ;; the previous (larger) set of candidates at hand.
+ (while (or (<= (+ beg lencom (length suf)) end)
+ (not (string-prefix-p (buffer-substring beg end)
+ (concat com suf))))
+ (setq new (mod (+ new n) len)
+ suf (nth new all)))
+ (set-text-properties 0 (length suf)
+ (list 'face (if (cdr all)
+ 'completion-preview
+ 'completion-preview-exact))
+ suf)
+ (let ((aft (propertize (substring (concat com suf) (- end beg))
'mouse-face 'completion-preview-highlight
'keymap completion-preview--mouse-map)))
(add-text-properties 0 1 '(cursor 1) aft)
@@ -398,6 +543,7 @@ prefix argument and defaults to 1."
(buffer-local-value 'completion-preview-active-mode buffer))
(dolist (cmd '(completion-preview-insert
+ completion-preview-complete
completion-preview-prev-candidate
completion-preview-next-candidate))
(put cmd 'completion-predicate #'completion-preview--active-p))
@@ -409,11 +555,12 @@ prefix argument and defaults to 1."
This mode automatically shows and updates the completion preview
according to the text around point.
\\<completion-preview-active-mode-map>\
-When the preview is visible, \\[completion-preview-insert]
-accepts the completion suggestion,
+When the preview is visible, \\[completion-preview-insert] accepts the
+completion suggestion, \\[completion-preview-complete] completes up to
+the longest common prefix of all completion candidates,
\\[completion-preview-next-candidate] cycles forward to the next
-completion suggestion, and \\[completion-preview-prev-candidate]
-cycles backward."
+completion suggestion, and \\[completion-preview-prev-candidate] cycles
+backward."
:lighter " CP"
(if completion-preview-mode
(add-hook 'post-command-hook #'completion-preview--post-command nil t)
@@ -423,7 +570,18 @@ cycles backward."
;;;###autoload
(define-globalized-minor-mode global-completion-preview-mode
completion-preview-mode completion-preview-mode
- :predicate '((not minibuffer-mode special-mode) t))
+ :predicate '((not archive-mode
+ calc-mode
+ compilation-mode
+ diff-mode
+ dired-mode
+ image-mode
+ minibuffer-mode
+ minibuffer-inactive-mode
+ org-agenda-mode
+ special-mode
+ wdired-mode)
+ t))
(provide 'completion-preview)
;;; completion-preview.el ends here
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index f004002333b..19449afbd2b 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -2251,24 +2251,33 @@ and `face'."
;;; The `custom' Widget.
(defface custom-button
- '((((type x w32 ns haiku pgtk android) (class color)) ; Like default
mode line
+ '((((type x w32 ns haiku pgtk android) (class color)
+ (min-colors 88)) ; Like default mode line
:box (:line-width 2 :style released-button)
- :background "lightgrey" :foreground "black"))
+ :background "lightgrey" :foreground "black")
+ (((type x w32 ns haiku pgtk android))
+ :box (:line-width 2 :style released-button)
+ :background "white" :foreground "black"))
"Face for custom buffer buttons if `custom-raised-buttons' is non-nil."
- :version "21.1"
+ :version "30.1"
:group 'custom-faces)
(defface custom-button-mouse
- '((((type x w32 ns haiku pgtk android) (class color))
+ '((((type x w32 ns haiku pgtk android) (class color)
+ (min-colors 88))
:box (:line-width 2 :style released-button)
:background "grey90" :foreground "black")
+ (((type x w32 ns haiku pgtk android))
+ :box (:line-width 2 :style released-button)
+ ;; Either light gray or a stipple pattern.
+ :background "gray20" :foreground "black")
(t
;; This is for text terminals that support mouse, like GPM mouse
;; or the MS-DOS terminal: inverse-video makes the button stand
;; out on mouse-over.
:inverse-video t))
"Mouse face for custom buffer buttons if `custom-raised-buttons' is non-nil."
- :version "22.1"
+ :version "30.1"
:group 'custom-faces)
(defface custom-button-unraised
@@ -2284,12 +2293,16 @@ and `face'."
(if custom-raised-buttons 'custom-button-mouse 'highlight))
(defface custom-button-pressed
- '((((type x w32 ns haiku pgtk android) (class color))
+ '((((type x w32 ns haiku pgtk android) (class color grayscale))
:box (:line-width 2 :style pressed-button)
:background "lightgrey" :foreground "black")
+ (((type x w32 ns haiku pgtk android))
+ :box (:line-width 2 :style pressed-button)
+ ;; Either light gray or a stipple pattern.
+ :background "gray20" :foreground "black")
(t :inverse-video t))
"Face for pressed custom buttons if `custom-raised-buttons' is non-nil."
- :version "21.1"
+ :version "30.1"
:group 'custom-faces)
(defface custom-button-pressed-unraised
@@ -4957,10 +4970,17 @@ if only the first line of the docstring is shown."))
;; can cause problems when read back, so print them
;; readably. (Bug#52554)
(print-escape-control-characters t))
- (atomic-change-group
- (custom-save-variables)
- (custom-save-faces)
- (custom-save-icons)))
+ ;; Insert lexical cookie, but only if the buffer is empty.
+ (save-restriction
+ (widen)
+ (atomic-change-group
+ (when (eq (point-min) (point-max))
+ (save-excursion
+ (goto-char (point-min))
+ (insert ";;; -*- lexical-binding: t -*-\n")))
+ (custom-save-variables)
+ (custom-save-faces)
+ (custom-save-icons))))
(let ((file-precious-flag t))
(save-buffer))
(if old-buffer
@@ -5350,6 +5370,12 @@ If several parents are listed, go to the first of them."
(setq-local widget-link-suffix ""))
(setq show-trailing-whitespace nil))
+(defvar touch-screen-keyboard-function) ; In touch-screen.el.
+
+(defun Custom-display-on-screen-keyboard-p ()
+ "Return whether it is okay to display the virtual keyboard at point."
+ (get-char-property (point) 'field))
+
(define-derived-mode Custom-mode nil "Custom"
"Major mode for editing customization buffers.
@@ -5387,6 +5413,9 @@ if that value is non-nil."
(setq-local custom--invocation-options nil
custom--hidden-state 'hidden)
(setq-local revert-buffer-function #'custom--revert-buffer)
+ (setq-local text-conversion-style 'action)
+ (setq-local touch-screen-keyboard-function
+ #'Custom-display-on-screen-keyboard-p)
(make-local-variable 'custom-options)
(make-local-variable 'custom-local-buffer)
(custom--initialize-widget-variables)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 47afa841f5e..d0a1a66e29f 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -141,7 +141,10 @@
(const :format "" :value :style)
(choice :tag "Style"
(const :tag "Line" line)
- (const :tag "Wave" wave))
+ (const :tag "Double line" double-line)
+ (const :tag "Wave" wave)
+ (const :tag "Dots" dots)
+ (const :tag "Dashes" dashes))
(const :format "" :value :position)
(choice :tag "Position"
(const :tag "At Default Position" nil)
diff --git a/lisp/custom.el b/lisp/custom.el
index a19b14aaf8a..c049e8f8be0 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -667,7 +667,8 @@ If NOSET is non-nil, don't bother autoloading LOAD when
setting the variable."
A customizable variable is either (i) a variable whose property
list contains a non-nil `standard-value' or `custom-autoload'
property, or (ii) an alias for another customizable variable."
- (declare (side-effect-free t))
+ (declare (ftype (function (symbol) t))
+ (side-effect-free t))
(when (symbolp variable)
(setq variable (indirect-variable variable))
(or (get variable 'standard-value)
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
index 853c0f4b290..7b6cbb78cef 100644
--- a/lisp/dabbrev.el
+++ b/lisp/dabbrev.el
@@ -495,7 +495,7 @@ See also `dabbrev-abbrev-char-regexp' and
\\[dabbrev-completion]."
(save-excursion
(save-restriction
(widen)
- (if dabbrev--last-buffer
+ (if (buffer-live-p dabbrev--last-buffer)
(set-buffer dabbrev--last-buffer))
;; Find the end of the last "expansion" word.
(if (or (eq dabbrev--last-direction 1)
@@ -557,7 +557,8 @@ See also `dabbrev-abbrev-char-regexp' and
\\[dabbrev-completion]."
(setq dabbrev--last-buffer-found dabbrev--last-buffer))
(message nil))
(if (and (or (eq (current-buffer) dabbrev--last-buffer)
- (null dabbrev--last-buffer))
+ (null dabbrev--last-buffer)
+ (buffer-live-p dabbrev--last-buffer))
(numberp dabbrev--last-expansion-location)
(and (> dabbrev--last-expansion-location (point))))
(setq dabbrev--last-expansion-location
@@ -731,7 +732,7 @@ of the start of the occurrence."
(save-excursion
;; If we were scanning something other than the current buffer,
;; continue scanning there.
- (when dabbrev--last-buffer
+ (when (buffer-live-p dabbrev--last-buffer)
(set-buffer dabbrev--last-buffer))
(or
;; ------------------------------------------
@@ -748,7 +749,7 @@ of the start of the occurrence."
;; or whatever buffer we were last scanning.
;; ------------------------------------------
(and (or (not dabbrev-search-these-buffers-only)
- dabbrev--last-buffer)
+ (buffer-live-p dabbrev--last-buffer))
(<= direction 0)
(setq dabbrev--last-direction -1)
(dabbrev--try-find abbrev nil
@@ -760,7 +761,7 @@ of the start of the occurrence."
;; ------------------------------------------
(progn
(setq dabbrev--last-direction -1)
- (unless dabbrev--last-buffer
+ (unless (buffer-live-p dabbrev--last-buffer)
;; If we have just now begun to search other buffers,
;; determine which other buffers we should check.
;; Put that list in dabbrev--friend-buffer-list.
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index a2ce3083cfe..ddacd2600d0 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -658,10 +658,13 @@ values, passed as the seventh arg to `completing-read'.
Optional arg COLLECTION is a collection of possible completions,
passed as the second arg to `completing-read'."
- (dired-mark-pop-up nil op-symbol files
- 'completing-read
- (format prompt (dired-mark-prompt arg files))
- collection nil nil initial nil default-value nil))
+ (apply #'dired-mark-pop-up
+ nil op-symbol files
+ (if (eq op-symbol 'touch) 'read-from-minibuffer 'completing-read)
+ (format prompt (dired-mark-prompt arg files))
+ (if (eq op-symbol 'touch)
+ `(,initial nil nil nil ,default-value)
+ `(,collection nil nil ,initial nil ,default-value nil))))
;;; Cleaning a directory: flagging some backups for deletion
@@ -865,8 +868,8 @@ In a noninteractive call (from Lisp code), you must specify
the list of file names explicitly with the FILE-LIST argument, which
can be produced by `dired-get-marked-files', for example.
-`dired-guess-shell-alist-default' and
-`dired-guess-shell-alist-user' are consulted when the user is
+`dired-guess-shell-alist-default', `dired-guess-shell-alist-optional'
+and `dired-guess-shell-alist-user' are consulted when the user is
prompted for the shell command to use interactively.
Also see the `dired-confirm-shell-command' variable."
@@ -1065,8 +1068,8 @@ Return the result of `process-file' - zero for success."
;; * `dired-guess-shell-command' calls `dired-guess-default' with list of
;; marked files.
;;
-;; * Parse `dired-guess-shell-alist-user' and
-;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP
+;; * Parse `dired-guess-shell-alist-user', `dired-guess-shell-alist-default',
+;; `dired-guess-shell-alist-optional' (in that order) for the first REGEXP
;; that matches the first file in the file list.
;;
;; * If the REGEXP matches all the entries of the file list then evaluate
@@ -1216,28 +1219,10 @@ Return the result of `process-file' - zero for success."
" " dired-guess-shell-znew-switches))
'("\\.pod\\'" "perldoc" "pod2man * | nroff -man")
- '("\\.dvi\\'" "xdvi" "dvips") ; preview and printing
- '("\\.au\\'" "play") ; play Sun audiofiles
- '("\\.mpe?g\\'\\|\\.avi\\'" "xine -p")
- '("\\.ogg\\'" "ogg123")
- '("\\.mp3\\'" "mpg123")
- '("\\.wav\\'" "play")
'("\\.uu\\'" "uudecode") ; for uudecoded files
- '("\\.hqx\\'" "mcvert")
'("\\.sh\\'" "sh") ; execute shell scripts
- '("\\.xbm\\'" "bitmap") ; view X11 bitmaps
- '("\\.gp\\'" "gnuplot")
- '("\\.p[bgpn]m\\'" "xloadimage")
- '("\\.gif\\'" "xloadimage") ; view gif pictures
- '("\\.tif\\'" "xloadimage")
- '("\\.png\\'" "display") ; xloadimage 4.1 doesn't grok PNG
- '("\\.jpe?g\\'" "xloadimage")
- '("\\.fig\\'" "xfig") ; edit fig pictures
- '("\\.out\\'" "xgraph") ; for plotting purposes.
'("\\.tex\\'" "latex" "tex")
'("\\.texi\\(nfo\\)?\\'" "makeinfo" "texi2dvi")
- '("\\.pdf\\'" "xpdf")
- '("\\.doc\\'" "antiword" "strings")
'("\\.rpm\\'" "rpm -qilp" "rpm -ivh")
'("\\.dia\\'" "dia")
'("\\.mgp\\'" "mgp")
@@ -1266,7 +1251,37 @@ Return the result of `process-file' - zero for success."
'("\\.sign?\\'" "gpg --verify"))
"Default alist used for shell command guessing.
-See `dired-guess-shell-alist-user'.")
+See also `dired-guess-shell-alist-optional' and
+`dired-guess-shell-alist-user'.")
+
+(defvar dired-guess-shell-alist-optional
+ (list
+ '("\\.dvi\\'" "xdvi" "dvips") ; preview and printing
+ '("\\.au\\'" "play") ; play Sun audiofiles
+ '("\\.mpe?g\\'\\|\\.avi\\'" "xine -p")
+ '("\\.ogg\\'" "ogg123")
+ '("\\.mp3\\'" "mpg123")
+ '("\\.wav\\'" "play")
+ '("\\.hqx\\'" "mcvert")
+ '("\\.xbm\\'" "bitmap") ; view X11 bitmaps
+ '("\\.gp\\'" "gnuplot")
+ '("\\.p[bgpn]m\\'" "xloadimage")
+ '("\\.gif\\'" "xloadimage") ; view gif pictures
+ '("\\.tif\\'" "xloadimage")
+ '("\\.png\\'" "display") ; xloadimage 4.1 doesn't grok PNG
+ '("\\.jpe?g\\'" "xloadimage")
+ '("\\.fig\\'" "xfig") ; edit fig pictures
+ '("\\.out\\'" "xgraph") ; for plotting purposes.
+ '("\\.pdf\\'" "xpdf")
+ '("\\.doc\\'" "antiword" "strings"))
+ "Optional alist used for shell command guessing.
+Unlike `dired-guess-shell-alist-default' that contains mostly the
+standard commands that handle the files with corresponding extensions
+such as the `tar' command handling the files with the `.tar' extension,
+this list contains the commands such as media players and viewers
+that don't exist on many systems where other alternatives are available.
+
+See also `dired-guess-shell-alist-user'.")
(defun dired-guess-default (files)
"Return a shell command, or a list of commands, appropriate for FILES.
@@ -1286,7 +1301,8 @@ See `dired-guess-shell-alist-user'."
(string-match-p (car elem) file))
files))
(append dired-guess-shell-alist-user
- dired-guess-shell-alist-default)))
+ dired-guess-shell-alist-default
+ dired-guess-shell-alist-optional)))
nil)))))
(if (length= programs 1)
(car programs)
@@ -1320,13 +1336,21 @@ See `dired-guess-shell-alist-user'."
(if (equal val "") default val))))
(defcustom shell-command-guess-functions
- '(shell-command-guess-dired)
+ '(shell-command-guess-dired-optional
+ shell-command-guess-mailcap
+ shell-command-guess-xdg
+ shell-command-guess-dired-default
+ shell-command-guess-dired-user)
"List of functions that guess shell commands for files.
Each function receives a list of commands and a list of file names
and should return the same list of commands with changes
-such as added new commands."
+such as new commands added to the beginning of the list.
+In this case the commands from the last entry
+will be at the top of the resulted list."
:type '(repeat
- (choice (function-item shell-command-guess-dired)
+ (choice (function-item shell-command-guess-dired-user)
+ (function-item shell-command-guess-dired-default)
+ (function-item shell-command-guess-dired-optional)
(function-item shell-command-guess-mailcap)
(function-item shell-command-guess-xdg)
(function-item shell-command-guess-open)
@@ -1347,9 +1371,29 @@ after adding own commands to the composite list."
nil))
commands))
-(defun shell-command-guess-dired (commands files)
- "Populate COMMANDS using `dired-guess-default'."
- (append (ensure-list (dired-guess-default files)) commands))
+(defun shell-command-guess-dired-user (commands files)
+ "Populate COMMANDS using `dired-guess-shell-alist-user'.
+This excludes `dired-guess-shell-alist-default' and
+`dired-guess-shell-alist-optional'."
+ (let ((dired-guess-shell-alist-default nil)
+ (dired-guess-shell-alist-optional nil))
+ (append (ensure-list (dired-guess-default files)) commands)))
+
+(defun shell-command-guess-dired-default (commands files)
+ "Populate COMMANDS using `dired-guess-shell-alist-default'.
+This excludes `dired-guess-shell-alist-user' and
+`dired-guess-shell-alist-optional'."
+ (let ((dired-guess-shell-alist-user nil)
+ (dired-guess-shell-alist-optional nil))
+ (append (ensure-list (dired-guess-default files)) commands)))
+
+(defun shell-command-guess-dired-optional (commands files)
+ "Populate COMMANDS using `dired-guess-shell-alist-optional'.
+This excludes `dired-guess-shell-alist-user' and
+`dired-guess-shell-alist-default'."
+ (let ((dired-guess-shell-alist-user nil)
+ (dired-guess-shell-alist-default nil))
+ (append (ensure-list (dired-guess-default files)) commands)))
(declare-function mailcap-file-default-commands "mailcap" (files))
@@ -1404,6 +1448,7 @@ after adding own commands to the composite list."
(declare-function w32-shell-execute "w32fns.c")
+;;;###autoload
(defun dired-do-open (&optional arg)
"Open all marked (or next ARG) files using an external program.
This \"opens\" the file(s) using the external command that is most
@@ -1519,14 +1564,23 @@ A FMT of \"\" will suppress the messaging."
;; Remove any preexisting entry for the name NEW-FILE.
(ignore-errors (dired-remove-entry new-file))
(goto-char start)
- ;; Now replace the current line with an entry for NEW-FILE.
- ;; But don't remove the current line if either FROM-FILE or
- ;; NEW-FILE is a directory, because compressing/uncompressing
- ;; directories doesn't remove the original.
- (if (or (file-directory-p from-file)
- (file-directory-p new-file))
- (dired-add-entry new-file nil t)
- (dired-update-file-line new-file))
+ ;; Now replace the current line with an entry for NEW-FILE,
+ ;; if it exists. But don't remove the current line if
+ ;; either FROM-FILE or NEW-FILE is a directory, because
+ ;; compressing/uncompressing directories doesn't remove the
+ ;; original. If NEW-FILE doesn't exist, assume that we are
+ ;; out of sync with the current directory, and revert it.
+ ;; This can happen, for example, when unpacking a .tar.gz
+ ;; archive which adds files to the current directory (as
+ ;; opposed to adding them to a directory whose name is
+ ;; NEW-FILE).
+ (if (file-exists-p new-file)
+ (if (or (file-directory-p from-file)
+ (file-directory-p new-file))
+ (dired-add-entry new-file nil t)
+ (dired-update-file-line new-file))
+ (dired-fun-in-all-buffers (dired-current-directory)
+ nil #'revert-buffer))
nil)
(dired-log (concat "Failed to (un)compress " from-file))
from-file)))
@@ -3797,13 +3851,13 @@ REGEXP should use constructs supported by your local
`grep' command."
(interactive "sSearch marked files (regexp): " dired-mode)
(require 'grep)
(require 'xref)
- (defvar grep-find-ignored-files)
(declare-function rgrep-find-ignored-directories "grep" (dir))
+ (declare-function grep-find-ignored-files "grep" (dir))
(let* ((marks (dired-get-marked-files nil nil nil nil t))
(ignores (nconc (mapcar
#'file-name-as-directory
(rgrep-find-ignored-directories default-directory))
- grep-find-ignored-files))
+ (grep-find-ignored-files default-directory)))
(fetcher
(lambda ()
(let (files xrefs)
diff --git a/lisp/dired.el b/lisp/dired.el
index 28ec187e666..f2a75df6ef1 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -443,8 +443,9 @@ is anywhere on its Dired line, except the beginning of the
line."
(defcustom dired-guess-shell-alist-user nil
"User-defined alist of rules for suggested commands.
-These rules take precedence over the predefined rules in the variable
-`dired-guess-shell-alist-default' (to which they are prepended).
+These rules take precedence over the predefined rules in the variables
+`dired-guess-shell-alist-default' and `dired-guess-shell-alist-optional'
+\(to which they are prepended).
Each element of this list looks like
@@ -2275,9 +2276,10 @@ Do so according to the former subdir alist
OLD-SUBDIR-ALIST."
"~" #'dired-flag-backup-files
;; Upper case keys (except !) for operating on the marked files
"A" #'dired-do-find-regexp
- "C" #'dired-do-copy
"B" #'dired-do-byte-compile
+ "C" #'dired-do-copy
"D" #'dired-do-delete
+ "E" #'dired-do-open
"G" #'dired-do-chgrp
"H" #'dired-do-hardlink
"I" #'dired-do-info
@@ -2482,7 +2484,9 @@ Do so according to the former subdir alist
OLD-SUBDIR-ALIST."
["Display Image" image-dired-dired-display-image
:help "Display sized image in a separate window"]
["Display Image Externally" image-dired-dired-display-external
- :help "Display image in external viewer"]))
+ :help "Display image in external viewer"]
+ ["Display Externally" dired-do-open
+ :help "Display file in external viewer"]))
(easy-menu-define dired-mode-regexp-menu dired-mode-map
"Regexp menu for Dired mode."
@@ -2642,7 +2646,7 @@ Do so according to the former subdir alist
OLD-SUBDIR-ALIST."
:help "Edit file at mouse click in other window"]
,@(when shell-command-guess-open
'(["Open" dired-do-open
- :help "Open externally"]))
+ :help "Open this file with the default application"]))
,@(when commands
(list (cons "Open With"
(append
@@ -2653,7 +2657,13 @@ Do so according to the former subdir alist
OLD-SUBDIR-ALIST."
(interactive)
(dired-do-async-shell-command
,command nil (list ,filename)))])
- commands)))))))
+ commands)))))
+ ,@(when (eq system-type 'windows-nt)
+ `(["Select system app"
+ (lambda ()
+ (interactive)
+ (w32-shell-execute "openas" ,filename))
+ :help "Choose one of the apps available on your system"]))))
(dolist (item (reverse (lookup-key easy-menu [menu-bar immediate])))
(when (consp item)
(define-key menu (vector (car item)) (cdr item))))))
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 1fc1ab45b84..411f0d5774c 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -151,8 +151,13 @@ Windows."
(with-selected-window window
(scroll-down 1))))))))
(when dnd-indicate-insertion-point
- (ignore-errors
- (goto-char (posn-point posn)))))))
+ (let ((pos (posn-point posn)))
+ ;; We avoid errors here, since on some systems this runs
+ ;; when waiting_for_input is non-zero, and that aborts on
+ ;; error.
+ (if (and pos (<= (point-min) pos (point-max)))
+ (goto-char pos)
+ pos))))))
(defun dnd-handle-one-url (window action url)
"Handle one dropped url by calling the appropriate handler.
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index c4b384c35c6..4ae9a5e6629 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -2092,35 +2092,35 @@ GOTO-PAGE-FN other than `doc-view-goto-page'."
(defun doc-view-set-doc-type ()
"Figure out the current document type (`doc-view-doc-type')."
(let ((name-types
- (when buffer-file-name
- (cdr (assoc-string
- (file-name-extension buffer-file-name)
- '(
- ;; DVI
- ("dvi" dvi)
- ;; PDF
- ("pdf" pdf) ("epdf" pdf)
- ;; EPUB
- ("epub" epub)
- ;; PostScript
- ("ps" ps) ("eps" ps)
- ;; DjVu
- ("djvu" djvu)
- ;; OpenDocument formats.
- ("odt" odf) ("ods" odf) ("odp" odf) ("odg" odf)
- ("odc" odf) ("odi" odf) ("odm" odf) ("ott" odf)
- ("ots" odf) ("otp" odf) ("otg" odf)
- ;; Microsoft Office formats (also handled by the odf
- ;; conversion chain).
- ("doc" odf) ("docx" odf) ("xls" odf) ("xlsx" odf)
- ("ppt" odf) ("pps" odf) ("pptx" odf) ("rtf" odf)
- ;; CBZ
- ("cbz" cbz)
- ;; FB2
- ("fb2" fb2)
- ;; (Open)XPS
- ("xps" xps) ("oxps" oxps))
- t))))
+ (cdr (assoc-string
+ (file-name-extension
+ (or buffer-file-name (buffer-name (current-buffer))))
+ '(
+ ;; DVI
+ ("dvi" dvi)
+ ;; PDF
+ ("pdf" pdf) ("epdf" pdf)
+ ;; EPUB
+ ("epub" epub)
+ ;; PostScript
+ ("ps" ps) ("eps" ps)
+ ;; DjVu
+ ("djvu" djvu)
+ ;; OpenDocument formats.
+ ("odt" odf) ("ods" odf) ("odp" odf) ("odg" odf)
+ ("odc" odf) ("odi" odf) ("odm" odf) ("ott" odf)
+ ("ots" odf) ("otp" odf) ("otg" odf)
+ ;; Microsoft Office formats (also handled by the odf
+ ;; conversion chain).
+ ("doc" odf) ("docx" odf) ("xls" odf) ("xlsx" odf)
+ ("ppt" odf) ("pps" odf) ("pptx" odf) ("rtf" odf)
+ ;; CBZ
+ ("cbz" cbz)
+ ;; FB2
+ ("fb2" fb2)
+ ;; (Open)XPS
+ ("xps" xps) ("oxps" oxps))
+ t)))
(content-types
(save-excursion
(goto-char (point-min))
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index e47e2662afa..120972d6cd8 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -678,12 +678,10 @@ characters with appropriate settings of `print-level' and
(defun backtrace--print-to-string (sexp &optional limit)
;; This is for use by callers who wrap the call with
;; backtrace--with-output-variables.
- (setq limit (or limit backtrace-line-length))
- (with-temp-buffer
- (insert (cl-print-to-string-with-limit #'backtrace--print sexp limit))
- ;; Add a unique backtrace-form property.
- (put-text-property (point-min) (point) 'backtrace-form (gensym))
- (buffer-string)))
+ (propertize (cl-print-to-string-with-limit #'backtrace--print sexp
+ (or limit backtrace-line-length))
+ ;; Add a unique backtrace-form property.
+ 'backtrace-form (gensym)))
(defun backtrace-print-frame (frame view)
"Insert a backtrace FRAME at point formatted according to VIEW.
@@ -722,9 +720,10 @@ Format it according to VIEW."
(def (find-function-advised-original fun))
(fun-file (or (symbol-file fun 'defun)
(and (subrp def)
- (not (eq 'unevalled (cdr (subr-arity def))))
+ (not (special-form-p def))
(find-lisp-object-file-name fun def))))
- (fun-pt (point)))
+ (fun-beg (point))
+ (fun-end nil))
(cond
((and evald (not debugger-stack-frame-as-list))
(if (atom fun)
@@ -734,6 +733,7 @@ Format it according to VIEW."
fun
(when (and args (backtrace--line-length-or-nil))
(/ backtrace-line-length 2)))))
+ (setq fun-end (point))
(if args
(insert (backtrace--print-to-string
args
@@ -749,10 +749,16 @@ Format it according to VIEW."
(t
(let ((fun-and-args (cons fun args)))
(insert (backtrace--print-to-string fun-and-args)))
- (cl-incf fun-pt)))
+ ;; Skip the open-paren.
+ (cl-incf fun-beg)))
(when fun-file
- (make-text-button fun-pt (+ fun-pt
- (length (backtrace--print-to-string fun)))
+ (make-text-button fun-beg
+ (or fun-end
+ (+ fun-beg
+ ;; FIXME: `backtrace--print-to-string' will
+ ;; not necessarily print FUN in the same way
+ ;; as it did when it was in FUN-AND-ARGS!
+ (length (backtrace--print-to-string fun))))
:type 'help-function-def
'help-args (list fun fun-file)))
;; After any frame that uses eval-buffer, insert a comment that
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index ea163723a3e..4095726d276 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -164,7 +164,7 @@ Earlier variables shadow later ones with the same name.")
;; The byte-code will be really inlined in byte-compile-unfold-bcf.
(byte-compile--check-arity-bytecode form fn)
`(,fn ,@(cdr form)))
- ((or `(lambda . ,_) `(closure . ,_))
+ ((pred interpreted-function-p)
;; While byte-compile-unfold-bcf can inline dynbind byte-code into
;; letbind byte-code (or any other combination for that matter), we
;; can only inline dynbind source into dynbind source or lexbind
@@ -1512,13 +1512,15 @@ See Info node `(elisp) Integer Basics'."
(put 'nthcdr 'byte-optimizer #'byte-optimize-nthcdr)
(defun byte-optimize-nthcdr (form)
(if (= (safe-length form) 3)
- (if (memq (nth 1 form) '(0 1 2))
- (let ((count (nth 1 form)))
- (setq form (nth 2 form))
- (while (>= (setq count (1- count)) 0)
- (setq form (list 'cdr form)))
- form)
- form)
+ (let ((count (nth 1 form)))
+ (cond ((and (integerp count) (<= count 3))
+ (setq form (nth 2 form))
+ (while (>= (setq count (1- count)) 0)
+ (setq form (list 'cdr form)))
+ form)
+ ((not (eq (car form) 'nthcdr))
+ (cons 'nthcdr (cdr form))) ; use the nthcdr byte-op
+ (t form)))
form))
(put 'cons 'byte-optimizer #'byte-optimize-cons)
@@ -1870,6 +1872,7 @@ See Info node `(elisp) Integer Basics'."
charsetp
;; data.c
arrayp atom bare-symbol-p bool-vector-p bufferp byte-code-function-p
+ interpreted-function-p closurep
byteorder car-safe cdr-safe char-or-string-p char-table-p
condition-variable-p consp eq floatp indirect-function
integer-or-marker-p integerp keywordp listp markerp
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index cc176821026..2fa646f2531 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -193,6 +193,11 @@ So far, FUNCTION can only be a symbol, not a lambda
expression."
(list 'function-put (list 'quote f)
''speed (list 'quote val))))
+(defalias 'byte-run--set-safety
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''safety (list 'quote val))))
+
(defalias 'byte-run--set-completion
#'(lambda (f _args val)
(list 'function-put (list 'quote f)
@@ -217,6 +222,15 @@ So far, FUNCTION can only be a symbol, not a lambda
expression."
(cadr elem)))
val)))))
+(defalias 'byte-run--set-function-type
+ #'(lambda (f _args val &optional f2)
+ (when (and f2 (not (eq f2 f)))
+ (error
+ "`%s' does not match top level function `%s' inside function type \
+declaration" f2 f))
+ (list 'function-put (list 'quote f)
+ ''function-type (list 'quote val))))
+
;; Add any new entries to info node `(elisp)Declare Form'.
(defvar defun-declarations-alist
(list
@@ -237,9 +251,11 @@ If `error-free', drop calls even if
`byte-compile-delete-errors' is nil.")
(list 'doc-string #'byte-run--set-doc-string)
(list 'indent #'byte-run--set-indent)
(list 'speed #'byte-run--set-speed)
+ (list 'safety #'byte-run--set-safety)
(list 'completion #'byte-run--set-completion)
(list 'modes #'byte-run--set-modes)
- (list 'interactive-args #'byte-run--set-interactive-args))
+ (list 'interactive-args #'byte-run--set-interactive-args)
+ (list 'ftype #'byte-run--set-function-type))
"List associating function properties to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is
a function. For each (PROP . VALUES) in a function's declaration,
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 80a8e37bd23..2705e5b804f 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -137,6 +137,19 @@
"Emacs Lisp byte-compiler."
:group 'lisp)
+(defcustom compilation-safety 1
+ "Safety level for generated compiled code.
+Possible values are:
+ 0 - emitted code can misbehave, even crash Emacs, if declarations of
+ functions do not correctly describe their actual behavior;
+ 1 - emitted code is to be generated in a safe manner, even if functions
+ are mis-declared.
+
+This currently affects only code produced by native-compilation."
+ :type 'integer
+ :safe #'integerp
+ :version "30.1")
+
(defcustom emacs-lisp-file-regexp "\\.el\\'"
"Regexp which matches Emacs Lisp source files.
If you change this, you might want to set `byte-compile-dest-file-function'.
@@ -1597,24 +1610,39 @@ extra args."
(when (and (symbolp (car form))
(stringp (nth 1 form))
(get (car form) 'byte-compile-format-like))
- (let ((nfields (with-temp-buffer
- (insert (nth 1 form))
- (goto-char (point-min))
- (let ((i 0) (n 0))
- (while (re-search-forward "%." nil t)
- (backward-char)
- (unless (eq ?% (char-after))
- (setq i (if (looking-at "\\([0-9]+\\)\\$")
- (string-to-number (match-string 1) 10)
- (1+ i))
- n (max n i)))
- (forward-char))
- n)))
- (nargs (- (length form) 2)))
+ (let* ((nargs (length (cddr form)))
+ (nfields 0)
+ (format-str (nth 1 form))
+ (len (length format-str))
+ (start 0))
+ (while (and (< start len)
+ (string-match
+ (rx "%"
+ (? (group (+ digit)) "$") ; field
+ (* (in "+ #0-")) ; flags
+ (* digit) ; width
+ (? "." (* digit)) ; precision
+ (? (group (in "sdioxXefgcS%")))) ; spec
+ format-str start))
+ (let ((field (if (match-beginning 1)
+ (string-to-number (match-string 1 format-str))
+ (1+ nfields)))
+ (spec (and (match-beginning 2)
+ (aref format-str (match-beginning 2)))))
+ (setq start (match-end 0))
+ (cond
+ ((not spec)
+ (byte-compile-warn-x
+ form "Bad format sequence in call to `%s' at string offset %d"
+ (car form) (match-beginning 0)))
+ ((not (eq spec ?%))
+ (setq nfields (max field nfields))))))
(unless (= nargs nfields)
- (byte-compile-warn-x (car form)
- "`%s' called with %d args to fill %d format field(s)" (car form)
- nargs nfields)))))
+ (byte-compile-warn-x
+ (car form) "`%s' called with %d argument%s to fill %d format field%s"
+ (car form)
+ nargs (if (= nargs 1) "" "s")
+ nfields (if (= nfields 1) "" "s"))))))
(dolist (elt '(format message format-message error))
(put elt 'byte-compile-format-like t))
@@ -2429,6 +2457,7 @@ With argument ARG, insert value in current buffer after
the form."
(when byte-native-compiling
(defvar native-comp-speed)
(push `(native-comp-speed . ,native-comp-speed)
byte-native-qualities)
+ (push `(compilation-safety . ,compilation-safety)
byte-native-qualities)
(defvar native-comp-debug)
(push `(native-comp-debug . ,native-comp-debug)
byte-native-qualities)
(defvar native-comp-compiler-options)
@@ -2827,7 +2856,7 @@ not to take responsibility for the actual compilation of
the code."
;; Tell the caller that we didn't compile it yet.
nil)
- (let* ((code (byte-compile-lambda (cons arglist body) t)))
+ (let ((code (byte-compile-lambda `(lambda ,arglist . ,body))))
(if this-one
;; A definition in b-c-initial-m-e should always take precedence
;; during compilation, so don't let it be redefined. (Bug#8647)
@@ -2901,9 +2930,14 @@ otherwise, print without quoting."
(defun byte-compile--reify-function (fun)
"Return an expression which will evaluate to a function value FUN.
FUN should be an interpreted closure."
- (pcase-let* ((`(closure ,env ,args . ,body) fun)
- (`(,preamble . ,body) (macroexp-parse-body body))
- (renv ()))
+ (let* ((args (aref fun 0))
+ (body (aref fun 1))
+ (env (aref fun 2))
+ (docstring (function-documentation fun))
+ (iform (interactive-form fun))
+ (preamble `(,@(if docstring (list docstring))
+ ,@(if iform (list iform))))
+ (renv ()))
;; Turn the function's closed vars (if any) into local let bindings.
(dolist (binding env)
(cond
@@ -2940,10 +2974,12 @@ If FORM is a lambda or a macro, byte-compile it as a
function."
(if (symbolp form) form "provided"))
fun)
(t
- (when (or (symbolp form) (eq (car-safe fun) 'closure))
+ (when (or (symbolp form) (interpreted-function-p fun))
;; `fun' is a function *value*, so try to recover its
;; corresponding source code.
- (when (setq lexical-binding (eq (car-safe fun) 'closure))
+ (if (not (interpreted-function-p fun))
+ (setq lexical-binding nil)
+ (setq lexical-binding (not (null (aref fun 2))))
(setq fun (byte-compile--reify-function fun)))
(setq need-a-value t))
;; Expand macros.
@@ -3048,14 +3084,12 @@ If FORM is a lambda or a macro, byte-compile it as a
function."
byte-compile--known-dynamic-vars)
", "))))
-(defun byte-compile-lambda (fun &optional add-lambda reserved-csts)
+(defun byte-compile-lambda (fun &optional reserved-csts)
"Byte-compile a lambda-expression and return a valid function.
The value is usually a compiled function but may be the original
lambda-expression."
- (if add-lambda
- (setq fun (cons 'lambda fun))
- (unless (eq 'lambda (car-safe fun))
- (error "Not a lambda list: %S" fun)))
+ (unless (eq 'lambda (car-safe fun))
+ (error "Not a lambda list: %S" 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.
@@ -4137,7 +4171,7 @@ This function is never called when `lexical-binding' is
nil."
(docstring-exp (nth 3 form))
(body (nthcdr 4 form))
(fun
- (byte-compile-lambda `(lambda ,vars . ,body) nil (length env))))
+ (byte-compile-lambda `(lambda ,vars . ,body) (length env))))
(cl-assert (or (> (length env) 0)
docstring-exp)) ;Otherwise, we don't need a closure.
(cl-assert (byte-code-function-p fun))
@@ -4172,16 +4206,13 @@ This function is never called when `lexical-binding' is
nil."
;; Nontrivial doc string expression: create a bytecode object
;; from small pieces at run time.
`(make-byte-code
- ',(aref fun 0) ; 15-bit form of arglist descriptor.
- ',(aref fun 1) ; The byte-code.
- (vconcat (vector . ,env) ',(aref fun 2)) ; constant vector.
- ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun))))
- (if docstring-exp
- `(,(car rest)
- ,(byte-run-strip-symbol-positions docstring-exp)
- ,@(cddr rest))
- rest))))
- ))))
+ ,(aref fun 0) ; 15-bit form of arglist descriptor.
+ ,(aref fun 1) ; The byte-code.
+ (vconcat (vector . ,env) ,(aref fun 2)) ; constant vector
+ ,(aref fun 3) ; max stack depth
+ ,(byte-run-strip-symbol-positions docstring-exp)
+ ;; optional interactive spec and anything else, all quoted
+ ,@(mapcar (lambda (x) `',x) (drop 5 (append fun nil)))))))))
(defun byte-compile-get-closed-var (form)
"Byte-compile the special `internal-get-closed-var' form."
@@ -5134,7 +5165,6 @@ binding slots have been popped."
;; `arglist' is the list of arguments (or t if not recognized).
;; `body' is the body of `lam' (or t if not recognized).
((or `(lambda ,arglist . ,body)
- ;; `(closure ,_ ,arglist . ,body)
(and `(internal-make-closure ,arglist . ,_) (let body t))
(and (let arglist t) (let body t)))
lam))
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 4ff47971351..e6a78f07762 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -902,7 +902,7 @@ lexically and dynamically bound symbols actually used by
FORM."
(delete-dups cconv--dynbindings)))))
(cons fvs dyns)))))
-(defun cconv-make-interpreted-closure (fun env)
+(defun cconv-make-interpreted-closure (args body env docstring iform)
"Make a closure for the interpreter.
This is intended to be called at runtime by the ELisp interpreter (when
the code has not been compiled).
@@ -911,22 +911,27 @@ ENV is the runtime representation of the lexical
environment,
i.e. a list whose elements can be either plain symbols (which indicate
that this symbol should use dynamic scoping) or pairs (SYMBOL . VALUE)
for the lexical bindings."
- (cl-assert (eq (car-safe fun) 'lambda))
+ (cl-assert (consp body))
+ (cl-assert (listp args))
(let ((lexvars (delq nil (mapcar #'car-safe env))))
- (if (or (null lexvars)
- ;; Functions with a `:closure-dont-trim-context' marker
- ;; should keep their whole context untrimmed (bug#59213).
- (and (eq :closure-dont-trim-context (nth 2 fun))
- ;; Check the function doesn't just return the magic keyword.
- (nthcdr 3 fun)))
+ (if (or
+ ;; Functions with a `:closure-dont-trim-context' marker
+ ;; should keep their whole context untrimmed (bug#59213).
+ (and (eq :closure-dont-trim-context (car body))
+ ;; Check the function doesn't just return the magic keyword.
+ (cdr body)
+ ;; Drop the magic marker from the closure.
+ (setq body (cdr body)))
+ ;; There's no var to capture, so skip the analysis.
+ (null lexvars))
;; The lexical environment is empty, or needs to be preserved,
;; so there's no need to look for free variables.
- ;; Attempting to replace ,(cdr fun) by a macroexpanded version
- ;; causes bootstrap to fail.
- `(closure ,env . ,(cdr fun))
+ ;; Attempting to replace body by a macroexpanded version
+ ;; caused bootstrap to fail.
+ (make-interpreted-closure args body env docstring iform)
;; We could try and cache the result of the macroexpansion and
;; `cconv-fv' analysis. Not sure it's worth the trouble.
- (let* ((form `#',fun)
+ (let* ((form `#'(lambda ,args ,iform . ,body))
(expanded-form
(let ((lexical-binding t) ;; Tell macros which dialect is in use.
;; Make the macro aware of any defvar declarations in scope.
@@ -935,10 +940,10 @@ for the lexical bindings."
(append env macroexp--dynvars) env)))
(macroexpand-all form macroexpand-all-environment)))
;; Since we macroexpanded the body, we may as well use that.
- (expanded-fun-cdr
+ (expanded-fun-body
(pcase expanded-form
- (`#'(lambda . ,cdr) cdr)
- (_ (cdr fun))))
+ (`#'(lambda ,_args ,_iform . ,newbody) newbody)
+ (_ body)))
(dynvars (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env)))
(fvs (cconv-fv expanded-form lexvars dynvars))
@@ -946,7 +951,8 @@ for the lexical bindings."
(cdr fvs))))
;; Never return a nil env, since nil means to use the dynbind
;; dialect of ELisp.
- `(closure ,(or newenv '(t)) . ,expanded-fun-cdr)))))
+ (make-interpreted-closure args expanded-fun-body (or newenv '(t))
+ docstring iform)))))
(provide 'cconv)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 8bda857afdd..11685d09d12 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1087,7 +1087,7 @@ MET-NAME is as returned by
`cl--generic-load-hist-format'."
(re-search-forward base-re nil t))))
;; WORKAROUND: This can't be a defconst due to bug#21237.
-(defvar cl--generic-find-defgeneric-regexp "(\\(?:cl-\\)?defgeneric[
\t]+%s\\>")
+(defvar cl--generic-find-defgeneric-regexp "(\\(?:cl-\\)?defgeneric[
\t]+%s\\_>")
(with-eval-after-load 'find-func
(defvar find-function-regexp-alist)
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 83d9e6ee220..fa745396b02 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -444,13 +444,24 @@ For this build of Emacs it's %dbit."
)
(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)
+(cl--define-built-in-type closure (function)
+ "Abstract type of functions represented by a vector-like object.
+You can access the object's internals with `aref'.
+The fields are used as follows:
+
+ 0 [args] Argument list (either a list or an integer)
+ 1 [code] Either a byte-code string or a list of Lisp forms
+ 2 [constants] Either vector of constants or a lexical environment
+ 3 [stackdepth] Maximum amount of stack depth used by the byte-code
+ 4 [docstring] The documentation, or a reference to it
+ 5 [iform] The interactive form (if present)")
+(cl--define-built-in-type byte-code-function (compiled-function closure)
"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)
+(cl--define-built-in-type interpreted-function (closure)
"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.")
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 5e5eee1da9e..e8e6502e66f 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -180,7 +180,7 @@ into a button whose action shows the function's
disassembly.")
;; FIXME: Don't degenerate to `prin1' for the contents of char-tables
;; and records!
-(cl-defmethod cl-print-object ((object compiled-function) stream)
+(cl-defmethod cl-print-object ((object byte-code-function) stream)
(unless stream (setq stream standard-output))
;; We use "#f(...)" rather than "#<...>" so that pp.el gives better results.
(princ "#f(compiled-function " stream)
@@ -237,6 +237,38 @@ into a button whose action shows the function's
disassembly.")
'byte-code-function object)))))
(princ ")" stream)))
+(cl-defmethod cl-print-object ((object interpreted-function) stream)
+ (unless stream (setq stream standard-output))
+ (princ "#f(lambda " stream)
+ (let ((args (help-function-arglist object 'preserve-names)))
+ ;; It's tempting to print the arglist from the "usage" info in the
+ ;; doc (e.g. for `&key` args), but that only makes sense if we
+ ;; *don't* print the body, since otherwise the body will tend to
+ ;; refer to args that don't appear in the arglist.
+ (if args
+ (prin1 args stream)
+ (princ "()" stream)))
+ (let ((env (aref object 2)))
+ (if (null env)
+ (princ " :dynbind" stream)
+ (princ " " stream)
+ (cl-print-object
+ (vconcat (mapcar (lambda (x) (if (consp x) (list (car x) (cdr x)) x))
+ env))
+ stream)))
+ (let* ((doc (documentation object 'raw)))
+ (when doc
+ (princ " " stream)
+ (prin1 doc stream)))
+ (let ((inter (interactive-form object)))
+ (when inter
+ (princ " " stream)
+ (cl-print-object inter stream)))
+ (dolist (exp (aref object 1))
+ (princ " " stream)
+ (cl-print-object exp stream))
+ (princ ")" stream))
+
;; This belongs in oclosure.el, of course, but some load-ordering issues make
it
;; complicated.
(cl-defmethod cl-print-object ((object accessor) stream)
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index e46955fd968..60d72d8657d 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -452,14 +452,15 @@ to avoid corrupting the original SEQ.
(apply 'cl-substitute cl-new nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun cl-nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
+(defun cl-nsubstitute (cl-new cl-old seq &rest cl-keys)
"Substitute NEW for OLD in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
(cl--parsing-keywords (:test :test-not :key :if :if-not :count
(:start 0) :end :from-end) ()
- (let ((len (length cl-seq)))
+ (let* ((cl-seq (if (stringp seq) (string-to-vector seq) seq))
+ (len (length cl-seq)))
(or (eq cl-old cl-new) (<= (or cl-count (setq cl-count len)) 0)
(if (and (listp cl-seq) (or (not cl-from-end) (> cl-count (/ len 2))))
(let ((cl-p (nthcdr cl-start cl-seq)))
@@ -483,8 +484,8 @@ This is a destructive function; it reuses the storage of
SEQ whenever possible.
(progn
(aset cl-seq cl-start cl-new)
(setq cl-count (1- cl-count))))
- (setq cl-start (1+ cl-start)))))))
- cl-seq))
+ (setq cl-start (1+ cl-start))))))
+ (if (stringp seq) (concat cl-seq) cl-seq))))
;;;###autoload
(defun cl-nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
@@ -667,7 +668,10 @@ This is a destructive function; it reuses the storage of
SEQ if possible.
\nKeywords supported: :key
\n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
(if (nlistp cl-seq)
- (cl-replace cl-seq (apply 'cl-sort (append cl-seq nil) cl-pred cl-keys))
+ (if (stringp cl-seq)
+ (concat (apply #'cl-sort (vconcat cl-seq) cl-pred cl-keys))
+ (cl-replace cl-seq
+ (apply #'cl-sort (append cl-seq nil) cl-pred cl-keys)))
(cl--parsing-keywords (:key) ()
(if (memq cl-key '(nil identity))
(sort cl-seq cl-pred)
diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el
index 4edfe811586..355988838c7 100644
--- a/lisp/emacs-lisp/comp-common.el
+++ b/lisp/emacs-lisp/comp-common.el
@@ -68,7 +68,7 @@ Used to modify the compiler environment."
:risky t
:version "28.1")
-(defconst comp-known-type-specifiers
+(defconst comp-primitive-type-specifiers
`(
;; Functions we can trust not to be redefined, or, if redefined,
;; to expose the same type. The vast majority of these are
@@ -97,7 +97,6 @@ Used to modify the compiler environment."
(assq (function (t list) list))
(atan (function (number &optional number) float))
(atom (function (t) boolean))
- (bignump (function (t) boolean))
(bobp (function () boolean))
(bolp (function () boolean))
(bool-vector-count-consecutive
@@ -107,7 +106,6 @@ Used to modify the compiler environment."
(bool-vector-p (function (t) boolean))
(bool-vector-subsetp (function (bool-vector bool-vector) boolean))
(boundp (function (symbol) boolean))
- (buffer-end (function ((or number marker)) integer))
(buffer-file-name (function (&optional buffer) (or string null)))
(buffer-list (function (&optional frame) list))
(buffer-local-variables (function (&optional buffer) list))
@@ -118,7 +116,9 @@ Used to modify the compiler environment."
(buffer-substring
(function ((or integer marker) (or integer marker)) string))
(bufferp (function (t) boolean))
+ (closurep (function (t) boolean))
(byte-code-function-p (function (t) boolean))
+ (interpreted-function-p (function (t) boolean))
(capitalize (function ((or integer string)) (or integer string)))
(car (function (list) t))
(car-less-than-car (function (list list) boolean))
@@ -155,8 +155,6 @@ Used to modify the compiler environment."
(copy-sequence (function (sequence) sequence))
(copysign (function (float float) float))
(cos (function (number) float))
- (count-lines
- (function ((or integer marker) (or integer marker) &optional t) integer))
(current-buffer (function () buffer))
(current-global-map (function () cons))
(current-indentation (function () integer))
@@ -169,7 +167,6 @@ Used to modify the compiler environment."
(current-time-zone (function (&optional (or number list)
(or symbol string cons integer))
cons))
- (custom-variable-p (function (symbol) t))
(decode-char (function (cons t) (or fixnum null)))
(decode-time (function (&optional (or number list)
(or symbol string cons integer)
@@ -177,7 +174,6 @@ Used to modify the compiler environment."
cons))
(default-boundp (function (symbol) boolean))
(default-value (function (symbol) t))
- (degrees-to-radians (function (number) float))
(documentation
(function ((or function symbol subr) &optional t) (or null string)))
(downcase (function ((or fixnum string)) (or fixnum string)))
@@ -190,7 +186,6 @@ Used to modify the compiler environment."
(eql (function (t t) boolean))
(equal (function (t t) boolean))
(error-message-string (function (list) string))
- (eventp (function (t) boolean))
(exp (function (number) float))
(expt (function (number number) number))
(fboundp (function (symbol) boolean))
@@ -205,7 +200,6 @@ Used to modify the compiler environment."
(file-readable-p (function (string) boolean))
(file-symlink-p (function (string) (or boolean string)))
(file-writable-p (function (string) boolean))
- (fixnump (function (t) boolean))
(float (function (number) float))
(float-time (function (&optional (or number list)) float))
(floatp (function (t) boolean))
@@ -228,18 +222,12 @@ Used to modify the compiler environment."
(function (&optional (or buffer string) (or symbol (integer 0 0)))
(or null window)))
(get-file-buffer (function (string) (or null buffer)))
- (get-largest-window (function (&optional t t t) (or window null)))
- (get-lru-window (function (&optional t t t) (or window null)))
- (getenv (function (string &optional frame) (or null string)))
(gethash (function (t hash-table &optional t) t))
(hash-table-count (function (hash-table) integer))
(hash-table-p (function (t) boolean))
(identity (function (t) t))
- (ignore (function (&rest t) null))
- (int-to-string (function (number) string))
(integer-or-marker-p (function (t) boolean))
(integerp (function (t) boolean))
- (interactive-p (function () boolean))
(intern-soft (function ((or string symbol) &optional (or obarray vector))
symbol))
(invocation-directory (function () string))
@@ -248,8 +236,6 @@ Used to modify the compiler environment."
(keymap-parent (function (cons) (or cons null)))
(keymapp (function (t) boolean))
(keywordp (function (t) boolean))
- (last (function (list &optional integer) list))
- (lax-plist-get (function (list t) t))
(ldexp (function (number integer) float))
(length (function (t) (integer 0 *)))
(length< (function (sequence fixnum) boolean))
@@ -263,7 +249,6 @@ Used to modify the compiler environment."
(local-variable-p (function (symbol &optional buffer) boolean))
(locale-info (function ((member codeset days months paper)) (or null
string)))
(log (function (number number) float))
- (log10 (function (number) float))
(logand (function (&rest (or integer marker)) integer))
(logb (function (number) integer))
(logcount (function (integer) integer))
@@ -271,7 +256,6 @@ Used to modify the compiler environment."
(lognot (function (integer) integer))
(logxor (function (&rest (or integer marker)) integer))
;; (lsh (function ((integer ,most-negative-fixnum *) integer) integer)) ?
- (lsh (function (integer integer) integer))
(make-byte-code
(function ((or fixnum list) string vector integer &optional string t
&rest t)
@@ -280,14 +264,12 @@ Used to modify the compiler environment."
(make-marker (function () marker))
(make-string (function (integer fixnum &optional t) string))
(make-symbol (function (string) symbol))
- (mark (function (&optional t) (or integer null)))
(mark-marker (function () marker))
(marker-buffer (function (marker) (or buffer null)))
(markerp (function (t) boolean))
(max (function ((or number marker) &rest (or number marker)) number))
(max-char (function (&optional t) fixnum))
(member (function (t list) list))
- (memory-limit (function () integer))
(memq (function (t list) list))
(memql (function (t list) list))
(min (function ((or number marker) &rest (or number marker)) number))
@@ -296,7 +278,6 @@ Used to modify the compiler environment."
(mod
(function ((or number marker) (or number marker))
(or (integer 0 *) (float 0 *))))
- (mouse-movement-p (function (t) boolean))
(multibyte-char-to-unibyte (function (fixnum) fixnum))
(natnump (function (t) boolean))
(next-window (function (&optional window t t) window))
@@ -308,9 +289,7 @@ Used to modify the compiler environment."
(number-or-marker-p (function (t) boolean))
(number-to-string (function (number) string))
(numberp (function (t) boolean))
- (one-window-p (function (&optional t t) boolean))
(overlayp (function (t) boolean))
- (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))
@@ -323,13 +302,11 @@ Used to modify the compiler environment."
(processp (function (t) boolean))
(proper-list-p (function (t) (or fixnum null)))
(propertize (function (string &rest t) string))
- (radians-to-degrees (function (number) float))
(rassoc (function (t list) list))
(rassq (function (t list) list))
(read-from-string (function (string &optional integer integer) cons))
(recent-keys (function (&optional (or cons null)) vector))
(recursion-depth (function () integer))
- (regexp-opt (function (list) string))
(regexp-quote (function (string) string))
(region-beginning (function () integer))
(region-end (function () integer))
@@ -385,7 +362,6 @@ Used to modify the compiler environment."
(upcase (function ((or fixnum string)) (or fixnum string)))
(user-full-name (function (&optional integer) (or string null)))
(user-login-name (function (&optional integer) (or string null)))
- (user-original-login-name (function (&optional integer) (or string null)))
(user-real-login-name (function () string))
(user-real-uid (function () integer))
(user-uid (function () integer))
@@ -398,13 +374,8 @@ Used to modify the compiler environment."
(window-live-p (function (t) boolean))
(window-valid-p (function (t) boolean))
(windowp (function (t) boolean))
- (zerop (function (number) boolean))
- ;; Type hints
- (comp-hint-fixnum (function (t) fixnum))
- (comp-hint-cons (function (t) cons))
;; Non returning functions
(throw (function (t t) nil))
- (error (function (string &rest t) nil))
(signal (function (symbol t) nil)))
"Alist used for type propagation.")
@@ -530,22 +501,27 @@ Account for `native-comp-eln-load-path' and
`comp-native-version-dir'."
(defun comp-function-type-spec (function)
"Return the type specifier of FUNCTION.
-This function returns a cons cell whose car is the function
-specifier, and cdr is a symbol, either `inferred' or `know'.
-If the symbol is `inferred', the type specifier is automatically
-inferred from the code itself by the native compiler; if it is
-`know', the type specifier comes from `comp-known-type-specifiers'."
- (let ((kind 'know)
- type-spec )
- (when-let ((res (assoc function comp-known-type-specifiers)))
+This function returns a cons cell whose car is the function specifier,
+and cdr is a symbol, either `inferred' or `declared'. If the symbol is
+`inferred', the type specifier is automatically inferred from the code
+itself by the native compiler; if it is `declared', the type specifier
+comes from `comp-primitive-type-specifiers' or the function type declaration
+itself."
+ (let ((kind 'declared)
+ type-spec)
+ (when-let ((res (assoc function comp-primitive-type-specifiers)))
+ ;; Declared primitive
(setf type-spec (cadr res)))
(let ((f (and (symbolp function)
(symbol-function function))))
- (when (and f
- (null type-spec)
- (subr-native-elisp-p f))
- (setf kind 'inferred
- type-spec (subr-type f))))
+ (when (and f (null type-spec))
+ (if-let ((delc-type (function-get function 'function-type)))
+ ;; Declared Lisp function
+ (setf type-spec delc-type)
+ (when (subr-native-elisp-p f)
+ ;; Native compiled inferred
+ (setf kind 'inferred
+ type-spec (subr-type f))))))
(when type-spec
(cons type-spec kind))))
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 2ec55ed98ee..4c76f95a0e9 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -179,16 +179,30 @@ For internal use by the test suite only.")
Each function in FUNCTIONS is run after PASS.
Useful to hook into pass checkers.")
-(defconst comp-known-func-cstr-h
+(defconst comp-primitive-func-cstr-h
(cl-loop
with comp-ctxt = (make-comp-cstr-ctxt)
with h = (make-hash-table :test #'eq)
- for (f type-spec) in comp-known-type-specifiers
+ for (f type-spec) in comp-primitive-type-specifiers
for cstr = (comp-type-spec-to-cstr type-spec)
do (puthash f cstr h)
finally return h)
"Hash table function -> `comp-constraint'.")
+(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--get-function-cstr (function)
+ "Given FUNCTION return the corresponding `comp-constraint'."
+ (when (symbolp function)
+ (or (gethash function comp-primitive-func-cstr-h)
+ (when-let ((type (or (when-let ((f (comp--symbol-func-to-fun
function)))
+ (comp-func-declared-type f))
+ (function-get function 'function-type))))
+ (comp-type-spec-to-cstr type)))))
+
;; 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).
@@ -354,6 +368,8 @@ Returns ELT."
:documentation "Target output file-name for the compilation.")
(speed native-comp-speed :type number
:documentation "Default speed for this compilation unit.")
+ (safety compilation-safety :type number
+ :documentation "Default safety level for this compilation unit.")
(debug native-comp-debug :type number
:documentation "Default debug level for this compilation unit.")
(compiler-options native-comp-compiler-options :type list
@@ -513,8 +529,12 @@ CFG is mutated by a pass.")
:documentation "t if non local jumps are present.")
(speed nil :type number
:documentation "Optimization level (see `native-comp-speed').")
+ (safety nil :type number
+ :documentation "Safety level (see `safety').")
(pure nil :type boolean
:documentation "t if pure nil otherwise.")
+ (declared-type nil :type list
+ :documentation "Declared function type.")
(type nil :type (or null comp-mvar)
:documentation "Mvar holding the derived return type."))
@@ -591,11 +611,6 @@ In use by the back-end."
finally return t)
t))
-(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)
"Return t if F is pure."
(or (get f 'pure)
@@ -687,6 +702,11 @@ current instruction or its cell."
(or (comp--spill-decl-spec function-name 'speed)
(comp-ctxt-speed comp-ctxt)))
+(defun comp--spill-safety (function-name)
+ "Return the safety level for FUNCTION-NAME."
+ (or (comp--spill-decl-spec function-name 'safety)
+ (comp-ctxt-safety comp-ctxt)))
+
;; Autoloaded as might be used by `disassemble-internal'.
;;;###autoload
(defun comp-c-func-name (name prefix &optional first)
@@ -813,6 +833,8 @@ clashes."
(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-safety func) (comp--spill-safety name)
+ (comp-func-declared-type func) (comp--spill-decl-spec name
'function-type)
(comp-func-pure func) (comp--spill-decl-spec name 'pure))
;; Store the c-name to have it retrievable from
@@ -838,6 +860,8 @@ clashes."
(comp-el-to-eln-filename filename native-compile-target-directory)))
(setf (comp-ctxt-speed comp-ctxt) (alist-get 'native-comp-speed
byte-native-qualities)
+ (comp-ctxt-safety comp-ctxt) (alist-get 'compilation-safety
+ byte-native-qualities)
(comp-ctxt-debug comp-ctxt) (alist-get 'native-comp-debug
byte-native-qualities)
(comp-ctxt-compiler-options comp-ctxt) (alist-get
'native-comp-compiler-options
@@ -1645,7 +1669,8 @@ into the C code forwarding the compilation unit."
;; the last function being
;; registered.
:frame-size 2
- :speed (comp-ctxt-speed comp-ctxt)))
+ :speed (comp-ctxt-speed comp-ctxt)
+ :safety (comp-ctxt-safety comp-ctxt)))
(comp-func func)
(comp-pass (make-comp-limplify
:curr-block (make--comp-block-lap -1 0 'top-level)
@@ -2102,10 +2127,10 @@ TARGET-BB-SYM is the symbol name of the target block."
(when-let ((match
(pcase insn
(`(set ,lhs (,(pred comp--call-op-p) ,f . ,args))
- (when-let ((cstr-f (gethash f comp-known-func-cstr-h)))
+ (when-let ((cstr-f (comp--get-function-cstr f)))
(cl-values f cstr-f lhs args)))
(`(,(pred comp--call-op-p) ,f . ,args)
- (when-let ((cstr-f (gethash f comp-known-func-cstr-h)))
+ (when-let ((cstr-f (comp--get-function-cstr f)))
(cl-values f cstr-f nil args))))))
(cl-multiple-value-bind (f cstr-f lhs args) match
(cl-loop
@@ -2642,7 +2667,7 @@ Fold the call in case."
(comp-cstr-imm-vld-p (car args)))
(setf f (comp-cstr-imm (car args))
args (cdr args)))
- (when-let ((cstr-f (gethash f comp-known-func-cstr-h)))
+ (when-let ((cstr-f (comp--get-function-cstr f)))
(let ((cstr (comp-cstr-f-ret cstr-f)))
(when (comp-cstr-empty-p cstr)
;; Store it to be rewritten as non local exit.
@@ -3301,11 +3326,13 @@ Prepare every function for final compilation and drive
the C back-end."
;; are assumed just to be true. Use with extreme caution...
(defun comp-hint-fixnum (x)
- (declare (gv-setter (lambda (val) `(setf ,x ,val))))
+ (declare (ftype (function (t) fixnum))
+ (gv-setter (lambda (val) `(setf ,x ,val))))
x)
(defun comp-hint-cons (x)
- (declare (gv-setter (lambda (val) `(setf ,x ,val))))
+ (declare (ftype (function (t) cons))
+ (gv-setter (lambda (val) `(setf ,x ,val))))
x)
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 850cc2085f7..91427166137 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -64,8 +64,11 @@ redefine OBJECT if it is a symbol."
obarray 'fboundp t nil nil def))
nil 0 t)))
(let ((lb lexical-binding))
- (if (and (consp object) (not (functionp object)))
- (setq object `(lambda () ,object)))
+ (when (and (consp object) (not (eq (car object) 'lambda)))
+ (setq object
+ (if (eq (car object) 'byte-code)
+ (apply #'make-byte-code 0 (cdr object))
+ `(lambda () ,object))))
(or indent (setq indent 0)) ;Default indent to zero
(save-excursion
(if (or interactive-p (null buffer))
@@ -113,23 +116,19 @@ redefine OBJECT if it is a symbol."
(if (eq (car-safe obj) 'macro) ;Handle macros.
(setq macro t
obj (cdr obj)))
- (if (eq (car-safe obj) 'byte-code)
- (setq obj `(lambda () ,obj)))
- (when (consp obj)
+ (when (or (consp obj) (interpreted-function-p obj))
(unless (functionp obj) (error "Not a function"))
- (if (assq 'byte-code obj)
- nil
- (if interactive-p (message (if name
- "Compiling %s's definition..."
- "Compiling definition...")
- name))
- (setq obj (byte-compile obj))
- (if interactive-p (message "Done compiling. Disassembling..."))))
+ (if interactive-p (message (if name
+ "Compiling %s's definition..."
+ "Compiling definition...")
+ name))
+ (setq obj (byte-compile obj))
+ (if interactive-p (message "Done compiling. Disassembling...")))
(cond ((consp obj)
(setq args (help-function-arglist obj)) ;save arg list
(setq obj (cdr obj)) ;throw lambda away
(setq obj (cdr obj)))
- ((byte-code-function-p obj)
+ ((closurep obj)
(setq args (help-function-arglist obj)))
(t (error "Compilation failed")))
(if (zerop indent) ; not a nested function
@@ -171,14 +170,14 @@ redefine OBJECT if it is a symbol."
(let ((print-escape-newlines t))
(prin1 interactive (current-buffer))))
(insert "\n"))))
- (cond ((and (consp obj) (assq 'byte-code obj))
- (disassemble-1 (assq 'byte-code obj) indent))
- ((byte-code-function-p obj)
+ (cond ((byte-code-function-p obj)
(disassemble-1 obj indent))
(t
(insert "Uncompiled body: ")
(let ((print-escape-newlines t))
- (prin1 (macroexp-progn obj)
+ (prin1 (macroexp-progn (if (interpreted-function-p obj)
+ (aref obj 1)
+ obj))
(current-buffer))))))
(if interactive-p
(message "")))
@@ -265,7 +264,7 @@ OBJ should be a call to BYTE-CODE generated by the byte
compiler."
(and (eq (car-safe arg) 'macro)
(byte-code-function-p (cdr arg))))
(cond ((byte-code-function-p arg)
- (insert "<compiled-function>\n"))
+ (insert "<byte-code-function>\n"))
(t (insert "<compiled macro>\n")))
(disassemble-internal
arg
@@ -277,6 +276,8 @@ OBJ should be a call to BYTE-CODE generated by the byte
compiler."
arg
(+ indent disassemble-recursive-indent)))
((eq (car-safe (car-safe arg)) 'byte-code)
+ ;; FIXME: I'm 99% sure bytecomp never generates
+ ;; this any more.
(insert "(<byte code>...)\n")
(mapc ;Recurse on list of byte-code objects.
(lambda (obj)
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index eaad9646985..ba0f8bad393 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -580,7 +580,20 @@ modes derived from `text-mode'\". An element with value t
means \"use\"
and nil means \"don't use\". There's an implicit nil at the end of the
list."
mode)
- :type '(repeat sexp)
+ :type '(choice
+ (const :tag "Enable in all major modes" t)
+ (const :tag "Don't enable in any major mode" nil)
+ (repeat
+ :tag "Rules (earlier takes precedence)..."
+ (choice
+ (const :tag "Enable in all (other) modes" t)
+ (const :tag "Don't enable in any (other) mode" nil)
+ (symbol :value fundamental-mode
+ :tag "Enable in major mode")
+ (cons :tag "Don't enable in major modes"
+ (const :tag "Don't enable in..." not)
+ (repeat (symbol :value fundamental-mode
+ :tag "Major mode"))))))
,@group))
;; Autoloading define-globalized-minor-mode autoloads everything
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index b27ffbca908..381b7964a35 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1313,6 +1313,12 @@ infinite loops when the code/environment contains a
circular object.")
(aref sexp 0) (aref sexp 1)
(vconcat (mapcar #'edebug-unwrap* (aref sexp 2)))
(nthcdr 3 (append sexp ()))))
+ ((interpreted-function-p sexp)
+ (make-interpreted-closure
+ (aref sexp 0) (mapcar #'edebug-unwrap* (aref sexp 1))
+ (mapcar (lambda (x) (if (consp x) (cons (car x) (edebug-unwrap* (cdr x)))
x))
+ (aref sexp 2))
+ (documentation sexp 'raw) (interactive-form sexp)))
(t sexp)))
@@ -4254,7 +4260,7 @@ code location is known."
((pred edebug--symbol-prefixed-p) nil)
(_
(when (and skip-next-lambda
- (not (memq (car-safe fun) '(closure lambda))))
+ (not (interpreted-function-p fun)))
(warn "Edebug--strip-instrumentation expected an interpreted
function:\n%S" fun))
(unless skip-next-lambda
(edebug--unwrap-frame new-frame)
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 8ab57d2b238..6a665c8181d 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -2816,8 +2816,7 @@ To be used in the ERT results buffer."
(insert (format-message " defined in `%s'"
(file-name-nondirectory file-name)))
(save-excursion
- (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
- nil t)
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'"))
(help-xref-button 1 'help-function-def test-name file-name)))
(insert ".")
(fill-region-as-paragraph (point-min) (point))
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 3475d944337..601cc7bf712 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -1347,7 +1347,6 @@ Lisp function does not specify a special indentation."
(put 'condition-case 'lisp-indent-function 2)
(put 'handler-case 'lisp-indent-function 1) ;CL
(put 'unwind-protect 'lisp-indent-function 1)
-(put 'closure 'lisp-indent-function 2)
(defun indent-sexp (&optional endpos)
"Indent each line of the list starting just after point.
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 7e6db51b1d5..e65eec508d9 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -534,7 +534,8 @@ major mode's decisions about context.")
"Return the \"far end\" position of the buffer, in direction ARG.
If ARG is positive, that's the end of the buffer.
Otherwise, that's the beginning of the buffer."
- (declare (side-effect-free error-free))
+ (declare (ftype (function ((or number marker)) integer))
+ (side-effect-free error-free))
(if (> arg 0) (point-max) (point-min)))
(defun end-of-defun (&optional arg interactive)
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index 581053f6304..50e90cdf94c 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -601,7 +601,6 @@ instead of just updating them with the new/changed
autoloads."
(if (consp dir) dir (list dir)))))
(updating (and (file-exists-p output-file) (not generate-full)))
(defs nil))
-
;; Allow the excluded files to be relative.
(setq excluded-files
(mapcar (lambda (file) (expand-file-name file dir))
@@ -610,7 +609,8 @@ instead of just updating them with the new/changed
autoloads."
;; Collect all the autoload data.
(let ((progress (make-progress-reporter
(byte-compile-info
- (concat "Scraping files for loaddefs"))
+ (format "Scraping %s files for loaddefs"
+ (length files)))
0 (length files) nil 10))
(output-time
(file-attribute-modification-time (file-attributes output-file)))
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index b603f2e6d0b..7b135c54a15 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -35,6 +35,9 @@
;;; Code:
(declare-function x-popup-dialog "menu.c" (position contents &optional header))
+(declare-function set-text-conversion-style "textconv.c")
+
+(defvar overriding-text-conversion-style)
(defun map-y-or-n-p (prompter actor list &optional help action-alist
no-cursor-in-echo-area)
@@ -168,7 +171,18 @@ The function's value is the number of actions taken."
(key-description (vector help-char)))
(if minibuffer-auto-raise
(raise-frame (window-frame (minibuffer-window))))
- (setq char (read-event))
+ (unwind-protect
+ ;; We want to inhibit text conversion here,
+ ;; because it gets in the way when system
+ ;; input methods are installed. See
+ ;;
https://lists.gnu.org/archive/html/emacs-devel/2024-05/msg00441.html
+ ;; for the details.
+ (let ((overriding-text-conversion-style nil))
+ (when (fboundp 'set-text-conversion-style)
+ (set-text-conversion-style
text-conversion-style))
+ (setq char (read-event)))
+ (when (fboundp 'set-text-conversion-style)
+ (set-text-conversion-style text-conversion-style)))
;; Show the answer to the question.
(message "%s(y, n, !, ., q, %sor %s) %s"
prompt user-keys
diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
index 8299e3dffcc..b7bc5536f78 100644
--- a/lisp/emacs-lisp/multisession.el
+++ b/lisp/emacs-lisp/multisession.el
@@ -137,6 +137,9 @@ DOC should be a doc string, and ARGS are keywords as
applicable to
(declare-function sqlite-select "sqlite.c")
(declare-function sqlite-open "sqlite.c")
(declare-function sqlite-pragma "sqlite.c")
+(declare-function sqlite-commit "sqlite.c")
+(declare-function sqlite-transaction "sqlite.c")
+(declare-function sqlite-rollback "sqlite.c")
(defvar multisession--db nil)
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 5326c520601..36df143a82a 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -185,7 +185,7 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are
expected.")
(defun advice--interactive-form-1 (function)
"Like `interactive-form' but preserves the static context if needed."
(let ((if (interactive-form function)))
- (if (or (null if) (not (eq 'closure (car-safe function))))
+ (if (not (and if (interpreted-function-p function)))
if
(cl-assert (eq 'interactive (car if)))
(let ((form (cadr if)))
@@ -193,14 +193,14 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are
expected.")
if
;; The interactive is expected to be run in the static context
;; that the function captured.
- (let ((ctx (nth 1 function)))
+ (let ((ctx (aref function 2)))
`(interactive
,(let* ((f (if (eq 'function (car-safe form)) (cadr form) form)))
;; If the form jut returns a function, preserve the fact that
;; it just returns a function, which is an info we use in
;; `advice--make-interactive-form'.
(if (eq 'lambda (car-safe f))
- `',(eval form ctx)
+ (eval form ctx)
`(eval ',form ',ctx))))))))))
(defun advice--interactive-form (function)
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index 4da8e61aaa7..165d7c4b6e8 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -146,7 +146,7 @@
(setf (cl--find-class 'oclosure)
(oclosure--class-make 'oclosure
"The root parent of all OClosure types"
- nil (list (cl--find-class 'function))
+ nil (list (cl--find-class 'closure))
'(oclosure)))
(defun oclosure--p (oclosure)
(not (not (oclosure-type oclosure))))
@@ -431,75 +431,57 @@ ARGS and BODY are the same as for `lambda'."
(defun oclosure--fix-type (_ignore oclosure)
"Helper function to implement `oclosure-lambda' via a macro.
-This has 2 uses:
-- For interpreted code, this converts the representation of type information
- by moving it from the docstring to the environment.
-- 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 `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
- ;; slot. For interpreted functions, there's no specific docstring slot
- ;; so `Ffunction' turns the symbol into a string.
- ;; We thus have convert it back into a symbol (via `intern') and then
- ;; stuff it into the environment part of the closure with a special
- ;; marker so we can distinguish this entry from actual variables.
- (cl-assert (eq 'closure (car-safe oclosure)))
- (let ((typename (nth 3 oclosure))) ;; The "docstring".
- (cl-assert (stringp typename))
- (push (cons :type (intern typename))
- (cadr oclosure))
- oclosure)))
+This is used as a marker which cconv uses to check that
+immutable fields are indeed not mutated."
+ (cl-assert (closurep oclosure))
+ ;; This should happen only for interpreted closures since `cconv.el'
+ ;; should have optimized away the call to this function.
+ oclosure)
(defun oclosure--copy (oclosure mutlist &rest args)
+ (cl-assert (closurep oclosure))
(if (byte-code-function-p oclosure)
(apply #'make-closure oclosure
(if (null mutlist)
args
(mapcar (lambda (arg) (if (pop mutlist) (list arg) arg)) args)))
- (cl-assert (eq 'closure (car-safe oclosure))
- nil "oclosure not closure: %S" oclosure)
- (cl-assert (eq :type (caar (cadr oclosure))))
- (let ((env (cadr oclosure)))
- `(closure
- (,(car env)
- ,@(named-let loop ((env (cdr env)) (args args))
- (when args
- (cons (cons (caar env) (car args))
- (loop (cdr env) (cdr args)))))
- ,@(nthcdr (1+ (length args)) env))
- ,@(nthcdr 2 oclosure)))))
+ (cl-assert (consp (aref oclosure 1)))
+ (cl-assert (null (aref oclosure 3)))
+ (cl-assert (symbolp (aref oclosure 4)))
+ (let ((env (aref oclosure 2)))
+ (make-interpreted-closure
+ (aref oclosure 0)
+ (aref oclosure 1)
+ (named-let loop ((env env) (args args))
+ (if (null args) env
+ (cons (cons (caar env) (car args))
+ (loop (cdr env) (cdr args)))))
+ (aref oclosure 4)
+ (if (> (length oclosure) 5)
+ `(interactive ,(aref oclosure 5)))))))
(defun oclosure--get (oclosure index mutable)
- (if (byte-code-function-p oclosure)
- (let* ((csts (aref oclosure 2))
- (v (aref csts index)))
- (if mutable (car v) v))
- (cl-assert (eq 'closure (car-safe oclosure)))
- (cl-assert (eq :type (caar (cadr oclosure))))
- (cdr (nth (1+ index) (cadr oclosure)))))
+ (cl-assert (closurep oclosure))
+ (let* ((csts (aref oclosure 2)))
+ (if (vectorp csts)
+ (let ((v (aref csts index)))
+ (if mutable (car v) v))
+ (cdr (nth index csts)))))
(defun oclosure--set (v oclosure index)
- (if (byte-code-function-p oclosure)
- (let* ((csts (aref oclosure 2))
- (cell (aref csts index)))
- (setcar cell v))
- (cl-assert (eq 'closure (car-safe oclosure)))
- (cl-assert (eq :type (caar (cadr oclosure))))
- (setcdr (nth (1+ index) (cadr oclosure)) v)))
+ (cl-assert (closurep oclosure))
+ (let ((csts (aref oclosure 2)))
+ (if (vectorp csts)
+ (let ((cell (aref csts index)))
+ (setcar cell v))
+ (setcdr (nth index csts) v))))
(defun oclosure-type (oclosure)
- "Return the type of OCLOSURE, or nil if the arg is not a OClosure."
- (if (byte-code-function-p oclosure)
- (let ((type (and (> (length oclosure) 4) (aref oclosure 4))))
- (if (symbolp type) type))
- (and (eq 'closure (car-safe oclosure))
- (let* ((env (car-safe (cdr oclosure)))
- (first-var (car-safe env)))
- (and (eq :type (car-safe first-var))
- (cdr first-var))))))
+ "Return the type of OCLOSURE, or nil if the arg is not an OClosure."
+ (and (closurep oclosure)
+ (> (length oclosure) 4)
+ (let ((type (aref oclosure 4)))
+ (if (symbolp type) type))))
(defconst oclosure--accessor-prototype
;; Use `oclosure--lambda' to circumvent a bootstrapping problem:
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index ef056c7909b..c86577b6b26 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -774,6 +774,9 @@ conflicts with its remote repository state."
(package-vc-upgrade pkg-desc))))
(message "Done upgrading packages."))
+(declare-function vc-dir-prepare-status-buffer "vc-dir"
+ (bname dir backend &optional create-new))
+
;;;###autoload
(defun package-vc-upgrade (pkg-desc)
"Upgrade the package described by PKG-DESC from package's VC repository.
@@ -810,7 +813,10 @@ with the remote repository state."
(remove-hook 'vc-post-command-functions post-upgrade))))))
(add-hook 'vc-post-command-functions post-upgrade)
(with-demoted-errors "Failed to fetch: %S"
- (let ((default-directory pkg-dir))
+ (require 'vc-dir)
+ (with-current-buffer (vc-dir-prepare-status-buffer
+ (format " *package-vc-dir: %s*" pkg-dir)
+ pkg-dir (vc-responsible-backend pkg-dir))
(vc-pull)))))
(defun package-vc--archives-initialize ()
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index ab1731aeb54..fda855d2143 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -174,7 +174,13 @@ with \"-q\").
Even if the value is nil, you can type \\[package-initialize] to
make installed packages available at any time, or you can
-call (package-activate-all) in your init-file."
+call (package-activate-all) in your init-file.
+
+Note that this variable must be set to a non-default value in
+your early-init file, as the variable's value is used before
+loading the regular init file. Therefore, if you customize it
+via Customize, you should save your customized setting into
+your `early-init-file'."
:type 'boolean
:version "24.1")
@@ -2941,7 +2947,7 @@ Helper function for `describe-package'."
(insert " "))
(insert "\n"))
(when maintainers
- (when (stringp (car maintainers))
+ (unless (and (listp (car maintainers)) (listp (cdr maintainers)))
(setq maintainers (list maintainers)))
(package--print-help-section
(if (cdr maintainers) "Maintainers" "Maintainer"))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 23f1bac600c..1a58c60734a 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -678,7 +678,8 @@ recording whether the var has been referenced by earlier
parts of the match."
bitsets)))
(defconst pcase--subtype-bitsets
- (if (fboundp 'built-in-class-p)
+ (if (and (fboundp 'built-in-class-p)
+ (built-in-class-p (get 'function 'cl--class)))
(pcase--subtype-bitsets)
;; Early bootstrap: we don't have the built-in classes yet, so just
;; use an empty table for now.
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index 59c1b7d8e10..d655855fab2 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -130,7 +130,8 @@ usually more efficient than that of a simplified version:
(concat (car parens)
(mapconcat \\='regexp-quote strings \"\\\\|\")
(cdr parens))))"
- (declare (pure t) (side-effect-free t))
+ (declare (ftype (function (list &optional t) string))
+ (pure t) (side-effect-free t))
(save-match-data
;; Recurse on the sorted list.
(let* ((max-lisp-eval-depth 10000)
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 246e41cff0b..7113d5a6241 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -149,6 +149,13 @@ If DEF is a list on the form (FUN MIN-ARGS MAX-ARGS PRED),
then
If PRED is non-nil, it is a predicate that all actual arguments must
satisfy.")
+(make-obsolete-variable
+ 'rx-constituents
+ "use `rx-let', `rx-let-eval', or `rx-define' instead."
+ ;; Effectively obsolete since Emacs 27 but only formally declared
+ ;; obsolete in Emacs 30.
+ "30.1")
+
(defvar rx--local-definitions nil
"Alist of dynamic local rx definitions.
Each entry is:
diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el
index c11c976312b..2824a70586d 100644
--- a/lisp/emacs-lisp/track-changes.el
+++ b/lisp/emacs-lisp/track-changes.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2024 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-;; Version: 1.1
+;; Version: 1.2
;; Package-Requires: ((emacs "24"))
;; This file is part of GNU Emacs.
@@ -74,6 +74,12 @@
;; id (lambda (beg end before)
;; ..DO THE THING..))))))))
+;;; News:
+
+;; Since v1.1:
+;;
+;; - New function `track-changes-inconsistent-state-p'.
+
;;; Code:
;; Random ideas:
@@ -364,9 +370,20 @@ and re-enable the TRACKER corresponding to ID."
(setf (track-changes--tracker-state id) track-changes--state)
(funcall func beg end (or before lenbefore)))
;; Re-enable the tracker's signal only after running `func', so
- ;; as to avoid recursive invocations.
+ ;; as to avoid nested invocations.
(cl-pushnew id track-changes--clean-trackers))))
+(defun track-changes-inconsistent-state-p ()
+ "Return whether the current buffer is in an inconsistent state.
+Ideally `before/after-change-functions' should be called for each and every
+buffer change, but some packages make transient changes without
+running those hooks.
+This function tries to detect those situations so clients can decide
+to postpone their work to a later time when the buffer is hopefully
+returned to a consistent state."
+ (or (not (equal track-changes--buffer-size (buffer-size)))
+ inhibit-modification-hooks))
+
;;;; Auxiliary functions.
(defun track-changes--clean-state ()
@@ -578,8 +595,10 @@ Details logged to `track-changes--error-log'")
(defun track-changes--call-signal (buf tracker)
(when (buffer-live-p buf)
(with-current-buffer buf
- ;; Silence ourselves if `track-changes-fetch' was called in the mean
time.
- (unless (memq tracker track-changes--clean-trackers)
+ ;; Silence ourselves if `track-changes-fetch' was called
+ ;; or the tracker was unregistered in the mean time.
+ (when (and (not (memq tracker track-changes--clean-trackers))
+ (memq tracker track-changes--trackers))
(funcall (track-changes--tracker-signal tracker) tracker)))))
;;;; Extra candidates for the API.
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index d8e5136c666..cb7ea397314 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -348,19 +348,57 @@ This will also remove the displayed line."
(when (vtable-goto-object object)
(delete-line)))))
-(defun vtable-insert-object (table object &optional after-object)
- "Insert OBJECT into TABLE after AFTER-OBJECT.
-If AFTER-OBJECT is nil (or doesn't exist in the table), insert
-OBJECT at the end.
+;; FIXME: The fact that the `location' argument of
+;; `vtable-insert-object' can be an integer and is then interpreted as
+;; an index precludes the use of integers as objects. This seems a very
+;; unlikely use-case, so let's just accept this limitation.
+
+(defun vtable-insert-object (table object &optional location before)
+ "Insert OBJECT into TABLE at LOCATION.
+LOCATION is an object in TABLE. OBJECT is inserted after LOCATION,
+unless BEFORE is non-nil, in which case it is inserted before LOCATION.
+
+If LOCATION is nil, or does not exist in the table, OBJECT is inserted
+at the end of the table, or at the beginning if BEFORE is non-nil.
+
+LOCATION can also be an integer, a (zero-based) index into the table.
+OBJECT is inserted at this location. If the index is out of range,
+OBJECT is inserted at the beginning (if the index is less than 0) or
+end (if the index is too large) of the table. BEFORE is ignored in this
+case.
+
This also updates the displayed table."
+ ;; FIXME: Inserting an object into an empty vtable currently isn't
+ ;; possible. `nconc' fails silently (twice), and `setcar' on the cache
+ ;; raises an error.
+ (if (null (vtable-objects table))
+ (error "[vtable] Cannot insert object into empty vtable"))
;; First insert into the objects.
- (let (pos)
- (if (and after-object
- (setq pos (memq after-object (vtable-objects table))))
- ;; Splice into list.
- (setcdr pos (cons object (cdr pos)))
- ;; Append.
- (nconc (vtable-objects table) (list object))))
+ (let ((pos (if location
+ (if (integerp location)
+ (prog1
+ (nthcdr location (vtable-objects table))
+ ;; Do not prepend if index is too large:
+ (setq before nil))
+ (or (memq location (vtable-objects table))
+ ;; Prepend if `location' is not found and
+ ;; `before' is non-nil:
+ (and before (vtable-objects table))))
+ ;; If `location' is nil and `before' is non-nil, we
+ ;; prepend the new object.
+ (if before (vtable-objects table)))))
+ (if (or before ; If `before' is non-nil, `pos' should be, as well.
+ (and pos (integerp location)))
+ ;; Add the new object before.
+ (let ((old-object (car pos)))
+ (setcar pos object)
+ (setcdr pos (cons old-object (cdr pos))))
+ ;; Otherwise, add the object after.
+ (if pos
+ ;; Splice the object into the list.
+ (setcdr pos (cons object (cdr pos)))
+ ;; Otherwise, append the object.
+ (nconc (vtable-objects table) (list object)))))
;; Then adjust the cache and display.
(save-excursion
(vtable-goto-table table)
@@ -372,19 +410,33 @@ This also updates the displayed table."
'face (vtable-face table))
""))
(ellipsis-width (string-pixel-width ellipsis))
- (elem (and after-object
- (assq after-object (car cache))))
+ (elem (if location ; This binding mirrors the binding of `pos'
above.
+ (if (integerp location)
+ (nth location (car cache))
+ (or (assq location (car cache))
+ (and before (caar cache))))
+ (if before (caar cache))))
+ (pos (memq elem (car cache)))
(line (cons object (vtable--compute-cached-line table object))))
- (if (not elem)
- ;; Append.
- (progn
- (setcar cache (nconc (car cache) (list line)))
- (vtable-end-of-table))
- ;; Splice into list.
- (let ((pos (memq elem (car cache))))
- (setcdr pos (cons line (cdr pos)))
- (unless (vtable-goto-object after-object)
- (vtable-end-of-table))))
+ (if (or before
+ (and pos (integerp location)))
+ ;; Add the new object before:.
+ (let ((old-line (car pos)))
+ (setcar pos line)
+ (setcdr pos (cons old-line (cdr pos)))
+ (unless (vtable-goto-object (car elem))
+ (vtable-beginning-of-table)))
+ ;; Otherwise, add the object after.
+ (if pos
+ ;; Splice the object into the list.
+ (progn
+ (setcdr pos (cons line (cdr pos)))
+ (if (vtable-goto-object location)
+ (forward-line 1) ; Insert *after*.
+ (vtable-end-of-table)))
+ ;; Otherwise, append the object.
+ (setcar cache (nconc (car cache) (list line)))
+ (vtable-end-of-table)))
(let ((start (point)))
;; FIXME: We have to adjust colors in lines below this if we
;; have :row-colors.
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 8b43c6a8726..68db33bfa68 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -120,6 +120,14 @@ so only the element (FOO) will match it.
See also `warning-suppress-log-types'."
:type '(repeat (repeat symbol))
:version "22.1")
+
+(defcustom warning-display-at-bottom t
+ "Display the warning buffer at the bottom of the screen.
+The output window will be scrolled to the bottom of the buffer
+to show the last warning message."
+ :type 'boolean
+ :version "30.1")
+
;; The autoload cookie is so that programs can bind this variable
;; safely, testing the existing value, before they call one of the
@@ -362,10 +370,21 @@ entirely by setting `warning-suppress-types' or
(or (< (warning-numeric-level level)
(warning-numeric-level warning-minimum-level))
(warning-suppress-p type warning-suppress-types)
- (let ((window (display-buffer buffer)))
- (when (and (markerp warning-series)
+ (let ((window (display-buffer
+ buffer
+ (when warning-display-at-bottom
+ '(display-buffer--maybe-at-bottom
+ (window-height . (lambda (window)
+ (fit-window-to-buffer window 10)))
+ (category . warning))))))
+ (when (and window (markerp warning-series)
(eq (marker-buffer warning-series) buffer))
(set-window-start window warning-series))
+ (when (and window warning-display-at-bottom)
+ (with-selected-window window
+ (goto-char (point-max))
+ (forward-line -1)
+ (recenter -1)))
(sit-for 0)))))))))
;; Use \\<special-mode-map> so that help-enable-autoload can do its thing.
diff --git a/lisp/env.el b/lisp/env.el
index e0a8df8476c..28f4f8a1d61 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -207,7 +207,8 @@ parameter.
Otherwise, this function searches `process-environment' for
VARIABLE. If it is not found there, then it continues the search
in the environment list of the selected frame."
- (declare (side-effect-free t))
+ (declare (ftype (function (string &optional frame) (or null string)))
+ (side-effect-free t))
(interactive (list (read-envvar-name "Get environment variable: " t)))
(let ((value (getenv-internal (if (multibyte-string-p variable)
(encode-coding-string
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index a4942e78de7..90cc91e99a0 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -267,7 +267,14 @@ encryption is used."
(setq file (expand-file-name file))
(let* ((coding-system (or coding-system-for-write
(if (fboundp 'select-safe-coding-system)
- (let ((buffer-file-name file))
+ ;; This is needed because
+ ;; `auto-coding-alist' has
+ ;; `no-conversion' for *.gpg files,
+ ;; which would otherwise force
+ ;; `select-safe-coding-system' return
+ ;; `no-conversion'.
+ (let ((buffer-file-name
+ (file-name-sans-extension file)))
(select-safe-coding-system
(point-min) (point-max)))
buffer-file-coding-system)))
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 9fc8a4d29f4..ef99d762a07 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -102,6 +102,7 @@
(require 'erc-common)
(defvar erc--display-context)
+(defvar erc--msg-prop-overrides)
(defvar erc--target)
(defvar erc-channel-list)
(defvar erc-channel-members)
@@ -787,7 +788,8 @@ TLS (see `erc-session-client-certificate' for more
details)."
;; MOTD line)
(if (eq (process-status process) 'connect)
;; waiting for a non-blocking connect - keep the user informed
- (progn
+ (let ((erc--msg-prop-overrides `((erc--skip . (stamp))
+ ,@erc--msg-prop-overrides)))
(erc-display-message nil nil buffer "Opening connection..\n")
(run-at-time 1 nil erc--server-connect-function process))
(message "%s...done" msg)
@@ -1536,6 +1538,8 @@ Finds hooks by looking in the `erc-server-responses' hash
table."
(let ((hook (or (erc-get-hook (erc-response.command message))
'erc-default-server-functions)))
(run-hook-with-args-until-success hook process message)
+ ;; Some handlers, like `erc-cmd-JOIN', open new targets without
+ ;; saving excursion, and `erc-open' sets the current buffer.
(erc-with-server-buffer
(run-hook-with-args 'erc-timer-hook (erc-current-time)))))
@@ -1879,6 +1883,9 @@ add things to `%s' instead."
(buffer (erc-get-buffer chnl proc)))
(pcase-let ((`(,nick ,login ,host)
(erc-parse-user (erc-response.sender parsed))))
+ ;; When `buffer' is nil, `erc-remove-channel-member' and
+ ;; `erc-remove-channel-users' do almost nothing, and the message
+ ;; is displayed in the server buffer.
(erc-remove-channel-member buffer nick)
(erc-display-message parsed 'notice buffer
'PART ?n nick ?u login
@@ -1892,8 +1899,10 @@ add things to `%s' instead."
(erc-delete-default-channel chnl buffer))
(erc-update-mode-line buffer)
(defvar erc-kill-buffer-on-part)
- (when erc-kill-buffer-on-part
- (kill-buffer buffer))))))
+ (when (and erc-kill-buffer-on-part buffer)
+ (defvar erc-killing-buffer-on-part-p)
+ (let ((erc-killing-buffer-on-part-p t))
+ (kill-buffer buffer)))))))
(define-erc-response-handler (PING)
"Handle ping messages." nil
@@ -1992,7 +2001,6 @@ like `erc-insert-modify-hook'.")
(and erc-ignore-reply-list (erc-ignored-reply-p msg tgt proc)))
(when erc-minibuffer-ignored
(message "Ignored %s from %s to %s" cmd sender-spec tgt))
- (defvar erc--msg-prop-overrides)
(let* ((sndr (erc-parse-user sender-spec))
(nick (nth 0 sndr))
(login (nth 1 sndr))
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 4b4930e5bff..8cf8991e57c 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -309,7 +309,9 @@ specified by `erc-button-alist'."
regexp)
(erc-button-remove-old-buttons)
(unless (or erc-button--has-nickname-entry
- (not erc-button-buttonize-nicks))
+ (not erc-button-buttonize-nicks)
+ (and (erc--memq-msg-prop 'erc--skip 'button)
+ (not (setq alist nil))))
(erc-button-add-nickname-buttons
`(_ _ erc-button--modify-nick-function
,erc-button-nickname-callback-function)))
@@ -830,7 +832,6 @@ argument when calling `erc-display-message'. Otherwise,
add it
to STRINGS. If STRINGS contains any trailing non-nil
non-strings, concatenate leading string members before applying
`format'. Otherwise, just concatenate everything."
- (defvar erc-stamp--skip)
(let* ((buffer (if (bufferp maybe-buffer)
maybe-buffer
(when (stringp maybe-buffer)
@@ -847,9 +848,11 @@ non-strings, concatenate leading string members before
applying
#'format))
(string (apply op strings))
;; Avoid timestamps unless left-sided.
- (erc-stamp--skip (or (bound-and-true-p erc-stamp--display-margin-mode)
- (not (fboundp 'erc-timestamp-offset))
- (zerop (erc-timestamp-offset))))
+ (skipp (or (bound-and-true-p erc-stamp--display-margin-mode)
+ (not (fboundp 'erc-timestamp-offset))
+ (zerop (erc-timestamp-offset))))
+ (erc--msg-prop-overrides `(,@(and skipp `((erc--skip stamp)))
+ ,@erc--msg-prop-overrides))
(erc-insert-post-hook
(cons (lambda ()
(setq string (buffer-substring (point-min)
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 8388efe062c..4115e314b39 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -617,6 +617,15 @@ the resulting variables will end up with more useful doc
strings."
"Return position of CHAR in STRING or nil if not found."
(inline-quote (string-search (string ,char) ,string)))
+(define-inline erc--solo (list-or-atom)
+ "If LIST-OR-ATOM is a list of one element, return that element.
+Otherwise, return LIST-OR-ATOM."
+ (inline-letevals (list-or-atom)
+ (inline-quote
+ (if (and (consp ,list-or-atom) (null (cdr ,list-or-atom)))
+ (car ,list-or-atom)
+ ,list-or-atom))))
+
(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-fill.el b/lisp/erc/erc-fill.el
index aa12b807fbc..b2c8c991c96 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -274,16 +274,10 @@ merged messages, see option
`erc-fill-wrap-merge-indicator'."
(defcustom erc-fill-wrap-merge-indicator nil
"Indicator to help distinguish between merged messages.
Only matters when the option `erc-fill-wrap-merge' is enabled.
-If the first element is the symbol `pre', ERC uses this option to
-generate a replacement for the speaker's name tag. If the first
-element is `post', ERC affixes a short string to the end of the
-previous message. In either case, the second element should be a
-character, like ?>, and the last element a valid face. In
-special cases, you may also specify a cons of either
-aforementioned symbol and a string, which tells ERC not to manage
-the process for you. If unsure, try either of the first two
-presets, both of which replace a continued speaker's name with a
-dot-product-like character in a `shadow'-like face.
+If the value is a cons of a character, like ?>, and a valid face,
+ERC generates a replacement for the speaker's name tag. The
+first two presets replace a continued speaker's name with a
+bullet-like character in `shadow' face.
Note that as of ERC 5.6, this option is still experimental, and
changing its value mid-session is not yet supported (though, if
@@ -300,20 +294,14 @@ command."
:type
'(choice (const nil)
(const :tag "Leading MIDDLE DOT (U+00B7) as speaker"
- (pre #xb7 erc-fill-wrap-merge-indicator-face))
+ (#xb7 . erc-fill-wrap-merge-indicator-face))
(const :tag "Leading MIDDLE DOT (U+00B7) sans gap"
- (pre . #("\u00b7" 0 1 (font-lock-face
- erc-fill-wrap-merge-indicator-face))))
+ #("\u00b7"
+ 0 1 (font-lock-face erc-fill-wrap-merge-indicator-face)))
(const :tag "Leading RIGHT-ANGLE BRACKET (>) as speaker"
- (pre ?> erc-fill-wrap-merge-indicator-face))
- (const :tag "Trailing PARAGRAPH SIGN (U+00B6)"
- (post #xb6 erc-fill-wrap-merge-indicator-face))
- (const :tag "Trailing TILDE (~)"
- (post ?~ erc-fill-wrap-merge-indicator-face))
- (cons :tag "User-provided string (advanced)"
- (choice (const pre) (const post)) string)
- (list :tag "User-provided character-face pairing"
- (choice (const pre) (const post)) character face)))
+ (?> . erc-fill-wrap-merge-indicator-face))
+ (string :tag "User-provided string (advanced)")
+ (cons :tag "User-provided character-face pairing" character face)))
(defun erc-fill--wrap-move (normal-cmd visual-cmd &rest args)
(apply (pcase erc-fill--wrap-visual-keys
@@ -330,24 +318,30 @@ command."
;; `kill-line' anyway so that users can see the error.
(erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
-(defun erc-fill--wrap-escape-hidden-speaker ()
+(defun erc-fill--wrap-escape-hidden-speaker (&optional old-point)
"Move to start of message text when left of speaker.
-Basically mimic what `move-beginning-of-line' does with invisible text."
+Basically mimic what `move-beginning-of-line' does with invisible text.
+Stay put if OLD-POINT lies within hidden region."
(when-let ((erc-fill-wrap-merge)
- (prop (get-text-property (point) 'display))
- ((or (equal prop "") (eq 'margin (car-safe (car-safe prop))))))
- (goto-char (text-property-not-all (point) (pos-eol) 'display prop))))
+ (prop (get-text-property (point) 'erc-fill--wrap-merge))
+ ((or (member prop '("" t))
+ (eq 'margin (car-safe (car-safe prop)))))
+ (end (text-property-not-all (point) (pos-eol)
+ 'erc-fill--wrap-merge prop))
+ ((or (null old-point) (>= old-point end))))
+ (goto-char end)))
(defun erc-fill--wrap-beginning-of-line (arg)
"Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
(interactive "^p")
- (let ((inhibit-field-text-motion t))
- (erc-fill--wrap-move #'move-beginning-of-line
- #'beginning-of-visual-line arg))
- (if (get-text-property (point) 'erc-prompt)
- (goto-char erc-input-marker)
- ;; Mimic what `move-beginning-of-line' does with invisible text.
- (erc-fill--wrap-escape-hidden-speaker)))
+ (let ((opoint (point)))
+ (let ((inhibit-field-text-motion t))
+ (erc-fill--wrap-move #'move-beginning-of-line
+ #'beginning-of-visual-line arg))
+ (if (get-text-property (point) 'erc-prompt)
+ (goto-char erc-input-marker)
+ (when erc-fill-wrap-merge
+ (erc-fill--wrap-escape-hidden-speaker opoint)))))
(defun erc-fill--wrap-previous-line (&optional arg try-vscroll)
"Move to ARGth previous logical or screen line."
@@ -359,7 +353,8 @@ Basically mimic what `move-beginning-of-line' does with
invisible text."
(erc-fill--wrap-move (if visp #'previous-line #'previous-logical-line)
#'previous-line
arg try-vscroll))
- (erc-fill--wrap-escape-hidden-speaker)))
+ (when erc-fill-wrap-merge
+ (erc-fill--wrap-escape-hidden-speaker))))
(defun erc-fill--wrap-next-line (&optional arg try-vscroll)
"Move to ARGth next logical or screen line."
@@ -368,7 +363,9 @@ Basically mimic what `move-beginning-of-line' does with
invisible text."
erc-fill-wrap-force-screen-line-movement)))
(erc-fill--wrap-move (if visp #'next-line #'next-logical-line)
#'next-line
- arg try-vscroll)))
+ arg try-vscroll)
+ (when erc-fill-wrap-merge
+ (erc-fill--wrap-escape-hidden-speaker))))
(defun erc-fill--wrap-end-of-line (arg)
"Defer to `move-end-of-line' or `end-of-visual-line'."
@@ -459,6 +456,28 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
" warning. See Info:\"(erc) Modules\" for more."
(mapcar (lambda (s) (format "`%s'" s)) missing-deps)))))
+(defun erc-fill--wrap-massage-legacy-indicator-type ()
+ "Migrate obsolete 5.6-git `erc-fill-wrap-merge-indicator' format."
+ (pcase erc-fill-wrap-merge-indicator
+ (`(post . ,_)
+ (erc--warn-once-before-connect 'erc-fill-wrap-mode
+ "The option `erc-fill-wrap-merge-indicator' has changed. Unfortunately,"
+ " the `post' variant and related presets are no longer available."
+ " Setting to nil for the current session. Apologies for the disruption."
+ (setq erc-fill-wrap-merge-indicator nil)))
+ (`(pre . ,(and (pred stringp) string))
+ (erc--warn-once-before-connect 'erc-fill-wrap-mode
+ "The format of option `erc-fill-wrap-merge-indicator' has changed"
+ " from a cons of (pre . STRING) to STRING. Please update your settings."
+ " Changing temporarily to \"" string "\" for the current session.")
+ (setq erc-fill-wrap-merge-indicator string))
+ (`(pre ,(and (pred characterp) char) ,face)
+ (erc--warn-once-before-connect 'erc-fill-wrap-mode
+ "The format of option `erc-fill-wrap-merge-indicator' has changed"
+ " from (pre CHAR FACE) to a cons of (CHAR . FACE). Please update"
+ " when possible. Changing temporarily to %S for the current session."
+ (setq erc-fill-wrap-merge-indicator (cons char face))))))
+
;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
(define-erc-module fill-wrap nil
"Fill style leveraging `visual-line-mode'.
@@ -505,6 +524,8 @@ 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)
+ (when erc-fill-wrap-merge-indicator
+ (erc-fill--wrap-massage-legacy-indicator-type))
(erc--restore-initialize-priors erc-fill-wrap-mode
erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys
erc-fill--wrap-value erc-fill-static-center
@@ -536,7 +557,6 @@ via `erc-fill-wrap-mode-hook'."
(kill-local-variable 'erc-fill--wrap-last-msg)
(kill-local-variable 'erc--inhibit-prompt-display-property-p)
(kill-local-variable 'erc-fill--wrap-merge-indicator-pre)
- (kill-local-variable 'erc-fill--wrap-merge-indicator-post)
(remove-hook 'erc--refresh-prompt-hook
#'erc-fill--wrap-indent-prompt)
(remove-hook 'erc-button--prev-next-predicate-functions
@@ -612,50 +632,25 @@ to be disabled."
"Whether to dedent speakers in CTCP \"ACTION\" lines.")
(defvar-local erc-fill--wrap-merge-indicator-pre nil)
-(defvar-local erc-fill--wrap-merge-indicator-post nil)
-
-;; To support `erc-fill-line-spacing' with the "post" variant, we'd
-;; need to use a new "replacing" `display' spec value for each
-;; insertion, and add a sentinel property alongside it atop every
-;; affected newline, e.g., (erc-fill-eol-display START-POS), where
-;; START-POS is the position of the newline in the replacing string.
-;; Then, upon spotting this sentinel in `erc-fill' (and maybe
-;; `erc-fill-wrap-refill-buffer'), we'd add `line-spacing' to the
-;; corresponding `display' replacement, starting at START-POS.
-(defun erc-fill--wrap-insert-merged-post ()
- "Add `display' property at end of previous line."
- (save-excursion
- (goto-char (point-min))
- (save-restriction
- (widen)
- (cl-assert (= ?\n (char-before (point))))
- (unless erc-fill--wrap-merge-indicator-post
- (let ((option (cdr erc-fill-wrap-merge-indicator)))
- (setq erc-fill--wrap-merge-indicator-post
- (if (stringp option)
- (concat option
- (and (not (string-suffix-p "\n" option)) "\n"))
- (propertize (concat (string (car option)) "\n")
- 'font-lock-face (cadr option))))))
- (unless (eq (field-at-pos (- (point) 2)) 'erc-timestamp)
- (put-text-property (1- (point)) (point)
- 'display erc-fill--wrap-merge-indicator-post)))
- 0))
(defun erc-fill--wrap-insert-merged-pre ()
- "Add `display' property in lieu of speaker."
+ "Add `display' text property to speaker.
+Also cover region with text prop `erc-fill--wrap-merge' set to t."
(if erc-fill--wrap-merge-indicator-pre
(progn
- (put-text-property (point-min) (point) 'display
- (car erc-fill--wrap-merge-indicator-pre))
+ (add-text-properties (point-min) (point)
+ (list 'display
+ (car erc-fill--wrap-merge-indicator-pre)
+ 'erc-fill--wrap-merge t))
(cdr erc-fill--wrap-merge-indicator-pre))
- (let* ((option (cdr erc-fill-wrap-merge-indicator))
+ (let* ((option erc-fill-wrap-merge-indicator)
(s (if (stringp option)
(concat option)
(concat (propertize (string (car option))
- 'font-lock-face (cadr option))
+ 'font-lock-face (cdr option))
" "))))
- (put-text-property (point-min) (point) 'display s)
+ (add-text-properties (point-min) (point)
+ (list 'display s 'erc-fill--wrap-merge t))
(cdr (setq erc-fill--wrap-merge-indicator-pre
(cons s (erc-fill--wrap-measure (point-min) (point))))))))
@@ -679,8 +674,6 @@ See `erc-fill-wrap-mode' for details."
(skip-syntax-forward "^-")
(forward-char)
(cond ((eq msg-prop 'datestamp)
- (when erc-fill--wrap-last-msg
- (set-marker erc-fill--wrap-last-msg (point-min)))
(save-excursion
(goto-char (point-max))
(skip-chars-backward "\n")
@@ -690,12 +683,11 @@ See `erc-fill-wrap-mode' for details."
(delete-region (1- (point)) (point))))))
((and erc-fill-wrap-merge
(erc-fill--wrap-continued-message-p))
- (put-text-property (point-min) (point)
- 'display "")
+ (add-text-properties
+ (point-min) (point)
+ '(display "" erc-fill--wrap-merge ""))
(if erc-fill-wrap-merge-indicator
- (pcase (car erc-fill-wrap-merge-indicator)
- ('pre (erc-fill--wrap-insert-merged-pre))
- ('post (erc-fill--wrap-insert-merged-post)))
+ (erc-fill--wrap-insert-merged-pre)
0))
(t
(erc-fill--wrap-measure (point-min) (point))))))))
@@ -731,10 +723,9 @@ stash and restore `erc-fill--wrap-last-msg' before doing
so, in
case this module's insert hooks run by way of the process filter.
With REPAIRP, destructively fill gaps and re-merge speakers."
(goto-char start)
- (cl-assert (null erc-fill--wrap-rejigger-last-message))
- (setq erc-fill--wrap-merge-indicator-pre nil
- erc-fill--wrap-merge-indicator-post nil)
- (let (erc-fill--wrap-rejigger-last-message)
+ (setq erc-fill--wrap-merge-indicator-pre nil)
+ (let ((erc-fill--wrap-rejigger-last-message
+ erc-fill--wrap-rejigger-last-message))
(while-let
(((< (point) finish))
(beg (if (get-text-property (point) 'line-prefix)
@@ -745,12 +736,13 @@ With REPAIRP, destructively fill gaps and re-merge
speakers."
;; If this is a left-side stamp on its own line.
(remove-text-properties beg (1+ end) '(line-prefix nil wrap-prefix nil))
(when-let ((repairp)
- (dbeg (text-property-not-all beg end 'display nil))
+ (dbeg (text-property-not-all beg end
+ 'erc-fill--wrap-merge nil))
((get-text-property (1+ dbeg) 'erc--speaker))
- (dval (get-text-property dbeg 'display))
- ((equal "" dval)))
- (remove-text-properties
- dbeg (text-property-not-all dbeg end 'display dval) '(display)))
+ (dval (get-text-property dbeg 'erc-fill--wrap-merge)))
+ (remove-list-of-text-properties
+ dbeg (text-property-not-all dbeg end 'erc-fill--wrap-merge dval)
+ '(display erc-fill--wrap-merge)))
;; This "should" work w/o `front-sticky' and `rear-nonsticky'.
(let* ((pos (if-let (((eq 'erc-timestamp (field-at-pos beg)))
(b (field-beginning beg))
@@ -798,9 +790,8 @@ like `erc-match-toggle-hidden-fools'."
callback repair)
(progress-reporter-done rep)))))
-;; FIXME use own text property to avoid false positives.
(defun erc-fill--wrap-merged-button-p (point)
- (equal "" (get-text-property point 'display)))
+ (get-text-property point 'erc-fill--wrap-merge))
(defun erc-fill--wrap-nudge (arg)
(when (zerop arg)
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index d5c56bcc2b3..66420662c23 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -289,8 +289,8 @@ Return nil if BUFFER is a server buffer."
(erc-save-buffer-in-logs)))
(defun erc-conditional-save-buffer (buffer)
- "Save Query BUFFER if `erc-save-queries-on-quit' is t."
- (when erc-save-buffer-on-part
+ "Save channel BUFFER if it and `erc-save-buffer-on-part' are non-nil."
+ (when (and buffer erc-save-buffer-on-part)
(erc-save-buffer-in-logs buffer)))
(defun erc-conditional-save-queries (process)
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 1b26afa1164..a5ca05b137a 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -50,6 +50,7 @@
(defvar erc-server-process)
(declare-function erc--get-isupport-entry "erc-backend" (key &optional single))
+(declare-function erc--insert-admin-message "erc" (&rest args))
(declare-function erc-buffer-filter "erc" (predicate &optional proc))
(declare-function erc-current-nick "erc" nil)
(declare-function erc-display-error-notice "erc" (parsed string))
@@ -1345,24 +1346,38 @@ Copy source (prefix) from MOTD-ish message as a last
resort."
(setq erc-network nil)
nil)
-;; TODO add note in Commentary saying that this module is considered a
-;; core module and that it's as much about buffer naming and network
-;; identity as anything else.
-
-(defun erc-networks--insert-transplanted-content (content)
- (let ((inhibit-read-only t)
- (buffer-undo-list t))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (insert-before-markers content)))))
+(defun erc-networks--transplant-buffer-content (src dest)
+ "Insert buffer SRC's contents into DEST, above its contents."
+ (with-silent-modifications
+ (let ((content (with-current-buffer src
+ (cl-assert (not (buffer-narrowed-p)))
+ (erc--insert-admin-message 'graft ?n dest ?o src)
+ (buffer-substring (point-min) erc-insert-marker))))
+ (with-current-buffer dest
+ (save-excursion
+ (save-restriction
+ (cl-assert (not (buffer-narrowed-p)))
+ (goto-char (point-min))
+ (while (and (eql ?\n (char-after (point)))
+ (null (text-properties-at (point))))
+ (delete-char 1))
+ (insert-before-markers content)))))))
+
+(defvar erc-networks--transplant-target-buffer-function
+ #'erc-networks--transplant-buffer-content
+ "Function to rename and merge the contents of two target buffers.
+Called with the donating buffer to be killed and buffer to receive the
+transplant. Consuming modules can leave a marker at the beginning of
+the latter buffer to access the insertion point, if needing to do things
+like adjust invisibility properties, etc.")
+
+(defvar erc-networks--target-transplant-in-progress-p nil
+ "Non-nil when merging target buffers.")
;; This should run whenever a network identity is updated.
-
(defun erc-networks--reclaim-orphaned-target-buffers (new-proc nid announced)
"Visit disowned buffers for same NID and associate with NEW-PROC.
-ANNOUNCED is the server's reported host name."
+Expect ANNOUNCED to be the server's reported host name."
(erc-buffer-filter
(lambda ()
(when (and erc--target
@@ -1372,20 +1387,26 @@ ANNOUNCED is the server's reported host name."
(string= erc-server-announced-name announced)))
;; If a target buffer exists for the current process, kill this
;; stale one after transplanting its content; else reinstate.
- (if-let ((existing (erc-get-buffer
- (erc--target-string erc--target) new-proc)))
+ (if-let ((actual (erc-get-buffer (erc--target-string erc--target)
+ new-proc))
+ (erc-networks--target-transplant-in-progress-p t))
(progn
- (widen)
- (let ((content (buffer-substring (point-min)
- erc-insert-marker)))
- (kill-buffer) ; allow target-buf renaming hook to run
- (with-current-buffer existing
- (erc-networks--ensure-unique-target-buffer-name)
- (erc-networks--insert-transplanted-content content))))
+ (funcall erc-networks--transplant-target-buffer-function
+ (current-buffer) actual)
+ (kill-buffer (current-buffer))
+ (with-current-buffer actual
+ (erc-networks--ensure-unique-target-buffer-name)))
(setq erc-server-process new-proc
erc-server-connected t
erc-networks--id nid))))))
+;; For existing buffers, `erc-open' reinitializes a core set of local
+;; variables in addition to some text, such as the prompt. It expects
+;; module activation functions to do the same for assets they manage.
+;; However, "stateful" modules, whose functionality depends on the
+;; evolution of a buffer's content, may need to reconcile state during
+;; a merge. An example might be a module that provides consistent
+;; timestamps: it should ensure time values don't decrease.
(defvar erc-networks--copy-server-buffer-functions nil
"Abnormal hook run in new server buffers when deduping.
Passed the existing buffer to be killed, whose contents have
@@ -1393,26 +1414,18 @@ already been copied over to the current, replacement
buffer.")
(defun erc-networks--copy-over-server-buffer-contents (existing name)
"Kill off existing server buffer after copying its contents.
-Must be called from the replacement buffer."
+Expect to be called from the replacement buffer."
(defvar erc-kill-buffer-hook)
(defvar erc-kill-server-hook)
- ;; ERC expects `erc-open' to be idempotent when setting up local
- ;; vars and other context properties for a new identity. Thus, it's
- ;; unlikely we'll have to copy anything else over besides text. And
- ;; no reconciling of user tables, etc. happens during a normal
- ;; reconnect, so we should be fine just sticking to text. (Right?)
- (let ((text (with-current-buffer existing
- ;; This `erc-networks--id' should be
- ;; `erc-networks--id-equal-p' to caller's network
- ;; identity and older if not eq.
- ;;
- ;; `erc-server-process' should be set but dead
- ;; and eq `get-buffer-process' unless latter nil
- (delete-process erc-server-process)
- (buffer-substring (point-min) erc-insert-marker)))
- erc-kill-server-hook
- erc-kill-buffer-hook)
- (erc-networks--insert-transplanted-content text)
+ ;; The following observations from ERC 5.5 regarding the buffer
+ ;; `existing' were thought at the time to be invariants:
+ ;; - `erc-networks--id' is `erc-networks--id-equal-p' to the
+ ;; caller's network identity and older if not `eq'.
+ ;; - `erc-server-process' should be set (local) but dead and `eq' to
+ ;; the result of `get-buffer-process' unless the latter is nil.
+ (delete-process (buffer-local-value 'erc-server-process existing))
+ (erc-networks--transplant-buffer-content existing (current-buffer))
+ (let (erc-kill-server-hook erc-kill-buffer-hook)
(run-hook-with-args 'erc-networks--copy-server-buffer-functions existing)
(kill-buffer name)))
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index 92cb9075b5e..0881006ed77 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -22,6 +22,13 @@
;;; Commentary:
+;; As of ERC 5.6, this library's main module, `services', mainly
+;; concerns itself with authenticating to legacy IRC servers. If your
+;; server supports SASL or CERTFP, please use one of those instead.
+;; See (info "(erc) client-certificate") and (info "(erc) SASL") for
+;; details. Note that this library also contains the local module
+;; `services-regain' as well as standalone utility functions.
+
;; There are two ways to go about identifying yourself automatically to
;; NickServ with this module. The more secure way is to listen for identify
;; requests from the user NickServ. Another way is to identify yourself to
@@ -37,10 +44,7 @@
;; Usage:
;;
-;; Put into your .emacs:
-;;
-;; (require 'erc-services)
-;; (erc-services-mode 1)
+;; Customize the option `erc-modules' to include `services'.
;;
;; Add your nickname and NickServ password to `erc-nickserv-passwords'.
;; Using the Libera.Chat network as an example:
@@ -50,10 +54,7 @@
;;
;; The default automatic identification mode is autodetection of NickServ
;; identify requests. Set the variable `erc-nickserv-identify-mode' if
-;; you'd like to change this behavior. You can also change the way
-;; automatic identification is handled by using:
-;;
-;; M-x erc-nickserv-identify-mode
+;; you'd like to change this behavior.
;;
;; If you'd rather not identify yourself automatically but would like access
;; to the functions contained in this file, just load this file without
@@ -309,21 +310,26 @@ Example of use:
"/msg\\s-NickServ\\s-IDENTIFY\\s-\^_password"
"NickServ@services.slashnet.org"
"IDENTIFY" nil nil nil))
- "Alist of NickServer details, sorted by network.
+ "Alist of NickServer details, sorted by network.
Every element in the list has the form
- (SYMBOL NICKSERV REGEXP NICK KEYWORD USE-CURRENT ANSWER SUCCESS-REGEXP)
-
-SYMBOL is a network identifier, a symbol, as used in `erc-networks-alist'.
-NICKSERV is the description of the nickserv in the form nick!user@host.
-REGEXP is a regular expression matching the message from nickserv.
-NICK is nickserv's nickname. Use nick@server where necessary/possible.
-KEYWORD is the keyword to use in the reply message to identify yourself.
-USE-CURRENT indicates whether the current nickname must be used when
- identifying.
-ANSWER is the command to use for the answer. The default is `privmsg'.
-SUCCESS-REGEXP is a regular expression matching the message nickserv
- sends when you've successfully identified.
-The last two elements are optional."
+ (NETWORK SENDER INSTRUCT-RX NICK SUBCMD YOUR-NICK-P ANSWER SUCCESS-RX)
+
+NETWORK is a network identifier, a symbol, as used in `erc-networks-alist'.
+SENDER is the exact nick!user@host \"source\" for \"NOTICE\" messages
+indicating success or requesting that the user identify.
+INSTRUCT-RX is a regular expression matching a \"NOTICE\" from the
+ services bot instructing the user to identify. It must be non-null
+ when the option `erc-nickserv-identify-mode' is set to `autodetect'.
+ When it's `both', and this field is non-null, ERC will forgo
+ identifying on nick changes and after connecting.
+NICK is the nickname of the services bot to use when issuing commands.
+SUBCMD is the bot command for identifying, typically \"IDENTIFY\".
+YOUR-NICK-P indicates whether to send the user's current nickname before
+ their password when identifying.
+ANSWER is the command to use for the answer. The default is \"PRIVMSG\".
+SUCCESS-RX is a regular expression matching the message NickServ sends
+ when you've successfully identified.
+The last two elements are optional, as are others, where implied."
:type '(repeat
(list :tag "Nickserv data"
(symbol :tag "Network name")
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index bcb9b4aafef..a9ffdb18ba7 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -202,7 +202,8 @@ from entering them and instead jump over them."
(when-let ((priors (or erc--server-reconnecting erc--target-priors)))
(dolist (var '(erc-timestamp-last-inserted
erc-timestamp-last-inserted-left
- erc-timestamp-last-inserted-right))
+ erc-timestamp-last-inserted-right
+ erc-stamp--date-stamps))
(when-let (existing (alist-get var priors))
(set var existing)))))
@@ -219,10 +220,7 @@ This becomes the message's `erc--ts' text property."
(cl-defmethod erc-stamp--current-time :around ()
(or erc-stamp--current-time (cl-call-next-method)))
-(defvar erc-stamp--skip nil
- "Non-nil means inhibit `erc-add-timestamp' completely.")
-
-(defvar erc-stamp--allow-unmanaged nil
+(defvar erc-stamp--allow-unmanaged-p nil
"Non-nil means run `erc-add-timestamp' almost unconditionally.
This is an unofficial escape hatch for code wanting to use
lower-level message-insertion functions, like `erc-insert-line',
@@ -242,9 +240,11 @@ known via \\[erc-bug].")
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
- (unless (or erc-stamp--skip (and (not erc-stamp--allow-unmanaged)
- (null erc--msg-props)))
- (let* ((ct (erc-stamp--current-time))
+ (unless (and (not erc-stamp--allow-unmanaged-p)
+ (or (null erc--msg-props)
+ (erc--memq-msg-prop 'erc--skip 'stamp)))
+ (let* ((ct (or (erc--check-msg-prop 'erc--ts)
+ (erc-stamp--current-time)))
(invisible (get-text-property (point-min) 'invisible))
(erc-stamp--invisible-property
;; FIXME on major version bump, make this `erc-' prefixed.
@@ -652,7 +652,7 @@ printed just after each line's text (no alignment)."
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
(defvar erc-stamp--insert-date-hook nil
- "Functions appended to send and modify hooks when inserting date stamp.")
+ "Hook run when inserting a date stamp.")
(defvar-local erc-stamp--date-format-end nil
"Tristate value indicating how and whether date stamps have been set up.
@@ -661,9 +661,27 @@ stamps. An integer marks the `substring' TO parameter for
truncating `erc-timestamp-format-left' prior to rendering. A
value of t means the option's value doesn't require trimming.")
-(defun erc-stamp--propertize-left-date-stamp ()
+;; This struct and its namesake variable exist to assist in testing.
+(cl-defstruct erc-stamp--date
+ "Data relevant to life cycle of date-stamp insertion."
+ ( ts (error "Missing `ts' field") :type (or cons integer)
+ :documentation "Time recorded by `erc-insert-timestamp-left-and-right'.")
+ ( str (error "Missing `str' field") :type string
+ :documentation "Stamp rendered by `erc-insert-timestamp-left-and-right'.")
+ ( fn nil :type (or null function)
+ :documentation "Deferred insertion function created by post-modify hook.")
+ ( marker (make-marker) :type marker
+ :documentation "Insertion marker."))
+
+(defvar-local erc-stamp--deferred-date-stamp nil
+ "Active `erc-stamp--date' instance.
+Non-nil between insertion-modification and \"done\" (or timer) hook.")
+
+(defvar-local erc-stamp--date-stamps nil
+ "List of stamps in the current buffer.")
+
+(defun erc-stamp--propertize-left-date-stamp (&rest _)
(add-text-properties (point-min) (1- (point-max)) '(field erc-timestamp))
- (erc--hide-message 'timestamp)
(run-hooks 'erc-stamp--insert-date-hook))
(defun erc-stamp--format-date-stamp (ct)
@@ -680,6 +698,16 @@ value of t means the option's value doesn't require
trimming.")
0 erc-stamp--date-format-end)
erc-timestamp-format-left))))
+(defun erc-stamp--find-insertion-point (p target-time)
+ "Scan buffer backwards from P looking for TARGET-TIME.
+Return P or, if found, a position less than P."
+ (while-let ((q (previous-single-property-change (1- p) 'erc--ts))
+ (qq (erc--get-inserted-msg-beg q))
+ (ts (get-text-property qq 'erc--ts))
+ ((not (time-less-p ts target-time))))
+ (setq p qq))
+ p)
+
(defun erc-stamp-inserting-date-stamp-p ()
"Return non-nil if the narrowed buffer contains a date stamp.
Expect to be called by members of `erc-insert-modify-hook' and
@@ -687,75 +715,88 @@ Expect to be called by members of
`erc-insert-modify-hook' and
inserted is a date stamp."
(erc--check-msg-prop 'erc--msg 'datestamp))
-;; Calling `erc-display-message' from within a hook it's currently
-;; running is roundabout, but it's a definite means of ensuring hooks
-;; can act on the date stamp as a standalone message to do things like
-;; adjust invisibility props.
-(defun erc-stamp--insert-date-stamp-as-phony-message (string)
- (cl-assert (string-empty-p string))
- (setq string erc-timestamp-last-inserted-left)
- (let ((erc-stamp--skip t)
- (erc-insert-modify-hook `(,@erc-insert-modify-hook
- erc-stamp--propertize-left-date-stamp))
- (erc--insert-line-function #'insert-before-markers)
- ;; Don't run hooks that aren't expecting a narrowed buffer.
- (erc-insert-pre-hook nil)
- (erc-insert-done-hook nil))
- (erc-display-message nil nil (current-buffer) string)))
-
-(defun erc-stamp--lr-date-on-pre-modify (_)
- (when-let (((not erc-stamp--skip))
- (ct (erc-stamp--current-time))
- (rendered (erc-stamp--format-date-stamp ct))
- ((not (string-equal rendered erc-timestamp-last-inserted-left)))
- (erc-insert-timestamp-function
- #'erc-stamp--insert-date-stamp-as-phony-message))
- (save-excursion
- (save-restriction
- (narrow-to-region (or erc--insert-marker erc-insert-marker)
- (or erc--insert-marker erc-insert-marker))
- ;; Ensure all hooks, like `erc-stamp--insert-date-hook', only
- ;; see the let-bound value below during `erc-add-timestamp'.
- (setq erc-timestamp-last-inserted-left nil)
- (let* ((aligned (erc-stamp--time-as-day ct))
- (erc-stamp--current-time aligned)
- ;; Forget current `erc--cmd', etc.
- (erc--msg-props (map-into `((erc--msg . datestamp))
- 'hash-table))
- (erc-timestamp-last-inserted-left rendered)
- erc-timestamp-format erc-away-timestamp-format)
- (erc-add-timestamp))
- (setq erc-timestamp-last-inserted-left rendered)))))
-
-;; This minor mode is just a placeholder and currently unhelpful for
-;; managing complexity. A useful version would leave a marker during
-;; post-modify hooks and then perform insertions (before markers)
-;; during "done" hooks. This would enable completely decoupling from
-;; and possibly deprecating `erc-insert-timestamp-left-and-right'.
-;; However, doing this would require expanding the internal API to
-;; include insertion and deletion handlers for twiddling and massaging
-;; text properties based on context immediately after modifying text
-;; earlier in a buffer (away from `erc-insert-marker'). Without such
-;; handlers, things like "merged" `fill-wrap' speakers and invisible
-;; messages may be damaged by buffer modifications.
+(defun erc-stamp--defer-date-insertion-on-post-modify (hook-var)
+ "Schedule a date stamp to be inserted via HOOK-VAR.
+Do so when `erc-stamp--deferred-date-stamp' and its `fn' slot are
+non-nil."
+ (when-let ((data erc-stamp--deferred-date-stamp)
+ ((null (erc-stamp--date-fn data)))
+ (ct (erc-stamp--date-ts data))
+ (rendered (erc-stamp--date-str data))
+ (buffer (current-buffer))
+ (symbol (make-symbol "erc-stamp--insert-date"))
+ (marker (setf (erc-stamp--date-marker data) (point-min-marker))))
+ (setf (erc-stamp--date-fn data) symbol)
+ (fset symbol
+ (lambda (&rest _)
+ (remove-hook hook-var symbol)
+ (setf (erc-stamp--date-fn data) #'ignore)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (setq erc-stamp--date-stamps
+ (cl-sort (cons data erc-stamp--date-stamps) #'time-less-p
+ :key #'erc-stamp--date-ts))
+ (setq erc-stamp--deferred-date-stamp nil)
+ (let* ((aligned (erc-stamp--time-as-day ct))
+ (erc-stamp--current-time aligned)
+ (erc--msg-props (map-into '((erc--msg . datestamp)
+ (erc--skip track))
+ 'hash-table))
+ (erc-insert-post-hook
+ `(,(lambda ()
+ (set-marker marker (point-min))
+ (set-marker-insertion-type marker t)
+ (erc--hide-message 'timestamp))
+ ,@erc-insert-post-hook))
+ (erc-insert-timestamp-function
+ #'erc-stamp--propertize-left-date-stamp)
+ (pos (erc-stamp--find-insertion-point marker aligned))
+ ;;
+ erc-timestamp-format erc-away-timestamp-format)
+ (erc--with-spliced-insertion pos
+ (erc-display-message nil nil (current-buffer) rendered))
+ (setf (erc-stamp--date-ts data) aligned))
+ (setq erc-timestamp-last-inserted-left rendered)))))
+ (add-hook hook-var symbol -90)))
+
+(defun erc-stamp--defer-date-insertion-on-post-insert ()
+ (erc-stamp--defer-date-insertion-on-post-modify 'erc-timer-hook))
+
+(defun erc-stamp--defer-date-insertion-on-post-send ()
+ (erc-stamp--defer-date-insertion-on-post-modify 'erc-send-completed-hook))
+
+;; This minor mode is hopefully just a placeholder because it's quite
+;; unhelpful for managing complexity. A useful version would exist as
+;; a standalone module to allow completely decoupling from and
+;; possibly deprecating `erc-insert-timestamp-left-and-right'.
(define-minor-mode erc-stamp--date-mode
"Insert date stamps as standalone messages."
:interactive nil
(if erc-stamp--date-mode
- (progn (add-hook 'erc-insert-pre-hook
- #'erc-stamp--lr-date-on-pre-modify 10 t)
- (add-hook 'erc-pre-send-functions
- #'erc-stamp--lr-date-on-pre-modify 10 t))
+ (progn
+ (add-function :around
+ (local 'erc-networks--transplant-target-buffer-function)
+ #'erc-stamp--dedupe-date-stamps-from-target-buffer)
+ (add-hook 'erc-networks--copy-server-buffer-functions
+ #'erc-stamp--dedupe-date-stamps-from-buffer 0 t)
+ (add-hook 'erc-insert-post-hook
+ #'erc-stamp--defer-date-insertion-on-post-insert 0 t)
+ (add-hook 'erc-send-post-hook
+ #'erc-stamp--defer-date-insertion-on-post-send 0 t))
(kill-local-variable 'erc-timestamp-last-inserted-left)
- (remove-hook 'erc-insert-pre-hook
- #'erc-stamp--lr-date-on-pre-modify t)
- (remove-hook 'erc-pre-send-functions
- #'erc-stamp--lr-date-on-pre-modify t)))
+ (remove-function (local 'erc-networks--transplant-target-buffer-function)
+ #'erc-stamp--dedupe-date-stamps-from-target-buffer)
+ (remove-hook 'erc-networks--copy-server-buffer-functions
+ #'erc-stamp--dedupe-date-stamps-from-buffer t)
+ (remove-hook 'erc-insert-post-hook
+ #'erc-stamp--defer-date-insertion-on-post-insert t)
+ (remove-hook 'erc-send-post-hook
+ #'erc-stamp--defer-date-insertion-on-post-send t)))
(defvar erc-stamp-prepend-date-stamps-p nil
"When non-nil, date stamps are not independent messages.
-This flag restores pre-5.6 behavior in which date stamps formed
-the leading portion of affected messages. Beware that enabling
+This flag restores pre-5.6 behavior in which date stamps were
+prepended to normal chat messages. Beware that enabling
this degrades the user experience by causing 5.6+ features, like
`fill-wrap', dynamic invisibility, etc., to malfunction. When
non-nil, none of the newline twiddling mentioned in the doc
@@ -775,26 +816,17 @@ in the latter (if any) as part of the `erc-timestamp'
field.
Allow the stamp's `invisible' property to span that same interval
but also cover the previous newline, in order to satisfy folding
requirements related to `erc-legacy-invisible-bounds-p'.
-Additionally, ensure every date stamp is identifiable as such so
-that internal modules can easily distinguish between other
-left-sided stamps and date stamps inserted by this function."
+Additionally, ensure every date stamp is identifiable as such via
+the function `erc-stamp-inserting-date-stamp-p' so that internal
+modules can easily distinguish between other left-sided stamps
+and date stamps inserted by this function."
(unless (or erc-stamp--date-format-end erc-stamp-prepend-date-stamps-p
(and (or (null erc-timestamp-format-left)
(string-empty-p ; compat
(string-trim erc-timestamp-format-left "\n")))
(always (erc-stamp--date-mode -1))
(setq erc-stamp-prepend-date-stamps-p t)))
- (erc-stamp--date-mode +1)
- ;; Hooks used by ^ are the preferred means of inserting date
- ;; stamps. But they'll never see this inaugural message, so it
- ;; must be handled specially.
- (let ((erc--insert-marker (point-min-marker))
- (end-marker (point-max-marker)))
- (set-marker-insertion-type erc--insert-marker t)
- (erc-stamp--lr-date-on-pre-modify nil)
- (narrow-to-region erc--insert-marker end-marker)
- (set-marker end-marker nil)
- (set-marker erc--insert-marker nil)))
+ (erc-stamp--date-mode +1))
(let* ((ct (erc-stamp--current-time))
(ts-right (with-suppressed-warnings
((obsolete erc-timestamp-format-right))
@@ -805,12 +837,24 @@ left-sided stamps and date stamps inserted by this
function."
;; "prepended" date stamps as well. However, since this is a
;; compatibility oriented code path, and pre-5.6 did no such
;; thing, better to punt.
- (when-let ((erc-stamp-prepend-date-stamps-p)
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
- ((not (string= ts-left erc-timestamp-last-inserted-left))))
- (goto-char (point-min))
- (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
- (insert (setq erc-timestamp-last-inserted-left ts-left)))
+ (if-let ((erc-stamp-prepend-date-stamps-p)
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ ((not (string= ts-left erc-timestamp-last-inserted-left))))
+ (progn
+ (goto-char (point-min))
+ (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp
+ ts-left)
+ (insert (setq erc-timestamp-last-inserted-left ts-left)))
+ (when-let
+ (((null erc-stamp--deferred-date-stamp))
+ (rendered (erc-stamp--format-date-stamp ct))
+ ((not (string-equal rendered erc-timestamp-last-inserted-left)))
+ ((null (cl-find rendered erc-stamp--date-stamps
+ :test #'string= :key #'erc-stamp--date-str))))
+ ;; Force `erc-insert-timestamp-right' to stamp this message.
+ (setq erc-timestamp-last-inserted-right nil)
+ (setq erc-stamp--deferred-date-stamp
+ (make-erc-stamp--date :ts ct :str rendered))))
;; insert right timestamp
(let ((erc-timestamp-only-if-changed-flag t)
(erc-timestamp-last-inserted erc-timestamp-last-inserted-right))
@@ -924,6 +968,8 @@ For `erc-hide-timestamps, modify
`buffer-invisibility-spec'."
(kill-local-variable 'erc-stamp--last-stamp)
(kill-local-variable 'erc-timestamp-last-inserted)
(kill-local-variable 'erc-timestamp-last-inserted-right)
+ (kill-local-variable 'erc-stamp--deferred-date-stamp)
+ (kill-local-variable 'erc-stamp--date-stamps)
(kill-local-variable 'erc-stamp--date-format-end)))
(defun erc-hide-timestamps ()
@@ -992,7 +1038,12 @@ with the option `erc-echo-timestamps', see the companion
option
(move-marker erc-last-saved-position (1- (point-max))))
(defun erc-stamp--reset-on-clear (pos)
- "Forget last-inserted stamps when POS is at insert marker."
+ "Forget last-inserted stamps when POS is at insert marker.
+And discard stale references in `erc-stamp--date-stamps'."
+ (when erc-stamp--date-stamps
+ (setq erc-stamp--date-stamps
+ (seq-filter (lambda (o) (> (erc-stamp--date-marker o) pos))
+ erc-stamp--date-stamps)))
(when (= pos (1- erc-insert-marker))
(when erc-stamp--date-mode
(add-hook 'erc-stamp--insert-date-hook
@@ -1001,6 +1052,47 @@ with the option `erc-echo-timestamps', see the companion
option
erc-timestamp-last-inserted-left nil
erc-timestamp-last-inserted-right nil)))
+(defun erc-stamp--dedupe-date-stamps (old-stamps)
+ "Update `erc-stamp--date-stamps' from its counterpart OLD-STAMPS.
+Assume the contents of the buffer for OLD-STAMPS have just been inserted
+above the current buffer's and that the old buffer still exists so that
+markers still point somewhere. For each duplicate, update the existing
+marker to match the transplanted timestamp with the same date. Also
+copy non-duplicate `erc-stamp--date' objects from OLD-STAMPS to the
+current buffer's, maintaining order."
+ (let (need)
+ (dolist (old old-stamps)
+ (if-let ((new (cl-find (erc-stamp--date-str old) erc-stamp--date-stamps
+ :test #'string= :key #'erc-stamp--date-str))
+ (new-marker (erc-stamp--date-marker new)))
+ ;; The new buffer now has a duplicate stamp, so remove the
+ ;; "newer" one from the buffer.
+ (progn
+ (erc--delete-inserted-message-naively new-marker)
+ (set-marker new-marker (erc-stamp--date-marker old)))
+ ;; The new buffer doesn't have this stamp, so add its data
+ ;; object to the sorted list.
+ (push old need)
+ ;; Update the old marker position to point to the new buffer.
+ (set-marker (erc-stamp--date-marker old)
+ (erc-stamp--date-marker old))))
+ ;; These *should* already be sorted.
+ (setq erc-stamp--date-stamps
+ (nconc (nreverse need) erc-stamp--date-stamps))))
+
+(defun erc-stamp--dedupe-date-stamps-from-buffer (old-buffer)
+ "Merge date stamps from OLD-BUFFER into in the current buffer."
+ (let ((old-stamps (buffer-local-value 'erc-stamp--date-stamps old-buffer)))
+ (erc-stamp--dedupe-date-stamps old-stamps)))
+
+(defun erc-stamp--dedupe-date-stamps-from-target-buffer (orig old-buffer
+ new-buffer)
+ "Merge date stamps from OLD-BUFFER into NEW-BUFFER after calling ORIG."
+ (let ((old-stamps (buffer-local-value 'erc-stamp--date-stamps old-buffer)))
+ (prog1 (funcall orig old-buffer new-buffer)
+ (with-current-buffer new-buffer
+ (erc-stamp--dedupe-date-stamps old-stamps)))))
+
(provide 'erc-stamp)
;;; erc-stamp.el ends here
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 04ee76a9349..40e83fff974 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -959,9 +959,6 @@ NEW-FACES has a cdr."
(throw 'face candidate))))))
choice)))
-(defvar erc-track--skipped-msgs '(datestamp)
- "Values of `erc--msg' text prop to ignore.")
-
(defun erc-track-modified-channels ()
"Hook function for `erc-insert-post-hook'.
Check if the current buffer should be added to the mode line as a
@@ -980,8 +977,7 @@ the current buffer is in `erc-mode'."
erc-track-exclude-types)
;; Skip certain non-server-sent messages.
(and (not parsed)
- (erc--check-msg-prop 'erc--msg
- erc-track--skipped-msgs))))))
+ (erc--memq-msg-prop 'erc--skip 'track))))))
;; If the active buffer is not visible (not shown in a
;; window), and not to be excluded, determine the kinds of
;; faces used in the current message, and unless the user
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 4ed77655f19..9100ab5577d 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -181,11 +181,18 @@ as of ERC 5.6:
5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\"
type otherwise; managed by the `stamp' module
+ - `erc--skip': list of symbols known to modules that indicate an
+ intent to skip or simplify module-specific processing
+
- `erc--ephemeral': a symbol prefixed by or matching a module
name; indicates to other modules and members of modification
hooks that the current message should not affect stateful
operations, such as recording a channel's most recent speaker
+ - `erc--hide': a symbol or list of symbols added as an `invisible'
+ prop value to the entire message, starting *before* the preceding
+ newline and ending before the trailing newline
+
This is an internal API, and the selection of related helper
utilities is fluid and provisional. As of ERC 5.6, see the
functions `erc--check-msg-prop' and `erc--get-inserted-msg-prop'.")
@@ -463,13 +470,22 @@ See also `erc-server-QUIT-functions' and
`erc-disconnected-hook'."
(defcustom erc-part-hook nil
"Hook run when processing a PART message directed at our nick.
-
-The hook receives one argument, the current BUFFER.
-See also `erc-server-QUIT-functions', `erc-quit-hook' and
-`erc-disconnected-hook'."
+Called in the server buffer with a single argument: the channel buffer
+being parted. For historical reasons, the buffer argument may be nil if
+it's been killed or otherwise can't be found. This typically happens
+when the \"PART\" response being handled comes by way of a channel
+buffer being killed, which, by default, tells `erc-part-channel-on-kill'
+to emit a \"PART\". Users needing to operate on a parted channel buffer
+before it's killed in this manner should use `erc-kill-channel-hook' and
+condition their code on `erc-killing-buffer-on-part-p' being nil."
:group 'erc-hooks
:type 'hook)
+(defvar erc-killing-buffer-on-part-p nil
+ "Non-nil when killing a target buffer while handling a \"PART\" response.
+Useful for preventing the redundant execution of code designed to run
+once when parting a channel.")
+
(defcustom erc-kick-hook nil
"Hook run when processing a KICK message directed at our nick.
@@ -1107,8 +1123,7 @@ directory in the list."
(defcustom erc-kill-buffer-on-part nil
"Kill the channel buffer on PART.
-This variable should probably stay nil, as ERC can reuse buffers if
-you rejoin them later."
+Nil by default because ERC can reuse buffers later re-joined."
:group 'erc-quit-and-part
:type 'boolean)
@@ -1506,6 +1521,10 @@ This will only be used if `erc-header-line-face-method'
is non-nil."
"ERC face for errors."
:group 'erc-faces)
+(defface erc-information '((t :inherit shadow))
+ "Face for local administrative messages of low to moderate importance."
+ :group 'erc-faces)
+
;; same default color as `erc-input-face'
(defface erc-my-nick-face '((t :weight bold :foreground "brown"))
"ERC face for your current nickname in messages sent by you.
@@ -1588,7 +1607,7 @@ capabilities."
(remove-hook hook fun t))
(fmakunbound fun)
(funcall f proc parsed)))
- (add-hook hook fun nil t)
+ (add-hook hook fun -95 t)
fun))
(defun erc--warn-once-before-connect (mode-var &rest args)
@@ -1640,7 +1659,7 @@ the process buffer."
"Return non-nil if argument BUFFER is an ERC server buffer.
If BUFFER is nil, use the current buffer. For historical
reasons, also return non-nil for channel buffers the client has
-parted or from which it's been kicked."
+parted or been kicked from."
(with-current-buffer (or buffer (current-buffer))
(and (eq major-mode 'erc-mode)
(null (erc-default-target)))))
@@ -1662,8 +1681,13 @@ 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."
- (not (erc-channel-p (or buffer (current-buffer)))))
+If BUFFER is nil, use the current buffer."
+ (and-let* ((target (if buffer
+ (progn (when (stringp buffer)
+ (setq buffer (get-buffer buffer)))
+ (buffer-local-value 'erc--target buffer))
+ erc--target)))
+ (not (erc--target-channel-p target))))
(defun erc-ison-p (nick)
"Return non-nil if NICK is online."
@@ -3230,13 +3254,20 @@ a full refresh."
(defun erc--check-msg-prop (prop &optional val)
"Return PROP's value in `erc--msg-props' when populated.
-If VAL is a list, return non-nil if PROP appears in VAL. If VAL
-is otherwise non-nil, return non-nil if VAL compares `eq' to the
-stored value. Otherwise, return the stored value."
+If VAL is a list, return non-nil if PROP's value appears in VAL. If VAL
+is otherwise non-nil, return non-nil if VAL compares `eq' to the stored
+value. Otherwise, return the stored value."
(and-let* ((erc--msg-props)
(v (gethash prop erc--msg-props)))
(if (consp val) (memq v val) (if val (eq v val) v))))
+(defun erc--memq-msg-prop (prop needle)
+ "Return non-nil if msg PROP's value is a list containing NEEDLE."
+ (and-let* ((erc--msg-props)
+ (haystack (gethash prop erc--msg-props))
+ ((consp haystack)))
+ (memq needle haystack)))
+
(defmacro erc--get-inserted-msg-beg-at (point at-start-p)
(macroexp-let2* nil ((point point)
(at-start-p at-start-p))
@@ -3278,14 +3309,36 @@ if not found."
(and-let* ((stack-pos (erc--get-inserted-msg-beg (point))))
(get-text-property stack-pos prop)))
-(defmacro erc--with-inserted-msg (&rest body)
- "Simulate narrowing performed for send and insert hooks, and run BODY.
-Expect callers to know that this doesn't wrap BODY in
-`with-silent-modifications' or bind a temporary `erc--msg-props'."
- `(when-let ((bounds (erc--get-inserted-msg-bounds)))
- (save-restriction
- (narrow-to-region (car bounds) (1+ (cdr bounds)))
- ,@body)))
+;; FIXME improve this nascent "message splicing" facility to include a
+;; means for modules to adjust inserted messages on either side of the
+;; splice position as well as to modify the spliced-in message itself
+;; before and after each insertion-related hook runs. Also add a
+;; counterpart to `erc--with-spliced-insertion' for deletions.
+(defvar erc--insert-line-splice-function
+ #'erc--insert-before-markers-transplanting-hidden
+ "Function to handle in-place insertions away from prompt.
+Modules that display \"stateful\" messages, where one message's content
+depends on prior messages, should advise this locally as needed.")
+
+(defmacro erc--with-spliced-insertion (marker-or-pos &rest body)
+ "In BODY, ensure `erc-insert-line' inserts messages at MARKER-OR-POS.
+If MARKER-OR-POS is a marker, let it advance normally (and permanently)
+with each insertion. Allow modules to influence insertion by binding
+`erc--insert-line-function' to `erc--insert-line-splice-function' around
+BODY. Note that as of ERC 5.6, this macro cannot handle multiple
+successive calls to `erc-insert-line' in BODY, such as when replaying
+a history backlog."
+ (declare (indent 1))
+ (let ((marker (make-symbol "marker")))
+ `(progn
+ (cl-assert (= ?\n (char-before ,marker-or-pos)))
+ (cl-assert (null erc--insert-line-function))
+ (let* ((,marker (and (not (markerp ,marker-or-pos))
+ (copy-marker ,marker-or-pos)))
+ (erc--insert-marker (or ,marker ,marker-or-pos))
+ (erc--insert-line-function erc--insert-line-splice-function))
+ (prog1 (progn ,@body)
+ (when ,marker (set-marker ,marker nil)))))))
(defun erc--traverse-inserted (beg end fn)
"Visit messages between BEG and END and run FN in narrowed buffer.
@@ -3325,7 +3378,11 @@ that this flag and the behavior it restores may
disappear at any
time, so if you need them, please let ERC know with \\[erc-bug].")
(defvar erc--insert-line-function nil
- "When non-nil, an alterntive to `insert' for inserting messages.")
+ "When non-nil, an `insert'-like function for inserting messages.
+Modules, like `fill-wrap', that leave a marker at the beginning of an
+inserted message clearly want that marker to advance along with text
+inserted at that position. This can be addressed by binding this
+variable to `insert-before-markers' around calls to `display-message'.")
(defvar erc--insert-marker nil
"Internal override for `erc-insert-marker'.")
@@ -3473,6 +3530,14 @@ being equivalent to a `erc-display-message' TYPE of
`notice'."
(push '(erc--msg . notice) erc--msg-prop-overrides)))
(erc-display-message nil nil buffer string)))
+(defun erc--insert-admin-message (msg &rest args)
+ "Print MSG with ARGS as a local notice.
+Inhibit all stamps and buttonizing."
+ (let ((erc--msg-prop-overrides `((erc--skip . (stamp track button))
+ ,@erc--msg-prop-overrides)))
+ (apply #'erc-display-message nil '(notice information)
+ (current-buffer) msg args)))
+
(defvar erc--merge-text-properties-p nil
"Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.")
@@ -3509,7 +3574,7 @@ also `erc-button-add-face'."
end (next-single-property-change pos prop object to)))))
(defun erc--remove-from-prop-value-list (from to prop val &optional object)
- "Remove VAL from text prop value between FROM and TO.
+ "Remove VAL from text PROP value between FROM and TO.
If current value is VAL itself, remove the property entirely.
When VAL is a list, act as if this function were called
repeatedly with VAL set to each of VAL's members."
@@ -3573,19 +3638,45 @@ preceding newline to its last non-newline character.")
(make-obsolete-variable 'erc-legacy-invisible-bounds-p
"decremented interval now permanent" "30.1")
+(defun erc--insert-before-markers-transplanting-hidden (string)
+ "Insert STRING before markers and migrate any `invisible' props.
+Expect to be called with `point' at the start of an inserted message,
+i.e., one with an `erc--msg' property. Check the message prop header
+for invisibility props advertised via `erc--hide'. When found, remove
+them from the previous newline, and add them to the newline suffixing
+the inserted version of STRING."
+ (let* ((after (and (not erc-legacy-invisible-bounds-p)
+ (get-text-property (point) 'erc--hide)))
+ (before (and after (get-text-property (1- (point)) 'invisible)))
+ (a (and after (ensure-list after)))
+ (b (and before (ensure-list before)))
+ (new (and before (erc--solo (cl-intersection b a)))))
+ (when new
+ (erc--remove-from-prop-value-list (1- (point)) (point) 'invisible a))
+ (prog1 (insert-before-markers string)
+ (when new
+ (erc--merge-prop (1- (point)) (point) 'invisible new)))))
+
(defun erc--hide-message (value)
"Apply `invisible' text-property with VALUE to current message.
Expect to run in a narrowed buffer during message insertion.
Begin the invisible interval at the previous message's trailing
newline and end before the current message's. If the preceding
message ends in a double newline or there is no previous message,
-don't bother including the preceding newline."
+don't bother including the preceding newline. Additionally,
+record VALUE as part of the `erc--hide' property in the
+\"msg-props\" header."
(if erc-legacy-invisible-bounds-p
;; Before ERC 5.6, this also used to add an `intangible'
;; property, but the docs say it's now obsolete.
(erc--merge-prop (point-min) (point-max) 'invisible value)
- (let ((beg (point-min))
+ (let ((old-hide (erc--check-msg-prop 'erc--hide))
+ (beg (point-min))
(end (point-max)))
+ (puthash 'erc--hide (if old-hide
+ `(,value . ,(ensure-list old-hide))
+ value)
+ erc--msg-props)
(save-restriction
(widen)
(when (or (<= beg 4) (= ?\n (char-before (- beg 2))))
@@ -3604,9 +3695,11 @@ Treat ARG in a manner similar to mode toggles defined by
(when (or (not arg) (natnump arg))
(add-to-invisibility-spec prop))))
-(defun erc--delete-inserted-message (beg-or-point &optional end)
+(defun erc--delete-inserted-message-naively (beg-or-point &optional end)
"Remove message between BEG and END.
-Expect BEG and END to match bounds as returned by the macro
+Do this without updating messages on either side even if their
+appearance was somehow influenced by the newly absent message.
+Expect BEG and END to match bounds as returned by the function
`erc--get-inserted-msg-bounds'. Ensure all markers residing at
the start of the deleted message end up at the beginning of the
subsequent message."
@@ -3626,7 +3719,8 @@ subsequent message."
-1))))))))
(defvar erc--ranked-properties
- '(erc--msg erc--spkr erc--ts erc--cmd erc--ctcp erc--ephemeral))
+ '( erc--msg erc--spkr erc--ts erc--skip
+ erc--cmd erc--hide erc--ctcp erc--ephemeral))
(defun erc--order-text-properties-from-hash (table)
"Return a plist of text props from items in TABLE.
@@ -3650,9 +3744,12 @@ See also `erc-make-notice'."
(t
(erc-put-text-property
0 (length string)
- 'font-lock-face (or (intern-soft
- (concat "erc-" (symbol-name type) "-face"))
- 'erc-default-face)
+ 'font-lock-face
+ (let* ((name (symbol-name type))
+ (symbol (or (intern-soft (concat "erc-" name "-face"))
+ (intern-soft (concat "erc-" name))
+ type)))
+ (or (and (facep symbol) symbol) 'erc-default-face))
string)
string)))
@@ -6061,7 +6158,8 @@ NUH, and the current `erc-response' object.")
;; The format strings in the following `-speaker' catalog shouldn't
;; contain any non-protocol words, so they make sense in any language.
-
+;; Note that the following definitions generally avoid `propertize'
+;; because it reverses the order of the text properties it's given.
(defvar erc--message-speaker-statusmsg
#("(%p%n%s) %m"
0 1 (font-lock-face erc-default-face)
@@ -6153,11 +6251,11 @@ NUH, and the current `erc-response' object.")
"Message template for a CTCP ACTION from another user.")
(defvar erc--message-speaker-ctcp-action-input
- #("* %p%n %m"
- 0 2 (font-lock-face #1=(erc-input-face erc-action-face))
- 2 4 (font-lock-face (erc-my-nick-prefix-face . #1#))
- 4 6 (font-lock-face (erc-my-nick-face . #1#))
- 6 9 (font-lock-face #1#))
+ (let ((base '(erc-input-face erc-action-face))) ; shared
+ (concat (propertize "* " 'font-lock-face base)
+ (propertize "%p" 'font-lock-face `(erc-my-nick-prefix-face ,@base))
+ (propertize "%n" 'font-lock-face `(erc-my-nick-face ,@base))
+ (propertize " %m" 'font-lock-face base)))
"Message template for a CTCP ACTION from current client.")
(defvar erc--message-speaker-ctcp-action-statusmsg
@@ -6170,12 +6268,12 @@ NUH, and the current `erc-response' object.")
"Template for a CTCP ACTION status message from another chan op.")
(defvar erc--message-speaker-ctcp-action-statusmsg-input
- #("* (%p%n%s) %m"
- 0 3 (font-lock-face #1=(erc-input-face erc-action-face))
- 3 5 (font-lock-face (erc-my-nick-prefix-face . #1#))
- 5 7 (font-lock-face (erc-my-nick-face . #1#))
- 7 9 (font-lock-face (erc-notice-face . #1#))
- 9 13 (font-lock-face #1#))
+ (let ((base '(erc-input-face erc-action-face))) ; shared
+ (concat (propertize "* (" 'font-lock-face base)
+ (propertize "%p" 'font-lock-face `(erc-my-nick-prefix-face ,@base))
+ (propertize "%n" 'font-lock-face `(erc-my-nick-face ,@base))
+ (propertize "%s" 'font-lock-face `(erc-notice-face ,@base))
+ (propertize ") %m" 'font-lock-face base)))
"Template for a CTCP ACTION status message from current client.")
(defun erc--speakerize-nick (nick &optional disp)
@@ -7399,7 +7497,7 @@ complement relevant letters in STRING."
t))
((not fallbackp)
(erc-display-message nil '(notice error) (erc-server-buffer)
- (format "Unknown channel mode: %S" c)))))
+ 'channel-mode-unknown ?c (string c)))))
(setq erc-channel-modes (sort erc-channel-modes #'string<))
(setq erc--mode-line-mode-string
(concat "+" (erc--channel-modes erc--mode-line-chanmodes-arg-len)))
@@ -9330,6 +9428,7 @@ SOFTP, only do so when defined as a variable."
(incorrect-args . "Incorrect arguments. Usage:\n%c %u\n%d")
(cannot-find-file . "Cannot find file %f")
(cannot-read-file . "Cannot read file %f")
+ (channel-mode-unknown . "Unknown channel mode: %c")
(connect . "Connecting to %S:%p... ")
(country . "%c")
(country-unknown . "%d: No such domain")
@@ -9350,6 +9449,7 @@ SOFTP, only do so when defined as a variable."
(finished . "\n\n*** ERC finished ***\n")
(terminated . "\n\n*** ERC terminated: %e\n")
(login . "Logging in as `%n'...")
+ (graft . "Grafting buffer `%n' onto `%o'...") ; {new} onto {old}
(nick-in-use . "%n is in use. Choose new nickname: ")
(nick-too-long
. "WARNING: Nick length (%i) exceeds max NICKLEN(%l) defined by server")
@@ -9522,7 +9622,7 @@ See also `format-spec'."
:type 'hook)
(defcustom erc-kill-channel-hook
- '(erc-kill-channel
+ '(erc-part-channel-on-kill
erc-networks-shrink-ids-and-buffer-names
erc-networks-rename-surviving-target-buffer)
"Invoked whenever a channel-buffer is killed via `kill-buffer'."
@@ -9583,10 +9683,13 @@ This function should be on `erc-kill-server-hook'."
(setq erc-server-quitting t)
(erc-server-send (format "QUIT :%s" (funcall erc-quit-reason nil)))))
-(defun erc-kill-channel ()
- "Sends a PART command to the server when the channel buffer is killed.
-This function should be on `erc-kill-channel-hook'."
- (when (erc-server-process-alive)
+(define-obsolete-function-alias 'erc-kill-channel #'erc-part-channel-on-kill
+ "30.1")
+(defun erc-part-channel-on-kill ()
+ "Send a \"PART\" when killing a channel buffer."
+ (when (and (not erc-killing-buffer-on-part-p)
+ (not erc-networks--target-transplant-in-progress-p)
+ (erc-server-process-alive))
(let ((tgt (erc-default-target)))
(if tgt
(erc-server-send (format "PART %s :%s" tgt
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index 7fc6958a00f..89a40151d00 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -317,7 +317,7 @@ The result is a list of three elements:
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 start-dir (concat start-dir (car globs))))
(setq last-saw-recursion nil))
(setq globs (cdr globs)))
(list start-dir
@@ -341,16 +341,24 @@ Mainly they are not supported because file matching is
done with Emacs
regular expressions, and these cannot support the above constructs."
(let ((globs (eshell-glob-convert glob))
eshell-glob-matches message-shown)
- (unwind-protect
- (apply #'eshell-glob-entries globs)
- (if message-shown
- (message nil)))
- (or (and eshell-glob-matches (sort eshell-glob-matches #'string<))
- (if eshell-error-if-no-glob
- (error "No matches found: %s" glob)
- (if eshell-glob-splice-results
- (list glob)
- glob)))))
+ (if (null (cadr globs))
+ ;; If, after examining GLOB, there are no actual globs, just
+ ;; bail out. This can happen for remote file names using "~",
+ ;; like "/ssh:remote:~/file.txt". During parsing, we can't
+ ;; always be sure if the "~" is a home directory reference or
+ ;; part of a glob (e.g. if the argument was assembled from
+ ;; variables).
+ glob
+ (unwind-protect
+ (apply #'eshell-glob-entries globs)
+ (if message-shown
+ (message nil)))
+ (or (and eshell-glob-matches (sort eshell-glob-matches #'string<))
+ (if eshell-error-if-no-glob
+ (error "No matches found: %s" glob)
+ (if eshell-glob-splice-results
+ (list glob)
+ glob))))))
;; FIXME does this really need to abuse eshell-glob-matches, message-shown?
(defun eshell-glob-entries (path globs only-dirs)
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 21029eae1bc..b171a2850ff 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -398,11 +398,9 @@ input."
(pcase eshell-hist-ignoredups
('nil t) ; Always add to history
('erase ; Add, removing any old occurrences
- (when-let ((old-index (ring-member eshell-history-ring input)))
- ;; Remove the old occurrence of this input so we can
- ;; add it to the end. FIXME: Should we try to
- ;; remove multiple old occurrences, e.g. if the user
- ;; recently changed to using `erase'?
+ (while-let ((old-index (ring-member eshell-history-ring
input)))
+ ;; Remove the old occurrences of this input so we can
+ ;; add it to the end.
(ring-remove eshell-history-ring old-index))
t)
(_ ; Add if not already the latest entry
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index fd89a9f778e..62ad7ff72a1 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -293,7 +293,6 @@ instead."
(eshell-do-ls (nconc switches (list target)))))))))
-(declare-function eshell-extended-glob "em-glob" (glob))
(declare-function dired-read-dir-and-switches "dired" (str))
(declare-function dired-goto-next-file "dired" ())
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 751f13cc715..855efa26033 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -815,8 +815,8 @@ external command."
(if (and maybe-use-occur eshell-no-grep-available)
(eshell-poor-mans-grep args)
(eshell-compile command (cons "-n" args)
- (and eshell-plain-grep-behavior
- 'interactive)
+ (when eshell-plain-grep-behavior
+ 'plain)
#'grep-mode)))
(defun eshell/grep (&rest args)
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 30494bafb48..57aeff59266 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -101,20 +101,18 @@
;;; Code:
(require 'esh-util)
-(require 'eldoc)
(require 'esh-arg)
(require 'esh-proc)
(require 'esh-module)
(require 'esh-io)
(require 'esh-ext)
+
+(require 'eldoc)
(require 'generator)
+(require 'pcomplete)
(eval-when-compile
- (require 'cl-lib)
- (require 'pcomplete))
-
-(declare-function pcomplete--here "pcomplete"
- (&optional form stub paring form-only))
+ (require 'cl-lib))
(defgroup eshell-cmd nil
"Executing an Eshell command is as simple as typing it in and \
@@ -785,9 +783,6 @@ this grossness will be made to disappear by using
`call/cc'..."
(eshell-errorn (error-message-string err))
(eshell-close-handles 1))))
-(defvar eshell-output-handle) ;Defined in esh-io.el.
-(defvar eshell-error-handle) ;Defined in esh-io.el.
-
(defmacro eshell-with-copied-handles (object &optional steal-p)
"Duplicate current I/O handles, so OBJECT works with its own copy.
If STEAL-P is non-nil, these new handles will be stolen from the
@@ -1292,13 +1287,15 @@ have been replaced by constants."
(setcdr form (cdr new-form)))
(eshell-do-eval form synchronous-p))
(if-let (((memq (car form) eshell-deferrable-commands))
- (procs (eshell-make-process-list result)))
+ (procs (eshell-make-process-list result))
+ (active (seq-some #'eshell-process-active-p procs)))
(if synchronous-p
(apply #'eshell/wait procs)
(eshell-manipulate form "inserting ignore form"
(setcar form 'ignore)
(setcdr form nil))
- (throw 'eshell-defer procs))
+ (when active
+ (throw 'eshell-defer procs)))
(list 'quote result))))))))))))
;; command invocation
@@ -1485,6 +1482,14 @@ Print the result using `eshell-printn'; if an error
occurs, print it
via `eshell-errorn'."
(eshell-eval* #'eshell-printn #'eshell-errorn form))
+(defun eshell/funcall (func &rest args)
+ "Eshell built-in command for `funcall' (which see).
+This simply calls FUNC with the specified ARGS. FUNC may be a symbol or
+a string naming a Lisp function."
+ (when (stringp func)
+ (setq func (intern func)))
+ (apply func args))
+
(defvar eshell-last-output-end) ;Defined in esh-mode.el.
(defun eshell-lisp-command (object &optional args)
diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el
index 44861c222b8..df8f7198917 100644
--- a/lisp/eshell/esh-ext.el
+++ b/lisp/eshell/esh-ext.el
@@ -31,12 +31,12 @@
;;; Code:
-(require 'esh-util)
-
(eval-when-compile (require 'cl-lib))
(require 'esh-io)
(require 'esh-arg)
(require 'esh-opt)
+(require 'esh-proc)
+(require 'esh-util)
(defgroup eshell-ext nil
"External commands are invoked when operating system executables are
@@ -90,10 +90,6 @@ but Eshell will be able to understand
(setq list (cdr list)))
file)))
-;; This file provides itself then eval-when-compile loads files that require
it.
-;; This causes spurious "might not be defined at runtime" warnings.
-(declare-function eshell-search-path "esh-ext" (name))
-
(defcustom eshell-windows-shell-file
(if (eshell-under-windows-p)
(if (string-match "\\(cmdproxy\\|sh\\)\\.\\(com\\|exe\\)"
@@ -171,23 +167,23 @@ external version."
(defcustom eshell-explicit-remote-commands t
"If non-nil, support explicitly-remote commands.
These are commands with a full remote file name, such as
-\"/ssh:host:whoami\". If this is enabled, you can also run
-explicitly-local commands by using a quoted file name, like
-\"/:whoami\"."
+\"/ssh:host:whoami\". If this is enabled, you can also explicitly run
+commands on your local host by using the \"/local:\" prefix, like
+\"/local:whoami\"."
:type 'boolean
:group 'eshell-ext)
;;; Functions:
+(defconst eshell--local-prefix "/local:")
+
(defun eshell-ext-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the external command handling code."
- (add-hook 'eshell-named-command-hook #'eshell-explicit-command nil t)
- (when eshell-explicit-remote-commands
- (add-hook 'eshell-named-command-hook
- #'eshell-handle-remote-command nil t)))
+ (add-hook 'eshell-named-command-hook #'eshell-quoted-file-command nil t)
+ (add-hook 'eshell-named-command-hook #'eshell-explicit-command nil t))
(defun eshell-explicit-command (command args)
- "If a command name begins with `*', call it externally always.
+ "If a command name begins with \"*\", always call it externally.
This bypasses all Lisp functions and aliases."
(when (and (> (length command) 1)
(eq (aref command 0) eshell-explicit-command-char))
@@ -198,39 +194,35 @@ This bypasses all Lisp functions and aliases."
(error "%s: external command not found"
(substring command 1))))))
-(defun eshell-handle-remote-command (command args)
- "Handle remote (or quoted) COMMAND names, using ARGS.
-This calls the appropriate function for commands that aren't on
-the connection associated with `default-directory'. (See
-`eshell-explicit-remote-commands'.)"
- (if (file-name-quoted-p command)
- (let ((default-directory (if (file-remote-p default-directory)
- (expand-file-name "~")
- default-directory)))
- (eshell-external-command (file-name-unquote command) args))
- (when (file-remote-p command)
- (eshell-remote-command command args))))
+(defun eshell-quoted-file-command (command args)
+ "If a command name begins with \"/:\", always call it externally.
+Similar to `eshell-explicit-command', this bypasses all Lisp functions
+and aliases, but it also ignores file name handlers."
+ (when (file-name-quoted-p command)
+ (eshell-external-command (file-name-unquote command) args)))
(defun eshell-remote-command (command args)
"Insert output from a remote COMMAND, using ARGS.
-A remote command is something that executes on a different machine.
-An external command simply means external to Emacs."
+A \"remote\" command in Eshell is something that executes on a different
+machine. If COMMAND is a remote file name, run it on the host for that
+file; if COMMAND is a local file name, run it locally."
(let* ((cwd-connection (file-remote-p default-directory))
(command-connection (file-remote-p command))
(default-directory (if (equal cwd-connection command-connection)
default-directory
- command-connection))
+ (or command-connection (expand-file-name "~"))))
;; Never use the remote connection here. We don't want to
;; expand the local name! Instead, we want it as the user
;; typed, so that if COMMAND is "/ssh:host:cat", we just get
;; "cat" as the result.
- (command-localname (file-remote-p command 'localname 'never)))
- (unless command-connection
- (error "%s: not a remote command" command))
- (eshell-external-command command-localname args)))
-
-(defun eshell-external-command (command args)
- "Insert output from an external COMMAND, using ARGS."
+ (command-localname (or (file-remote-p command 'localname 'never)
+ command)))
+ (eshell-connection-local-command command-localname args)))
+
+(defun eshell-connection-local-command (command args)
+ "Insert output from an external COMMAND, using ARGS.
+This always runs COMMAND using the connection associated with the
+current working directory."
(setq args (eshell-stringify-list (flatten-tree args)))
(let ((interp (eshell-find-interpreter
command
@@ -244,11 +236,22 @@ An external command simply means external to Emacs."
(cl-assert interp)
(if (functionp (car interp))
(apply (car interp) (append (cdr interp) args))
- (require 'esh-proc)
- (declare-function eshell-gather-process-output "esh-proc" (command args))
(eshell-gather-process-output
(car interp) (append (cdr interp) args)))))
+(defun eshell-external-command (command args)
+ "Insert output from an external COMMAND, using ARGS."
+ (cond
+ ((and eshell-explicit-remote-commands
+ (file-remote-p command))
+ (eshell-remote-command command args))
+ ((and eshell-explicit-remote-commands
+ (string-prefix-p eshell--local-prefix command))
+ (eshell-remote-command
+ (substring command (length eshell--local-prefix)) args))
+ (t
+ (eshell-connection-local-command command args))))
+
(defun eshell/addpath (&rest args)
"Add a set of paths to PATH."
(eshell-eval-using-options
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index b15f99a0359..78a448a41a5 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -418,8 +418,10 @@ and the hook `eshell-exit-hook'."
(add-hook 'kill-buffer-hook #'eshell-kill-buffer-function t t)
- (if eshell-first-time-p
- (run-hooks 'eshell-first-time-mode-hook))
+ (when eshell-first-time-p
+ (setq eshell-first-time-p nil)
+ (run-hooks 'eshell-first-time-mode-hook))
+
(run-hooks 'eshell-post-command-hook))
(put 'eshell-mode 'mode-class 'special)
@@ -692,9 +694,6 @@ newline."
(defun eshell-send-eof-to-process ()
"Send EOF to the currently-running \"head\" process."
(interactive)
- (require 'esh-mode)
- (declare-function eshell-send-input "esh-mode"
- (&optional use-region queue-p no-newline))
(eshell-send-input nil nil t)
(when (eshell-head-process)
(process-send-eof (eshell-head-process))))
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 35c81f6a4b2..34db5e1c771 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -27,6 +27,8 @@
(require 'esh-io)
(require 'esh-util)
+(require 'pcomplete)
+
(defgroup eshell-proc nil
"When Eshell invokes external commands, it always does so
asynchronously, so that Emacs isn't tied up waiting for the process to
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 129134814e3..47645231b75 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -458,8 +458,7 @@ Prepend remote identification of `default-directory', if
any."
(string-prefix-p "//" filename))
(setq index 2))
(while (< index len)
- (when (and (eq (aref filename index) ?/)
- (not (get-text-property index 'escaped filename)))
+ (when (eq (aref filename index) ?/)
(push (if (= curr-start index) "/"
(substring filename curr-start (1+ index)))
parts)
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index 7d374587dc4..503f64add41 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -250,7 +250,8 @@ information on Eshell, see Info node `(eshell)Top'."
(t
(get-buffer-create eshell-buffer-name)))))
(cl-assert (and buf (buffer-live-p buf)))
- (pop-to-buffer buf display-comint-buffer-action)
+ (with-suppressed-warnings ((obsolete display-comint-buffer-action))
+ (pop-to-buffer buf display-comint-buffer-action))
(unless (derived-mode-p 'eshell-mode)
(eshell-mode))
buf))
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index d269d85301c..b9fdad2be17 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -387,9 +387,10 @@ this are the `default' and `header-line' faces: they will
both be
scaled even if they have an explicit `:height' setting.
See also the related command `global-text-scale-adjust'. Unlike
-that command, which scales the font size with a increment,
-`text-scale-adjust' scales the font size with a factor,
-`text-scale-mode-step'. With a small `text-scale-mode-step'
+that command, which scales the font size with a increment (and can
+also optionally resize frames to keep the same number of lines and
+characters per line), `text-scale-adjust' scales the font size with
+a factor, `text-scale-mode-step'. With a small `text-scale-mode-step'
factor, the two commands behave similarly."
(interactive "p")
(let ((ev last-command-event)
diff --git a/lisp/files.el b/lisp/files.el
index 1e11dd44bad..ae6dc1d6b29 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -862,6 +862,7 @@ GNU and Unix systems). Substitute environment variables
into the
resulting list of directory names. For an empty path element (i.e.,
a leading or trailing separator, or two adjacent separators), return
nil (meaning `default-directory') as the associated list element."
+ (declare (ftype (function (string) list)))
(when (stringp search-path)
(let ((spath (substitute-env-vars search-path))
(double-slash-special-p
@@ -1504,27 +1505,28 @@ containing it, until no links are left at any level.
(new (file-name-as-directory (file-truename dirfile
counter prev-dirs))))
(setcar prev-dirs (cons (cons old new) (car prev-dirs)))
(setq dir new))))
- (if (equal ".." (file-name-nondirectory filename))
- (setq filename
- (directory-file-name (file-name-directory
(directory-file-name dir)))
- done t)
- (if (equal "." (file-name-nondirectory filename))
- (setq filename (directory-file-name dir)
- done t)
- ;; Put it back on the file name.
- (setq filename (concat dir (file-name-nondirectory filename)))
- ;; Is the file name the name of a link?
- (setq target (file-symlink-p filename))
- (if target
- ;; Yes => chase that link, then start all over
- ;; since the link may point to a directory name that uses
links.
- ;; We can't safely use expand-file-name here
- ;; since target might look like foo/../bar where foo
- ;; is itself a link. Instead, we handle . and .. above.
- (setq filename (files--splice-dirname-file dir target)
- done nil)
- ;; No, we are done!
- (setq done t))))))))
+ (let ((filename-no-dir (file-name-nondirectory filename)))
+ (if (equal ".." filename-no-dir)
+ (setq filename
+ (directory-file-name (file-name-directory
(directory-file-name dir)))
+ done t)
+ (if (equal "." filename-no-dir)
+ (setq filename (directory-file-name dir)
+ done t)
+ ;; Put it back on the file name.
+ (setq filename (concat dir filename-no-dir))
+ ;; Is the file name the name of a link?
+ (setq target (file-symlink-p filename))
+ (if target
+ ;; Yes => chase that link, then start all over
+ ;; since the link may point to a directory name that uses
links.
+ ;; We can't safely use expand-file-name here
+ ;; since target might look like foo/../bar where foo
+ ;; is itself a link. Instead, we handle . and .. above.
+ (setq filename (files--splice-dirname-file dir target)
+ done nil)
+ ;; No, we are done!
+ (setq done t)))))))))
filename))
(defun file-chase-links (filename &optional limit)
@@ -2113,15 +2115,15 @@ killed."
(rename-buffer oname)))
(unless (eq (current-buffer) obuf)
(with-current-buffer obuf
- (unless (get-buffer oname)
- ;; Restore original's buffer name so 'kill-buffer' can use it
- ;; to assign its last name (Bug#68235).
- (rename-buffer oname))
;; Restore original buffer's file names so they can be still
;; used when referencing the now defunct buffer (Bug#68235).
(setq buffer-file-name ofile)
(setq buffer-file-number onum)
(setq buffer-file-truename otrue)
+ (unless (get-buffer oname)
+ ;; Restore original's buffer name so 'kill-buffer' can use it
+ ;; to assign its last name (Bug#68235).
+ (rename-buffer oname))
;; We already ran these; don't run them again.
(let (kill-buffer-query-functions kill-buffer-hook)
(kill-buffer obuf))))))
@@ -8812,9 +8814,10 @@ Otherwise, trash FILENAME using the freedesktop.org
conventions,
;; If `system-move-file-to-trash' is defined, use it.
(cond ((fboundp 'system-move-file-to-trash)
(system-move-file-to-trash filename))
- (trash-directory
+ ((connection-local-value trash-directory)
;; If `trash-directory' is non-nil, move the file there.
- (let* ((trash-dir (expand-file-name trash-directory))
+ (let* ((trash-dir (expand-file-name
+ (connection-local-value trash-directory)))
(fn (directory-file-name (expand-file-name filename)))
(new-fn (concat (file-name-as-directory trash-dir)
(file-name-nondirectory fn))))
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index 41581cc7900..fa0c034c816 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -120,7 +120,8 @@ them for `find-ls-option'."
:group 'find-dired)
(defcustom find-grep-options
- (if (or (eq system-type 'berkeley-unix)
+ (if (or (and (eq system-type 'berkeley-unix)
+ (not (string-match "openbsd" system-configuration)))
(string-match "solaris2" system-configuration))
"-s" "-q")
"Option to grep to be as silent as possible.
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index 1fc2b33fffb..c4266a7060e 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -262,8 +262,7 @@ If DONT-POP is nil, display the buffer after setting it up."
(setq ga
(message-fetch-field gnus-draft-meta-information-header)))
(insert mail-header-separator)
- (forward-line 1)
- (message-set-auto-save-file-name))))
+ (forward-line 1))))
(gnus-backlog-remove-article group narticle)
(when (and ga
(ignore-errors (setq ga (car (read-from-string ga)))))
@@ -290,30 +289,25 @@ If DONT-POP is nil, display the buffer after setting it
up."
(defun gnus-draft-check-draft-articles (articles)
"Check whether the draft articles ARTICLES are under edit."
(when (equal gnus-newsgroup-name "nndraft:drafts")
- (let ((buffers (buffer-list))
- file buffs buff)
- (save-current-buffer
- (while (and articles
- (not buff))
- (setq file (nndraft-article-filename (pop articles))
- buffs buffers)
- (while buffs
- (set-buffer (setq buff (pop buffs)))
- (if (and buffer-file-name
- (equal (file-remote-p file)
- (file-remote-p buffer-file-name))
- (string-equal (file-truename buffer-file-name)
- (file-truename file))
- (buffer-modified-p))
- (setq buffs nil)
- (setq buff nil)))))
- (when buff
- (let* ((window (get-buffer-window buff t))
- (frame (and window (window-frame window))))
- (if frame
- (select-frame-set-input-focus frame)
- (pop-to-buffer buff t)))
- (error "The draft %s is under edit" file)))))
+ (let* ((files (mapcar #'nndraft-article-filename articles))
+ (buffs (delq nil (mapcar (lambda (f)
+ (find-buffer-visiting
+ f (lambda (b) (buffer-modified-p b))))
+ files))))
+ (when buffs
+ (if (= 1 (length buffs))
+ ;; We might have arrived here via `gnus-draft-edit-message';
+ ;; either way show the user the draft with unsaved changes.
+ (let* ((window (get-buffer-window (car buffs) t))
+ (frame (and window (window-frame window))))
+ (if frame
+ (select-frame-set-input-focus frame)
+ (pop-to-buffer (car buffs) t))
+ (error "Draft is already under edit"))
+ ;; Otherwise we got here from `gnus-draft-send-message', and
+ ;; the main thing is to interrupt the sending.
+ (display-buffer (list-buffers-noselect t buffs))
+ (error "Some drafts have unsaved changes: %S" buffs))))))
(defun gnus-draft-clear-marks ()
(setq gnus-newsgroup-reads nil
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index a967d6d71da..9cff2e2f109 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -1002,10 +1002,11 @@ Responsible for handling and, or, and parenthetical
expressions.")
(defsubst gnus-search-single-p (query)
"Return t if QUERY is a search for a single message."
- (let ((q (alist-get 'parsed-query query)))
- (and (= (length q ) 1)
- (consp (car-safe q))
- (eq (caar q) 'id))))
+ (unless (alist-get 'thread query)
+ (let ((q (alist-get 'parsed-query query)))
+ (and (= (length q ) 1)
+ (consp (car-safe q))
+ (eq (caar q) 'id)))))
(cl-defmethod gnus-search-transform ((engine gnus-search-engine)
(query list))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index dc66e1375ab..d4895f3c5f8 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -8939,7 +8939,8 @@ The difference between N and the number of articles
fetched is returned."
(while (and (> n 0)
(not error))
(setq header (gnus-summary-article-header))
- (if (and (eq (mail-header-number header)
+ (if (and (null gnus-alter-header-function)
+ (eq (mail-header-number header)
(cdr gnus-article-current))
(equal gnus-newsgroup-name
(car gnus-article-current)))
@@ -8947,7 +8948,8 @@ The difference between N and the number of articles
fetched is returned."
;; displayed article, then we take a look at the actual
;; References header, since this is slightly more
;; reliable than the References field we got from the
- ;; server.
+ ;; server. But if we altered the header, we should prefer
+ ;; the version from the header vector.
(with-current-buffer gnus-original-article-buffer
(nnheader-narrow-to-headers)
(unless (setq ref (message-fetch-field "references"))
@@ -8955,8 +8957,8 @@ The difference between N and the number of articles
fetched is returned."
(setq ref (gnus-extract-message-id-from-in-reply-to ref))))
(widen))
(setq ref
- ;; It's not the current article, so we take a bet on
- ;; the value we got from the server.
+ ;; It's not the current article, or we altered the header,
+ ;; so we use whats in the header vector.
(mail-header-references header)))
(if (and ref
(not (equal ref "")))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index dab66b60205..f1fc129a505 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1360,6 +1360,7 @@ slower."
("nnimap" post-mail address prompt-address physical-address respool
server-marks cloud)
("nnmaildir" mail respool address server-marks)
+ ("nnatom" none address)
("nnnil" none))
"An alist of valid select methods.
The first element of each list lists should be a string with the name
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 979d2fecf56..b2805774162 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -5768,8 +5768,10 @@ The result is a fixnum."
(with-temp-buffer
(insert-buffer-substring buf)
(message-clone-locals buf)
- ;; Avoid re-doing things like GPG-encoding secret parts.
- (if (not encoded-cache)
+ ;; Avoid re-doing things like GPG-encoding secret parts, unless
+ ;; the user has requested that attachments be externalized, in
+ ;; which case we have to re-encode the message body.
+ (if (or mml-externalize-attachments (not encoded-cache))
(message-encode-message-body)
(erase-buffer)
(insert encoded-cache))
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 109b6c17c2c..223da19a164 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -105,7 +105,7 @@ This is only used if `mm-inline-large-images' is set to
(lambda ()
(let ((inhibit-read-only t))
(remove-images b b)
- (delete-region b (1+ b)))))))
+ (delete-region b (+ b 2)))))))
(defvar mm-w3m-setup nil
"Whether gnus-article-mode has been setup to use emacs-w3m.")
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index 3064c46d2a3..07d72edf3a3 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -24,8 +24,7 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
-
+(require 'cl-lib)
(require 'smime)
(require 'mm-decode)
(require 'mml-sec)
@@ -129,11 +128,15 @@ Whether the passphrase is cached at all is controlled by
(if func
(funcall func handle ctl))))
-(defun mml-smime-openssl-sign (_cont)
- (when (null smime-keys)
- (customize-variable 'smime-keys)
- (error "No S/MIME keys configured, use customize to add your key"))
- (smime-sign-buffer (cdar smime-keys))
+(defun mml-smime-openssl-sign (cont)
+ (smime-sign-buffer
+ ;; List with key and certificate as its car, and a list of additional
+ ;; certificates to include in its cadr for smime-sign-region
+ (list
+ (cdr (assq 'keyfile cont))
+ (mapcar #'cdr (cl-remove-if-not (apply-partially #'equal 'chainfile)
+ cont
+ :key #'car-safe))))
(goto-char (point-min))
(while (search-forward "\r\n" nil t)
(replace-match "\n" t t))
@@ -167,21 +170,23 @@ Whether the passphrase is cached at all is controlled by
(when (null smime-keys)
(customize-variable 'smime-keys)
(error "No S/MIME keys configured, use customize to add your key"))
- (list 'keyfile
- (if (= (length smime-keys) 1)
- (cadar smime-keys)
- (or (let ((from (cadr (mail-extract-address-components
- (or (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (message-fetch-field "from")))
- "")))))
- (and from (smime-get-key-by-email from)))
- (smime-get-key-by-email
- (gnus-completing-read "Sign this part with what signature"
- (mapcar #'car smime-keys) nil nil nil
- (and (listp (car-safe smime-keys))
- (caar smime-keys))))))))
+ (let ((key-with-certs
+ (if (= (length smime-keys) 1)
+ (cdar smime-keys)
+ (or (let ((from (cadr (mail-extract-address-components
+ (or (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-fetch-field "from")))
+ "")))))
+ (and from (smime-get-key-with-certs-by-email from)))
+ (smime-get-key-with-certs-by-email
+ (gnus-completing-read "Sign this part with what signature"
+ (mapcar #'car smime-keys) nil nil nil
+ (and (listp (car-safe smime-keys))
+ (caar smime-keys))))))))
+ (append (list 'keyfile (car key-with-certs))
+ (mapcan (apply-partially #'list 'chainfile) (cadr
key-with-certs)))))
(defun mml-smime-get-file-cert ()
(ignore-errors
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index edb3c286242..e3bc3932529 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -233,6 +233,10 @@ part. This is for the internal use, you should never
modify the value.")
(if (eq (car-safe tag) 'certfile)
(cdr tag)))
taginfo)))
+ (chainfiles (delq nil (mapcar (lambda (tag)
+ (if (eq (car-safe tag)
'chainfile)
+ (cdr tag)))
+ taginfo)))
(recipients (cdr (assq 'recipients taginfo)))
(sender (cdr (assq 'sender taginfo)))
(location (cdr (assq 'tag-location taginfo)))
@@ -267,6 +271,10 @@ part. This is for the internal use, you should never
modify the value.")
(mapcar (lambda (certfile)
(list "certfile" certfile))
certfiles))
+ ,@(apply #'append
+ (mapcar (lambda (chainfile)
+ (list "chainfile" chainfile))
+ chainfiles))
,(if recipients "recipients")
,recipients
,(if sender "sender")
diff --git a/lisp/gnus/nnatom.el b/lisp/gnus/nnatom.el
new file mode 100644
index 00000000000..13286159784
--- /dev/null
+++ b/lisp/gnus/nnatom.el
@@ -0,0 +1,277 @@
+;;; nnatom.el --- Atom backend for Gnus -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+;; Author: Daniel Semyonov <daniel@dsemy.com>
+
+;; This file is part of GNU Emacs.
+
+;; nnatom 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.
+
+;; nnatom 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 nnatom. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'subr-x))
+
+(require 'nnfeed)
+(require 'mm-url)
+(require 'dom)
+
+(defgroup nnatom nil
+ "Atom backend for Gnus."
+ :group 'nnfeed)
+
+(nnoo-declare nnatom nnfeed)
+
+(nnfeed-define-basic-backend-interface nnatom)
+
+;;;; Atom feed parser:
+
+(declare-function libxml-parse-xml-region "xml.c")
+(defun nnatom--read-feed (feed _)
+ "Return a list structure representing FEED, or nil."
+ (if (string-match-p "\\`https?://" feed)
+ (nnheader-report
+ nnatom-backend
+ "Address shouldn't start with \"http://\"; or \"https://\"";)
+ (with-temp-buffer
+ (condition-case e
+ (if (file-name-absolute-p feed)
+ (insert-file-contents feed)
+ (mm-url-insert-file-contents (concat "https://"; feed)))
+ (file-error (nnheader-report nnatom-backend (cdr e)))
+ (:success (when-let ((data (if (libxml-available-p)
+ (libxml-parse-xml-region
+ (point-min) (point-max))
+ (car (xml-parse-region
+ (point-min) (point-max)))))
+ (authors (list 'authors)))
+ (when (eq (car data) 'top)
+ (setq data (assq 'feed data)))
+ (dom-add-child-before data authors)
+ (let ((all (dom-children data)))
+ (while-let ((rest (cdr all))
+ (child (car-safe rest))
+ (type (car-safe child))
+ ((not (eq type 'entry))))
+ (and (or (eq type 'author)
+ (eq type 'contributor))
+ (dom-add-child-before authors child))
+ (setq all rest))
+ ;; Order of entries is reversed as most Atom feeds
+ ;; list only the "most recent" entries, in reverse
+ ;; chronological order.
+ (setcdr all (nreverse (cdr all))))
+ data))))))
+(defvoo nnatom-read-feed-function #'nnatom--read-feed
+ nil nnfeed-read-feed-function)
+
+(defun nnatom--read-group (data)
+ "Return the next group and the remaining DATA in a cons cell, or nil."
+ `(,data))
+(defvoo nnatom-read-group-function #'nnatom--read-group
+ nil nnfeed-read-group-function)
+
+(defun nnatom--read-article (data _)
+ "Return the next article and the remaining DATA in a cons cell, or nil."
+ (when (eq (car data) 'feed) (setq data (dom-children data)))
+ ;; Discard any children between/after entries.
+ (while (and data (not (eq (car-safe (car data)) 'entry))) (pop data))
+ (when-let ((article (car data))
+ (auths (list 'authors)) (links (list 'links)))
+ (dom-add-child-before article links)
+ (dom-add-child-before article auths)
+ (dolist (child (cddddr article) `(,article . ,(cdr data)))
+ (pcase (car-safe child) ; Authors and links can appear
+ ((or 'author 'contributor) ; anywhere in the entry so we
+ (dom-add-child-before auths child) ; collect them all here to
+ (dom-add-child-before links child)) ; avoid looping over the
+ ((or 'link ; entry multiple times later.
+ (and 'content (guard (assq 'src (dom-attributes child)))))
+ (dom-add-child-before links child))))))
+(defvoo nnatom-read-article-function #'nnatom--read-article
+ nil nnfeed-read-article-function)
+
+(defun nnatom--read-title (group)
+ "Return the title of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'title)))
+(defvoo nnatom-read-title-function #'nnatom--read-title
+ nil nnfeed-read-title-function)
+
+(defun nnatom--read-description (group)
+ "Return the description of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'subtitle)))
+(defvoo nnatom-read-description-function #'nnatom--read-description
+ nil nnfeed-read-description-function)
+
+(defun nnatom--read-article-or-group-authors (article-or-group)
+ "Return the authors of ARTICLE-OR-GROUP, or nil."
+ (when-let
+ ((a (mapconcat
+ (lambda (author)
+ (let* ((name (dom-text (dom-child-by-tag author 'name)))
+ (name (unless (string-blank-p name) name))
+ (email (dom-text (dom-child-by-tag author 'email)))
+ (email (unless (string-blank-p email) email)))
+ (or (and name email (format "%s <%s>" name email)) name email)))
+ (dom-children (dom-child-by-tag article-or-group 'authors))
+ ", "))
+ ((not (string-blank-p a))))
+ a))
+(defvoo nnatom-read-author-function #'nnatom--read-article-or-group-authors
+ nil nnfeed-read-author-function)
+(defvoo nnatom-read-group-author-function
+ #'nnatom--read-article-or-group-authors
+ nil nnfeed-read-group-author-function)
+
+(defun nnatom--read-subject (article)
+ "Return the subject of ARTICLE, or nil."
+ (dom-text (dom-child-by-tag article 'title)))
+(defvoo nnatom-read-subject-function #'nnatom--read-subject
+ nil nnfeed-read-subject-function)
+
+(defun nnatom--read-id (article)
+ "Return the ID of ARTICLE.
+If the ARTICLE doesn't contain an ID but it does contain a subject,
+return the subject. Otherwise, return nil."
+ (or (dom-text (dom-child-by-tag article 'id))
+ (nnatom--read-subject article)))
+(defvoo nnatom-read-id-function #'nnatom--read-id
+ nil nnfeed-read-id-function)
+
+(defun nnatom--read-publish (article)
+ "Return the date and time ARTICLE was published, or nil."
+ (when-let (d (dom-child-by-tag article 'published))
+ (date-to-time (dom-text d))))
+(defvoo nnatom-read-publish-date-function #'nnatom--read-publish
+ nil nnfeed-read-publish-date-function)
+
+(defun nnatom--read-update (article)
+ "Return the date and time of the last update to ARTICLE, or nil."
+ (when-let (d (dom-child-by-tag article 'updated))
+ (date-to-time (dom-text d))))
+(defvoo nnatom-read-update-date-function #'nnatom--read-update
+ nil nnfeed-read-update-date-function)
+
+(defun nnatom--read-links (article)
+ "Return all links contained in ARTICLE, or nil."
+ (let ((alt 0) (rel 0) (sel 0) (enc 0) (via 0) (aut 0))
+ (mapcan
+ (lambda (link)
+ (when-let ((l (car-safe link)))
+ (or
+ (when-let (((eq l 'content))
+ (src (dom-attr link 'src))
+ (label (concat "Link"
+ (and (< 1 (cl-incf alt))
+ (format " %s" alt)))))
+ `(((("text/plain") . ,(format "%s: %s\n" label src))
+ (("text/html") . ,(format "<a href=\"%s\">[%s]</a> "
+ src label)))))
+ (when-let (((or (eq l 'author) (eq l 'contributor)))
+ (name (dom-text (dom-child-by-tag link 'name)))
+ (name (if (string-blank-p name)
+ (concat "Author"
+ (and (< 1 (cl-incf aut))
+ (format " %s" aut)))
+ name))
+ (uri (dom-text (dom-child-by-tag link 'uri)))
+ ((not (string-blank-p uri))))
+ `(((("text/plain") . ,(format "%s: %s\n" name uri))
+ (("text/html") . ,(format "<a href=\"%s\">[%s]</a> "
+ uri name)))))
+ (when-let (((eq l 'link))
+ (attrs (dom-attributes link))
+ (label (or (cdr (assq 'title attrs))
+ (pcase (cdr (assq 'rel attrs))
+ ("related"
+ (concat "Related"
+ (and (< 1 (cl-incf rel))
+ (format " %s" rel))))
+ ("self"
+ (concat "More"
+ (and (< 1 (cl-incf sel))
+ (format " %s" sel))))
+ ("enclosure"
+ (concat "Enclosure"
+ (and (< 1 (cl-incf enc))
+ (format " %s" enc))))
+ ("via"
+ (concat "Source"
+ (and (< 1 (cl-incf via))
+ (format " %s" via))))
+ (_ (if-let
+ ((lang (cdr (assq 'hreflang link))))
+ (format "Link (%s)" lang)
+ (concat
+ "Link"
+ (and (< 1 (cl-incf alt))
+ (format " %s" alt))))))))
+ (link (cdr (assq 'href attrs))))
+ `(((("text/plain") . ,(format "%s: %s\n" label link))
+ (("text/html") . ,(format "<a href=\"%s\">[%s]</a> "
+ link label))))))))
+ (dom-children (dom-child-by-tag article 'links)))))
+(defvoo nnatom-read-links-function #'nnatom--read-links
+ nil nnfeed-read-links-function)
+
+(defun nnatom--read-part (part type)
+ (let* ((atypes '("html" "plain"))
+ (mtypes '(("xhtml" . "text/html") ("text" . "text/plain")))
+ (xsuff (concat "[+/]xml\\(-\\(dtd\\|external-parsed-entity\\)\\)?\\'"
+ "\\|^text"))
+ (part (if (string= type "xhtml")
+ (with-temp-buffer
+ (dom-print (dom-child-by-tag part 'div) nil t)
+ (buffer-substring-no-properties
+ (point-min) (point-max)))
+ (dom-text part)))
+ (type (if (member type atypes) (concat "text/" type) type))
+ (type (or (cdr (assoc type mtypes)) type)))
+ (unless (string-blank-p part)
+ `(,part (Content-Type . ,(or type (setq type "text/plain")))
+ ,(and (not (string-match-p xsuff type))
+ '(Content-Transfer-Encoding . "base64"))))))
+
+(defun nnatom--read-parts (article)
+ "Return all parts contained in ARTICLE, or an empty HTML part with links."
+ (let* ((summary (dom-child-by-tag article 'summary))
+ (stype (cdr (assq 'type (dom-attributes summary))))
+ (summary (nnatom--read-part summary stype))
+ (content (dom-child-by-tag article 'content))
+ (ctype (cdr (assq 'type (dom-attributes content))))
+ (content (nnatom--read-part content ctype))
+ (st (string= stype ctype))
+ parts)
+ (cond ((and summary content)
+ (and st (push summary parts))
+ (push (append content '(links)) parts)
+ (or st (push summary parts)))
+ ((setq content (or summary content))
+ (push (append content '(links)) parts))
+ (t (push '((nil (Content-Type . "text/html") links)) parts)))
+ parts))
+(defvoo nnatom-read-parts-function #'nnatom--read-parts
+ nil nnfeed-read-parts-function)
+
+(gnus-declare-backend (symbol-name nnatom-backend) 'none 'address)
+
+(provide 'nnatom)
+
+;;; nnatom.el ends here
diff --git a/lisp/gnus/nnfeed.el b/lisp/gnus/nnfeed.el
new file mode 100644
index 00000000000..d6963b2e929
--- /dev/null
+++ b/lisp/gnus/nnfeed.el
@@ -0,0 +1,683 @@
+;;; nnfeed.el --- Generic feed backend for Gnus -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+;; Author: Daniel Semyonov <daniel@dsemy.com>
+
+;; This file is part of GNU Emacs.
+
+;; nnfeed 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.
+
+;; nnfeed 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 nnfeed. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Generic Gnus backend (intended) for implementing backends for web
+;; feeds (Atom, RSS).
+;;
+;; This backend is abstract - it doesn't implement a parser for any
+;; specific web feed type, and so can't be used independently.
+;;
+;; Instead, it implements a generic parser, feed data storage and most
+;; of the Gnus backend interface; the intended use for this backend is
+;; to be a source of inheritance for backends supporting new web feed
+;; types.
+;;
+;; To implement new backends, use `nnfeed-define-basic-backend-interface':
+;;
+;; ...
+;; (require 'nnfeed)
+;;
+;; (nnoo-declare nnfoo nnfeed)
+;;
+;; (nnfeed-define-basic-backend-interface nnfoo)
+;; ...
+;; [ definitions of parsing functions, see the "Feed parser interface"
+;; section for more information. ]
+;;
+;; (defvoo nnfoo-read-feed-function #'nnfoo--read-feed
+;; nil nnfeed-read-feed-function)
+;; ...
+;; (gnus-declare-backend (symbol-name nnfeed-backend) 'none 'address)
+;;
+;; (provide 'nnfoo)
+;;
+;;; Code:
+
+(eval-when-compile
+ (require 'subr-x))
+
+(require 'gnus)
+(require 'nnoo)
+
+(defgroup nnfeed nil
+ "Generic feed backend for Gnus."
+ :group 'gnus)
+
+(defcustom nnfeed-date-format "%F %X%p"
+ "Format of displayed dates (see function `format-time-string')."
+ :type 'string)
+
+(nnoo-declare nnfeed)
+
+(defvoo nnfeed-backend nil
+ "Symbol which identifies this backend.")
+
+(defvoo nnfeed-status-string nil
+ "Last status message reported by this backend.")
+
+;; This macro should be used to define inheriting backends.
+
+(defmacro nnfeed-define-basic-backend-interface (backend)
+ "Define a basic set of functions and variables for BACKEND."
+ `(progn
+ (defvoo ,(nnoo-symbol backend 'backend) ',backend nil nnfeed-backend)
+ (defvoo ,(nnoo-symbol backend 'status-string)
+ nil nil nnfeed-status-string)
+ (defvoo ,(nnoo-symbol backend 'group) nil nil nnfeed-group)
+ (defvoo ,(nnoo-symbol backend 'servers)
+ (make-hash-table :test 'equal) nil nnfeed-servers)
+ (defvoo ,(nnoo-symbol backend 'group-article-ids)
+ (make-hash-table :test 'equal) nil nnfeed-group-article-ids)
+ (defvoo ,(nnoo-symbol backend 'group-articles)
+ (make-hash-table :test 'eql) nil nnfeed-group-articles)
+ (defvoo ,(nnoo-symbol backend 'group-article-max-num) 0 nil
+ nnfeed-group-article-max-num)
+ (defvoo ,(nnoo-symbol backend 'group-article-mix-num) 1 nil
+ nnfeed-group-article-min-num)
+ ,@(mapcar (lambda (fun)
+ `(deffoo ,(nnoo-symbol backend fun) (&optional server)
+ (,(nnoo-symbol 'nnoo fun) ',backend server)))
+ '(server-opened status-message))
+ (deffoo ,(nnoo-symbol backend 'open-server) (server &optional defs)
+ (nnfeed-open-server server defs ',backend))
+ (nnoo-import ,backend (nnfeed))))
+
+;;;; Feed parser interface:
+
+;; The following set of server variables define a parser for a
+;; specific web feed type.
+;; An inheriting backend doesn't necessarily have to define all of
+;; these functions (see the comments below for more information).
+;; Apart from this set of variables there is also
+;; `nnfeed-print-content-function' which can optionally be defined
+;; by an inheriting backend to allow more advanced control over the
+;; printing of articles.
+
+(defvoo nnfeed-read-feed-function #'ignore
+ "Function returning a Lisp object representing a feed (or part of it).
+
+It should accept two arguments, the address of a feed and the name of
+a group (or nil).
+If a group name is supplied, it should return a representation of only
+the group (as if it was extracted from the feed with
+`nnfeed-read-group-function').")
+
+(defvoo nnfeed-read-group-function #'ignore
+ "Function returning a cons cell of a group and remaining data from a feed.
+
+The returned group can be represented by any Lisp object.
+It should accept a single argument, a Lisp object representing a feed
+\(as can be returned by this function or `nnfeed-read-feed-function').")
+
+(defvoo nnfeed-read-article-function #'ignore
+ "Function returning a cons cell of an article and remaining data from a
group.
+
+The returned article can be represented by any Lisp object.
+It should accept two arguments, a Lisp object representing a group
+\(as can be returned by this function or `nnfeed-read-group-function'),
+and a flag indicating whether the last article was not new or updated.")
+
+(defvoo nnfeed-read-title-function #'ignore
+ "Function returning the title of a group (a string).
+
+It should accept a single argument, a Lisp object representing a group
+\(as returned by `nnfeed-read-group-function').")
+
+;; Optional.
+(defvoo nnfeed-read-description-function #'ignore
+ "Function returning the description of a group (a string), or nil.
+
+It should accept a single argument, a Lisp object representing a group
+\(as returned by `nnfeed-read-group-function').")
+
+;; Either this function or `nnfeed-read-author-function' is required.
+(defvoo nnfeed-read-group-author-function #'ignore
+ "Function returning the author of a group (a string), or nil.
+
+It should accept a single argument, a Lisp object representing a group
+\(as returned by `nnfeed-read-group-function')..")
+
+(defvoo nnfeed-read-id-function #'ignore
+ "Function returning the ID of an article.
+
+It should accept a single argument, a Lisp object representing an article
+\(as returned by `nnfeed-read-article-function').")
+
+(defvoo nnfeed-read-subject-function #'ignore
+ "Function returning the subject of an article (a string), or nil.
+
+It should accept a single argument, a Lisp object representing an article
+\(as returned by `nnfeed-read-article-function').")
+
+;; Either this function or `nnfeed-read-update-date-function' is required.
+(defvoo nnfeed-read-publish-date-function #'ignore
+ "Function returning the publish date of an article (a time value), or nil.
+
+It should accept a single argument, a Lisp object representing an article
+\(as returned by `nnfeed-read-article-function').")
+
+;; Either this function or `nnfeed-read-publish-date-function' is required.
+(defvoo nnfeed-read-update-date-function #'ignore
+ "Function returning the update date of an article (a time value), or nil.
+
+It should accept a single argument, a Lisp object representing an article
+\(as returned by `nnfeed-read-article-function').")
+
+;; Either this function or `nnfeed-read-group-author-function' is required.
+(defvoo nnfeed-read-author-function #'ignore
+ "Function returning the author of an article (a string), or nil.
+
+It should accept a single argument, a Lisp object representing an article
+\(as returned by `nnfeed-read-article-function').")
+
+(defvoo nnfeed-read-headers-function #'ignore
+ "Function returning an alist of article-wide MIME headers.
+
+Each element of this alist maps a MIME header (a symbol,
+i.e. `Content-Type') to its value. As a special case, `:boundary'
+maps to a string which will serve as the boundary between article
+parts. This must be supplied if a custom boundary is used in a
+multipart content type header. The default boundary is \"-_nnfeed_-\",
+and is automatically modified to match the name of the back end.
+It should accept a single argument, a Lisp object representing an article
+\(as returned by `nnfeed-read-article-function').")
+
+;; As mentioned in their docstrings, the last two parsing functions
+;; can optionally return any Lisp representation they want, provided
+;; an appropriate `nnfeed-print-content-function' is defined. This
+;; means they are also not _strictly_ required.
+
+(defvoo nnfeed-read-links-function #'ignore
+ "Function returning all links contained in an article.
+
+With the default `nnfeed-print-content-function', it should return a
+list of links, where each link is an alist mapping MIME content types
+to links formatted for display in a part of that type. Each content
+type may also be a list of content types.
+Otherwise, it could return any Lisp object.
+It should accept a single argument, a Lisp object representing an article
+\(as returned by `nnfeed-read-article-function').")
+
+(defvoo nnfeed-read-parts-function #'ignore
+ "Function returning an alist associating parts of an article to their
headers.
+
+With the default `nnfeed-print-content-function', each part should be a
+string. Otherwise, it can be any Lisp object. The \"headers\" of
+each part should be a list where each element is either a cons of a
+MIME header (a symbol, i.e. `Content-Type') and its value (a string),
+or any other Lisp object. MIME headers will be printed, the rest will
+be passed on to `nnfeed-print-content-function', which recognizes the
+following extra data by default:
+- `links', if present, will cause links to be printed in the part.
+It should accept a single argument, a Lisp object representing an article
+\(as returned by `nnfeed-read-article-function').")
+
+;;;; Feed data storage:
+
+;; This section defines the data types used to store feed data, and
+;; functions to read and write it.
+;; All variables in this section are automatically defined by
+;; `nnfeed-define-basic-backend-interface'.
+
+(defvoo nnfeed-servers (make-hash-table :test 'equal)
+ "Hash table mapping known servers to their groups.
+
+Each value in this table should itself be a hash table mapping known
+group names to their data, which should be a vector of the form
+[GROUP IDS ARTICLES MAX MIN DESCRIPTION], where:
+- GROUP is the \"real\" group name (the name known to the server).
+- IDS is a hash table mapping article IDs to their numbers.
+- ARTICLES is a hash table mapping article numbers to articles and
+ their attributes (see `nnfeed-group-articles').
+- MAX is the maximum article number.
+- MIN is the minimum article number.
+- DESCRIPTION is the group description.")
+
+(defvoo nnfeed-group-names (make-hash-table :test 'equal)
+ "Hash table mapping real group names to their custom name.")
+
+(defun nnfeed--server-address (server)
+ "Return SERVER's real address."
+ (if (string-suffix-p "-ephemeral" server)
+ (setq server (or (cadr (assq (nnoo-symbol nnfeed-backend 'address)
+ (cddr (gnus-server-to-method
+ (concat
+ (symbol-name nnfeed-backend) ":"
+ server)))))
+ server))
+ server))
+
+(defun nnfeed--server-file (server)
+ "Return the file containing data for SERVER."
+ (expand-file-name (format "%s/%s.eld"
+ (string-trim (symbol-name nnfeed-backend)
+ "nn")
+ (gnus-newsgroup-savable-name
+ (nnfeed--server-address server)))
+ gnus-directory))
+
+(defun nnfeed--read-server (server)
+ "Read SERVER's information from storage."
+ (if-let ((f (nnfeed--server-file server))
+ ((file-readable-p f)))
+ (with-temp-buffer
+ (insert-file-contents f)
+ (goto-char (point-min))
+ (puthash server (read (current-buffer)) nnfeed-servers))
+ (nnheader-report nnfeed-backend "Can't read %s" server)))
+
+(defun nnfeed--write-server (server)
+ "Write SERVER's information to storage."
+ (if-let ((f (nnfeed--server-file server))
+ ((file-writable-p f)))
+ (if-let ((s (gethash server nnfeed-servers))
+ ((hash-table-p s)))
+ (with-temp-file f
+ (insert ";;;; -*- mode: lisp-data -*- DO NOT EDIT\n")
+ (prin1 s (current-buffer))
+ (insert "\n")
+ t)
+ t)
+ (nnheader-report nnfeed-backend "Can't write %s" f)))
+
+;; The following function uses the parsing functions defined in the last
+;; section to parse a feed (or just one group from it).
+;; This is the only place where these parsing functions are used; the Gnus
+;; backend interface extracts all required information from the parsed feed.
+
+(defun nnfeed--parse-feed (feed &optional group)
+ "Parse GROUP from FEED into a new or existing server.
+If GROUP is omitted or nil, parse the entire FEED."
+ (let* ((feed (nnfeed--server-address feed))
+ (s (or (gethash feed nnfeed-servers) (nnfeed--read-server feed)
+ (make-hash-table :test 'equal)))
+ (name group) ; (Maybe) fake name (or nil)
+ (group (aref (gethash group s `[,group]) 0)) ; Real name (or nil)
+ data)
+ (when (setq data (funcall nnfeed-read-feed-function feed group))
+ (while-let ((cg (or (and name (cons data)) ; `data' is a single group
+ (funcall nnfeed-read-group-function data)))
+ (cg (prog1 (car cg) (setq data (cdr cg)))))
+ (let* ((name (funcall nnfeed-read-title-function cg)) ; Real name
+ (group (gethash name nnfeed-group-names name)) ; (Maybe) fake
name
+ (info (gnus-get-info
+ (concat (symbol-name nnfeed-backend) "+" feed ":"
group)))
+ (g (or (gethash group s)
+ `[ ,name ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""]))
+ (desc (funcall nnfeed-read-description-function cg))
+ (ids (aref g 1))
+ (articles (aref g 2))
+ (max (aref g 3))
+ (max (if max max
+ (setq max 0) ; Find max article number
+ (dolist ; remembered by Gnus.
+ ( r (cons (gnus-info-read info)
+ (gnus-info-marks info))
+ max)
+ (mapc (lambda (x)
+ (let ((x (if (consp x)
+ (if (< (car x) (cdr x))
+ (cdr x) (car x))
+ x)))
+ (when (< max x) (setq max x))))
+ (if (symbolp (car r)) (cdr r) r)))))
+ (group-author (funcall nnfeed-read-group-author-function cg))
+ stale)
+ (and desc (aset g 5 desc))
+ (while-let ((article (funcall nnfeed-read-article-function cg stale))
+ (article (prog1 (car article) (setq cg (cdr article)))))
+ (when-let ((id (funcall nnfeed-read-id-function article))
+ (id (format "<%s@%s.%s>" id name nnfeed-backend)))
+ (let* ((num (gethash id ids))
+ (update (funcall nnfeed-read-update-date-function
article))
+ (prev-update (aref (gethash num articles
+ '[nil nil nil nil nil])
+ 4)))
+ (if (or (null num) ; New article ID.
+ (and (null prev-update) update)
+ (and prev-update update
+ (time-less-p prev-update update)))
+ (let* ((num (or num (aset g 3 (setq max (1+ max)))))
+ (publish (funcall nnfeed-read-publish-date-function
+ article)))
+ (setf
+ (gethash id (aref g 1)) num
+ (gethash num (aref g 2))
+ `[ ,id
+ ,(or (funcall nnfeed-read-author-function article)
+ group-author group)
+ ,(or (funcall nnfeed-read-subject-function article)
+ "no subject")
+ ,(or publish update '(0 0)) ; published
+ ,(or update publish '(0 0)) ; updated
+ ,(funcall nnfeed-read-links-function article)
+ ,(funcall nnfeed-read-parts-function article)
+ ,(funcall nnfeed-read-headers-function article)]
+ stale nil))
+ (setq stale t)))))
+ (puthash group g s)))
+ (puthash feed s nnfeed-servers))))
+
+;;;; Gnus backend functions:
+
+;; The following two sections define a Gnus backend interface based on
+;; the parsed data from the last section.
+;; All server variables in this section are automatically defined by
+;; `nnfeed-define-basic-backend-interface'.
+;; For more information about these functions see the "Back End
+;; Interface" section of the Gnus manual.
+
+(defvoo nnfeed-group nil
+ "Name of the current group.")
+
+(defvoo nnfeed-group-article-ids (make-hash-table :test 'equal)
+ "Hash table mapping article IDs to their article number.")
+
+(defvoo nnfeed-group-articles (make-hash-table :test 'eql)
+ "Hash table mapping article numbers to articles and their attributes.
+
+Each value in this table should be a vector of the form
+[ID FROM SUBJECT DATE UPDATED LINKS PARTS HEADERS], where:
+- ID is the ID of the article.
+- FROM is the author of the article or group.
+- SUBJECT is the subject of the article.
+- DATE is the date the article was published, or last updated (time value).
+- UPDATE is the date the article was last updated, or published (time value).
+- LINKS is a collection of links (any Lisp object).
+- PARTS is an alist associating the content of each part of the
+ article to its headers.
+- HEADERS is an alist associating article-wide MIME headers to their value.")
+
+(defvoo nnfeed-group-article-max-num 0
+ "Maximum article number for the current group.")
+
+(defvoo nnfeed-group-article-min-num 1
+ "Minimum article number for the current group.")
+
+(nnoo-define-basics nnfeed)
+
+(defun nnfeed--current-server-no-prefix ()
+ "Remove the \"<backend>+\" prefix from the current server."
+ (string-remove-prefix (concat (symbol-name nnfeed-backend) "+")
+ (nnoo-current-server nnfeed-backend)))
+
+(defun nnfeed--group-data (group server)
+ "Get parsed data for GROUP from SERVER."
+ (when-let ((server (nnfeed--server-address server))
+ (s (gethash server nnfeed-servers))
+ ((hash-table-p s)))
+ (gethash group s)))
+
+(defun nnfeed-retrieve-article (article group)
+ "Retrieve headers for ARTICLE from GROUP."
+ (if-let ((a (gethash article (aref group 2))))
+ (insert (format "221 %s Article retrieved.
+From: %s\nSubject: %s\nDate: %s\nMessage-ID: %s\n.\n"
+ article
+ (aref a 1)
+ (aref a 2)
+ (format-time-string "%F %H:%M" (aref a 3))
+ (aref a 0)))
+ (insert "404 Article not found.\n.\n")))
+
+(deffoo nnfeed-retrieve-headers (articles &optional group server _fetch-old)
+ (if-let ((server (or server (nnfeed--current-server-no-prefix)))
+ (g (or (nnfeed--group-data group server)
+ `[ nil ,nnfeed-group-article-ids ,nnfeed-group-articles
+ nil nil nil])))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (or (and (stringp (car articles))
+ (mapc (lambda (a)
+ (nnfeed-retrieve-article
+ (gethash a (aref g 2)) g))
+ articles))
+ (and (numberp (car articles))
+ (range-map (lambda (a) (nnfeed-retrieve-article a g))
+ articles)))
+ 'headers)
+ (nnheader-report nnfeed-backend "Group %s not found" (or group ""))))
+
+(deffoo nnfeed-open-server (server &optional defs backend)
+ (let ((backend (or backend 'nnfeed))
+ (a (nnfeed--server-address server))
+ s)
+ (nnoo-change-server backend server defs)
+ (when (setq s (or (gethash a nnfeed-servers) (nnfeed--read-server server)))
+ (maphash (lambda (group g)
+ (setq g (aref g 0))
+ (unless (string= group g)
+ (puthash g group nnfeed-group-names)))
+ s))
+ (setq a (nnfeed--server-file server))
+ (or s (condition-case _ (make-directory (file-name-parent-directory a) t)
+ (:success (file-writable-p a))
+ (t nil))
+ (and (nnoo-close-server nnfeed-backend server)
+ (nnheader-report
+ nnfeed-backend "Server file %s not readable or writable"
+ server)))))
+
+(deffoo nnfeed-request-close ()
+ (when (hash-table-p nnfeed-servers)
+ (maphash (lambda (server _) (nnfeed--write-server server)) nnfeed-servers)
+ (setq nnfeed-servers (make-hash-table :test 'equal)))
+ (setq nnfeed-status-string nil)
+ t)
+
+;; The default content printing function, which should be suitable for
+;; most inheriting backends.
+
+(defun nnfeed--print-content (content attributes links)
+ "Return CONTENT formatted according to ATTRIBUTES, with LINKS possibly
added."
+ (let ((links (and (memq 'links attributes) links)))
+ (when (or content links)
+ (concat
+ (and content (format "%s\n\n" content))
+ (mapconcat (lambda (link)
+ (cdr (assoc (cdr (assq 'Content-Type attributes)) link
+ (lambda (types type)
+ (if (stringp types) (string= types type)
+ (member type types))))))
+ links)))))
+
+(defvoo nnfeed-print-content-function #'nnfeed--print-content
+ "Function returning a single piece of content for an article (a string).
+
+It should accept three arguments, a part and its attributes (as returned
+by `nnfeed-read-parts-function'), and links (as returned by
+`nnfeed-read-links-function').")
+
+(defun nnfeed--print-part (content headers mime links)
+ "Print part of an article using its CONTENT, HEADERS, and LINKS.
+Only HEADERS of a type included in MIME are considered."
+ (concat
+ (mapconcat (lambda (header)
+ (when-let ((m (car-safe header))
+ ((member m mime)))
+ (format "%s: %s\n" m (cdr header))))
+ headers)
+ "\n"
+ (funcall nnfeed-print-content-function content headers links)))
+
+(deffoo nnfeed-request-article (article &optional group server to-buffer)
+ (if-let ((server (or server (nnfeed--current-server-no-prefix)))
+ (g (or (nnfeed--group-data group server)
+ (and (setq group nnfeed-group)
+ `[ nil ,nnfeed-group-article-ids
+ ,nnfeed-group-articles
+ ,nnfeed-group-article-max-num
+ ,nnfeed-group-article-min-num nil])))
+ (num (or (and (stringp article)
+ (gethash article (aref g 1)))
+ (and (numberp article) article)))
+ ((and (<= num (aref g 3))
+ (>= num (aref g 4))))
+ (a (gethash num (aref g 2))))
+ (with-current-buffer (or to-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let* ((links (aref a 5))
+ (parts (aref a 6))
+ (headers (aref a 7))
+ (boundary (or (cdr (assq :boundary headers))
+ (format "-_%s_-" nnfeed-backend)))
+ (multi (length> parts 1))
+ (mime '( Content-Type Content-Disposition
+ Content-Transfer-Encoding)))
+ (insert (format
+ "Subject: %s\nFrom: %s\nDate: %s\nMessage-ID: %s\n"
+ (aref a 2) (aref a 1)
+ (format-time-string
+ nnfeed-date-format (or (aref a 3) '(0 0)))
+ (aref a 0))
+ (if (assq 'MIME-Version headers) "" "MIME-Version: 1.0\n")
+ (mapconcat (lambda (header)
+ (unless (keywordp (car header))
+ (format "%s: %s\n" (car header) (cdr
header))))
+ headers)
+ (if multi
+ (if (assq 'Content-Type headers) ""
+ (format
+ "Content-Type: multipart/alternative; boundary=%s\n"
+ boundary))
+ (prog1 (nnfeed--print-part
+ (caar parts) (cdar parts) mime links)
+ (setq parts nil)))
+ (mapconcat (lambda (part)
+ (format "--%s\n%s\n" boundary
+ (nnfeed--print-part
+ (car part) (cdr part) mime links)))
+ parts)
+ (if multi (format "--%s--" boundary) "\n")))
+ `(,group . ,num))
+ (nnheader-report nnfeed-backend "No such article")))
+
+(deffoo nnfeed-request-group (group &optional server fast _info)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (if-let ((server (or server (nnfeed--current-server-no-prefix)))
+ (g (or (if fast (nnfeed--group-data group server)
+ (setq server (nnfeed--parse-feed server group))
+ (and (hash-table-p server) (gethash group server)))
+ `[ ,group ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) 0 1 ""])))
+ (progn
+ (setq nnfeed-group group
+ nnfeed-group-article-ids (aref g 1)
+ nnfeed-group-articles (aref g 2)
+ nnfeed-group-article-max-num (aref g 3)
+ nnfeed-group-article-min-num (aref g 4))
+ (insert (format "211 %s %s %s \"%s\""
+ (hash-table-count nnfeed-group-article-ids)
+ nnfeed-group-article-min-num
+ nnfeed-group-article-max-num group))
+ t)
+ (insert "404 group not found")
+ (nnheader-report nnfeed-backend "Group %s not found" group))))
+
+(deffoo nnfeed-close-group (group &optional server)
+ (and (string= group nnfeed-group)
+ (setq nnfeed-group nil
+ nnfeed-group-article-ids (make-hash-table :test 'equal)
+ nnfeed-group-articles (make-hash-table :test 'eql)
+ nnfeed-group-article-max-num 0
+ nnfeed-group-article-min-num 1))
+ (setq server (or server (nnfeed--current-server-no-prefix)))
+ (nnfeed--write-server server))
+
+(deffoo nnfeed-request-list (&optional server)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (when-let ((p (point))
+ (s (nnfeed--parse-feed
+ (or server (nnfeed--current-server-no-prefix))))
+ ((hash-table-p s)))
+ (maphash (lambda (group g)
+ (insert (format "\"%s\" %s %s y\n"
+ group (aref g 3) (aref g 4))))
+ s)
+ (not (= (point) p)))))
+
+(deffoo nnfeed-request-post (&optional _server)
+ (nnheader-report nnfeed-backend "%s is a read only backend" nnfeed-backend))
+
+;;;; Optional back end functions:
+
+(deffoo nnfeed-retrieve-groups (_groups &optional server)
+ (nnfeed-request-list server)
+ 'active)
+
+(deffoo nnfeed-request-type (_group &optional _article)
+ 'unknown)
+
+(deffoo nnfeed-request-group-description (group &optional server)
+ (when-let ((server (or server (nnfeed--current-server-no-prefix)))
+ (g (nnfeed--group-data group server)))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (insert group " " (aref g 5) "\n"))))
+
+(deffoo nnfeed-request-list-newsgroups (&optional server)
+ (when-let ((server (or server (nnfeed--current-server-no-prefix)))
+ (s (gethash (nnfeed--server-address server) nnfeed-servers))
+ ((hash-table-p s)))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (maphash (lambda (group g)
+ (insert group " " (aref g 5) "\n"))
+ s))))
+
+(deffoo nnfeed-request-rename-group (group new-name &optional server)
+ (when-let ((server (or server (nnfeed--current-server-no-prefix)))
+ (a (nnfeed--server-address server))
+ (s (or (gethash a nnfeed-servers)
+ (and ; Open the server to add it to `nnfeed-servers'
+ (save-match-data
+ (nnfeed-open-server
+ server
+ (cdr ; Get defs and backend.
+ (assoc a (cdr (assq nnfeed-backend nnoo-state-alist))
+ (lambda (car key)
+ (and (stringp car)
+ (string-match
+ (concat
+ "\\`\\(\\(nn[[:alpha:]]+\\)\\+\\)?"
+ (regexp-quote key) "\\'")
+ car)
+ (setq server car)))))
+ (if (match-string 1 server)
+ (intern (match-string 2 server)) 'nnfeed)))
+ (gethash a nnfeed-servers))))
+ (g (or (nnfeed--group-data group a)
+ `[ ,group ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""])))
+ (puthash new-name g s)
+ (puthash group new-name nnfeed-group-names)
+ (remhash group s)
+ (and (string= group nnfeed-group)
+ (setq nnfeed-group new-name))
+ t))
+
+(provide 'nnfeed)
+
+;;; nnfeed.el ends here
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 17a55f988c9..c61dfecfa7a 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -97,7 +97,7 @@ Uses the same syntax as `nnmail-split-methods'.")
(defvoo nnimap-authenticator nil
"How nnimap authenticate itself to the server.
Possible choices are nil (use default methods), `anonymous',
-`login', `plain' and `cram-md5'.")
+`login', `plain', `cram-md5' and `xoauth2'.")
(defvoo nnimap-expunge 'on-exit
"When to expunge deleted messages.
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index b61579912dd..987bc7273db 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -261,7 +261,7 @@ password under `cache-key'."
If signing fails, the buffer is not modified. Region is assumed to
have proper MIME tags. KEYFILE is expected to contain a PEM encoded
private key and certificate as its car, and a list of additional
-certificates to include in its caar. If no additional certificates is
+certificates to include in its cadr. If no additional certificates are
included, KEYFILE may be the file containing the PEM encoded private
key and certificate itself."
(smime-new-details-buffer)
@@ -327,7 +327,10 @@ is expected to contain of a PEM encoded certificate."
(defun smime-sign-buffer (&optional keyfile buffer)
"S/MIME sign BUFFER with key in KEYFILE.
-KEYFILE should contain a PEM encoded key and certificate."
+KEYFILE is expected to contain a PEM encoded private key and certificate
+as its car, and a list of additional certificates to include in its
+cadr. If no additional certificates are included, KEYFILE may be the
+file containing the PEM encoded private key and certificate itself."
(interactive)
(with-current-buffer (or buffer (current-buffer))
(unless (smime-sign-region
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index cfe27077055..a202c2d247e 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -362,14 +362,17 @@ if the variable `help-downcase-arguments' is non-nil."
(propertize (if help-downcase-arguments (downcase arg) arg)
'face 'help-argument-name))
-(defun help-do-arg-highlight (doc args)
+(defun help-do-arg-highlight (doc args &optional usage-p)
(with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\- "w")
(dolist (arg args)
(setq doc (replace-regexp-in-string
;; This is heuristic, but covers all common cases
;; except ARG1-ARG2
- (concat "([^ ]+ .*" ; skip function name
+ (concat (when usage-p
+ ;; Skip function name in usage string
+ ;; (Bug#65580).
+ "([^ ]+ .*")
"\\<" ; beginning of word
"\\(?:[a-z-]*-\\)?" ; for xxx-ARG
"\\("
@@ -404,7 +407,7 @@ if the variable `help-downcase-arguments' is non-nil."
(search-backward "(")
(goto-char (scan-sexps (point) 1)))))
;; Highlight arguments in the USAGE string
- (setq usage (help-do-arg-highlight (buffer-string) args))
+ (setq usage (help-do-arg-highlight (buffer-string) args t))
;; Highlight arguments in the DOC string
(setq doc (and doc (help-do-arg-highlight doc args))))))
;; Return value is like the one from help-split-fundoc, but highlighted
@@ -658,16 +661,14 @@ the C sources, too."
(progn
(insert (format-message " `%s'" handler))
(save-excursion
- (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
- nil t)
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'"))
(help-xref-button 1 'help-function handler)))
;; FIXME: Obsolete since 24.4.
(let ((lib (get function 'compiler-macro-file)))
(when (stringp lib)
(insert (format-message " in `%s'" lib))
(save-excursion
- (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
- nil t)
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'"))
(help-xref-button 1 'help-function-cmacro function lib)))))))
(unless (bolp)
(insert ". See "
@@ -734,7 +735,7 @@ the C sources, too."
(insert (format
(if (eq kind 'inferred)
"\nInferred type: %s\n"
- "\nType: %s\n")
+ "\nDeclared type: %s\n")
type-spec))))
(fill-region fill-begin (point))
high-doc)))))
@@ -1132,8 +1133,7 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED
REAL-DEF)."
(setq help-mode--current-data (list :symbol function
:file file-name))
(save-excursion
- (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
- nil t)
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'"))
(help-xref-button 1 'help-function-def function file-name))))
(princ "."))))
@@ -1332,8 +1332,7 @@ it is displayed along with the global value."
:file file-name))
(save-excursion
(re-search-backward (substitute-command-keys
- "`\\([^`']+\\)'")
- nil t)
+ "`\\([^`']+\\)'"))
(help-xref-button 1 'help-variable-def
variable file-name)))
(if valvoid
@@ -1572,8 +1571,7 @@ This cancels value editing without updating the value."
(princ (concat " You can " customize-label (or text " this variable.")))
(with-current-buffer standard-output
(save-excursion
- (re-search-backward
- (concat "\\(" customize-label "\\)") nil t)
+ (re-search-backward (concat "\\(" customize-label "\\)"))
(help-xref-button 1 'help-customize-variable variable)))
(terpri))))
@@ -1803,8 +1801,7 @@ If FRAME is omitted or nil, use the selected frame."
"\n\n"))
(with-current-buffer standard-output
(save-excursion
- (re-search-backward
- (concat "\\(" customize-label "\\)") nil t)
+ (re-search-backward (concat "\\(" customize-label "\\)"))
(help-xref-button 1 'help-customize-face f)))
(setq file-name (find-lisp-object-file-name f 'defface))
(if (not file-name)
@@ -1817,7 +1814,7 @@ If FRAME is omitted or nil, use the selected frame."
;; Make a hyperlink to the library.
(save-excursion
(re-search-backward
- (substitute-command-keys "`\\([^`']+\\)'") nil t)
+ (substitute-command-keys "`\\([^`']+\\)'"))
(help-xref-button 1 'help-face-def f file-name))
(princ ".")
(terpri)
@@ -1864,7 +1861,7 @@ If FRAME is omitted or nil, use the selected frame."
(not (eq attr 'unspecified)))
;; Make a hyperlink to the parent face.
(save-excursion
- (re-search-backward ": \\([^:]+\\)" nil t)
+ (re-search-backward ": \\([^:]+\\)")
(help-xref-button 1 'help-face attr)))
(insert "\n")))
(terpri)))
@@ -2115,9 +2112,7 @@ keymap value."
"C source code"
(help-fns-short-filename file-name))))
(save-excursion
- (re-search-backward (substitute-command-keys
- "`\\([^`']+\\)'")
- nil t)
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'"))
(setq help-mode--current-data (list :symbol keymap
:file file-name))
(help-xref-button 1 'help-variable-def
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 48433d899ab..e16408be7b0 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -265,7 +265,9 @@ The format is (FUNCTION ARGS...).")
(require 'find-func)
(when (eq file 'C-source)
(setq file
- (help-C-file-name (indirect-function fun) 'fun)))
+ (if (memq type '(variable defvar))
+ (help-C-file-name fun 'var)
+ (help-C-file-name (indirect-function fun) 'fun))))
;; Don't use find-function-noselect because it follows
;; aliases (which fails for built-in functions).
(let* ((location
diff --git a/lisp/help.el b/lisp/help.el
index d4e39f04e53..616a45328fd 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1049,6 +1049,9 @@ with `mouse-movement' events."
(let ((enable-disabled-menus-and-buttons t)
(cursor-in-echo-area t)
(side-event nil)
+ ;; Showing the list of key sequences makes no sense when they
+ ;; asked about a key sequence.
+ (echo-keystrokes-help nil)
saved-yank-menu)
(unwind-protect
(let (last-modifiers key-list)
@@ -1066,8 +1069,11 @@ with `mouse-movement' events."
;; After a click, see if a double click is on the way.
(and (memq 'click last-modifiers)
(not (sit-for (/ (mouse-double-click-time) 1000.0) t))))
- (let* ((seq (read-key-sequence "\
+ (let* ((prompt
+ (propertize "\
Describe the following key, mouse click, or menu item: "
+ 'face 'minibuffer-prompt))
+ (seq (read-key-sequence prompt
nil nil 'can-return-switch-frame))
(raw-seq (this-single-command-raw-keys))
(keyn (when (> (length seq) 0)
@@ -2349,9 +2355,8 @@ the same names as used in the original source code, when
possible."
;; If definition is a macro, find the function inside it.
(if (eq (car-safe def) 'macro) (setq def (cdr def)))
(cond
- ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0))
+ ((and (closurep def) (listp (aref def 0))) (aref def 0))
((eq (car-safe def) 'lambda) (nth 1 def))
- ((eq (car-safe def) 'closure) (nth 2 def))
((and (featurep 'native-compile)
(subrp def)
(listp (subr-native-lambda-list def)))
diff --git a/lisp/image/image-dired-tags.el b/lisp/image/image-dired-tags.el
index 2b5248cb14b..54595adc147 100644
--- a/lisp/image/image-dired-tags.el
+++ b/lisp/image/image-dired-tags.el
@@ -32,8 +32,6 @@
(require 'image-dired-util)
-(declare-function image-dired--with-marked "image-dired")
-
(defvar image-dired-dir)
(defvar image-dired-thumbnail-storage)
(defvar image-dired-tags-db-file)
@@ -156,18 +154,6 @@ With prefix ARG, tag the file at point."
(cons x tag))
files))))
-(defun image-dired-tag-thumbnail ()
- "Tag current or marked thumbnails."
- (interactive nil image-dired-thumbnail-mode)
- (let ((tag (completing-read
- "Tags to add (separate tags with a semicolon): "
- image-dired-tag-history nil nil nil 'image-dired-tag-history)))
- (image-dired--with-marked
- (image-dired-write-tags
- (list (cons (image-dired-original-file-name) tag)))
- (image-dired-update-property
- 'tags (image-dired-list-tags (image-dired-original-file-name))))))
-
;;;###autoload
(defun image-dired-delete-tag (arg)
"Remove tag for selected file(s).
@@ -181,16 +167,6 @@ With prefix argument ARG, remove tag from file at point."
(setq files (dired-get-marked-files)))
(image-dired-remove-tag files tag)))
-(defun image-dired-tag-thumbnail-remove ()
- "Remove tag from current or marked thumbnails."
- (interactive nil image-dired-thumbnail-mode)
- (let ((tag (completing-read "Tag to remove: " image-dired-tag-history
- nil nil nil 'image-dired-tag-history)))
- (image-dired--with-marked
- (image-dired-remove-tag (image-dired-original-file-name) tag)
- (image-dired-update-property
- 'tags (image-dired-list-tags (image-dired-original-file-name))))))
-
(defun image-dired-write-comments (file-comments)
"Write file comments specified by FILE-COMMENTS comments to database.
FILE-COMMENTS is an alist on the following form:
diff --git a/lisp/image/image-dired-util.el b/lisp/image/image-dired-util.el
index c3860cb0b0a..e9048e157cd 100644
--- a/lisp/image/image-dired-util.el
+++ b/lisp/image/image-dired-util.el
@@ -191,6 +191,8 @@ Should be used by commands in `image-dired-thumbnail-mode'."
"Return non-nil if there is an `image-dired' thumbnail at point."
(get-text-property (point) 'image-dired-thumbnail))
+(declare-function clear-image-cache "image.c" (&optional filter))
+
(defun image-dired-update-thumbnail-at-point ()
"Update the thumbnail at point if the original image file has been modified.
This function uncaches and removes the thumbnail file under the old name."
diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el
index 9eb68e240fe..ca808bcb5ab 100644
--- a/lisp/image/image-dired.el
+++ b/lisp/image/image-dired.el
@@ -1757,6 +1757,28 @@ Dired."
(cons (list tag file) (cdr image-dired-tag-file-list))))
(setq image-dired-tag-file-list (list (list tag file))))))
+(defun image-dired-tag-thumbnail-remove ()
+ "Remove tag from current or marked thumbnails."
+ (interactive nil image-dired-thumbnail-mode)
+ (let ((tag (completing-read "Tag to remove: " image-dired-tag-history
+ nil nil nil 'image-dired-tag-history)))
+ (image-dired--with-marked
+ (image-dired-remove-tag (image-dired-original-file-name) tag)
+ (image-dired-update-property
+ 'tags (image-dired-list-tags (image-dired-original-file-name))))))
+
+(defun image-dired-tag-thumbnail ()
+ "Tag current or marked thumbnails."
+ (interactive nil image-dired-thumbnail-mode)
+ (let ((tag (completing-read
+ "Tags to add (separate tags with a semicolon): "
+ image-dired-tag-history nil nil nil 'image-dired-tag-history)))
+ (image-dired--with-marked
+ (image-dired-write-tags
+ (list (cons (image-dired-original-file-name) tag)))
+ (image-dired-update-property
+ 'tags (image-dired-list-tags (image-dired-original-file-name))))))
+
(defvar image-dired-slideshow-count 0
"Keeping track on number of images in slideshow.")
(make-obsolete-variable 'image-dired-slideshow-count "no longer used." "29.1")
diff --git a/lisp/imenu.el b/lisp/imenu.el
index f628936cedc..ea097f5da3a 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -100,7 +100,7 @@ If `on-mouse' use a popup menu when `imenu' was invoked
with the mouse."
(other :tag "Always" t)))
(defcustom imenu-eager-completion-buffer t
- "If non-nil, eagerly popup the completion buffer."
+ "If non-nil, eagerly pop up the completion buffer."
:type 'boolean
:version "22.1")
@@ -115,7 +115,10 @@ Useful things to use here include `reposition-window',
`recenter', and
(defcustom imenu-sort-function nil
"The function to use for sorting the index mouse-menu.
-Affects only the mouse index menu.
+Affects only the mouse index menu. If you want to change
+the sorting order of completions, you can customize
+the option `completion-category-overrides' and set
+`display-sort-function' for the category `imenu'.
Set this to nil if you don't want any sorting (faster).
The items in the menu are then presented in the order they were found
@@ -142,10 +145,23 @@ names work as tokens."
(defcustom imenu-level-separator ":"
"The separator between index names of different levels.
-Used for making mouse-menu titles and for flattening nested indexes
-with name concatenation."
+Used for flattening nested indexes with name concatenation."
:type 'string)
+(defcustom imenu-flatten nil
+ "Whether to flatten the list of sections in an imenu or show it nested.
+If nil, use nested indexes.
+If t, pop up the completion buffer with a flattened menu.
+If `annotation', use completion annotation as a suffix
+to append section names after the index names.
+
+The string from `imenu-level-separator' is used to separate names of
+nested levels while flattening nested indexes with name concatenation."
+ :type '(choice (const :tag "Nested" nil)
+ (const :tag "By prefix" t)
+ (const :tag "By suffix" annotation))
+ :version "30.1")
+
(defcustom imenu-generic-skip-comments-and-strings t
"When non-nil, ignore text inside comments and strings.
Only affects `imenu-default-create-index-function' (and any
@@ -733,10 +749,17 @@ Return one of the entries in index-alist or nil."
(imenu--in-alist name prepared-index-alist)
;; Default to `name' if it's in the alist.
name))))
- (let ((minibuffer-setup-hook minibuffer-setup-hook))
- ;; Display the completion buffer.
- (if (not imenu-eager-completion-buffer)
- (add-hook 'minibuffer-setup-hook 'minibuffer-completion-help))
+ ;; Display the completion buffer.
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq-local completion-extra-properties
+ `( :category imenu
+ ,@(when (eq imenu-flatten 'annotation)
+ `(:annotation-function
+ ,(lambda (s) (get-text-property
+ 0 'imenu-section s))))))
+ (unless imenu-eager-completion-buffer
+ (minibuffer-completion-help)))
(setq name (completing-read prompt
prepared-index-alist
nil t nil 'imenu--history-list name)))
@@ -763,6 +786,30 @@ Returns t for rescan and otherwise an element or
subelement of INDEX-ALIST."
menu)))))
(popup-menu map event)))
+(defun imenu--flatten-index-alist (index-alist &optional concat-names prefix)
+ ;; Takes a nested INDEX-ALIST and returns a flat index alist.
+ ;; If optional CONCAT-NAMES is non-nil, then a nested index has its
+ ;; name and a space concatenated to the names of the children.
+ ;; Third argument PREFIX is for internal use only.
+ (mapcan
+ (lambda (item)
+ (let* ((name (car item))
+ (pos (cdr item))
+ (new-prefix (and concat-names
+ (if prefix
+ (concat prefix imenu-level-separator name)
+ name))))
+ (cond
+ ((not (imenu--subalist-p item))
+ (list (cons (if (and (eq imenu-flatten 'annotation) prefix)
+ (propertize name 'imenu-section
+ (format " (%s)" prefix))
+ new-prefix)
+ pos)))
+ (t
+ (imenu--flatten-index-alist pos concat-names new-prefix)))))
+ index-alist))
+
(defun imenu-choose-buffer-index (&optional prompt alist)
"Let the user select from a buffer index and return the chosen index.
@@ -792,6 +839,8 @@ The returned value is of the form (INDEX-NAME .
INDEX-POSITION)."
;; Create a list for this buffer only when needed.
(while (eq result t)
(setq index-alist (if alist alist (imenu--make-index-alist)))
+ (when imenu-flatten
+ (setq index-alist (imenu--flatten-index-alist index-alist t)))
(setq result
(if (and imenu-use-popup-menu
(or (eq imenu-use-popup-menu t) mouse-triggered))
@@ -836,8 +885,6 @@ A trivial interface to `imenu-add-to-menubar' suitable for
use in a hook."
(interactive)
(imenu-add-to-menubar "Index"))
-(defvar imenu-buffer-menubar nil)
-
(defvar-local imenu-menubar-modified-tick 0
"Value of (buffer-chars-modified-tick) when `imenu-update-menubar' was
called.")
diff --git a/lisp/info.el b/lisp/info.el
index b1b9d48855a..c2c393cb243 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -4794,7 +4794,15 @@ Interactively, if the binding is
`execute-extended-command', a command is read.
The command is found by looking up in Emacs manual's indices
or in another manual found via COMMAND's `info-file' property or
the variable `Info-file-list-for-emacs'."
- (interactive "kFind documentation for key: ")
+ (interactive
+ (let ((enable-disabled-menus-and-buttons t)
+ (cursor-in-echo-area t)
+ ;; Showing the list of key sequences makes no sense when they
+ ;; asked about a key sequence.
+ (echo-keystrokes-help nil)
+ (prompt (propertize "Find documentation for key: "
+ 'face 'minibuffer-prompt)))
+ (list (read-key-sequence prompt nil nil 'can-return-switch-frame))))
(let ((command (key-binding key)))
(cond ((null command)
(message "%s is undefined" (key-description key)))
diff --git a/lisp/international/textsec.el b/lisp/international/textsec.el
index 86429f15f7c..4740dd81345 100644
--- a/lisp/international/textsec.el
+++ b/lisp/international/textsec.el
@@ -44,15 +44,20 @@
(require 'uni-scripts))
(defun textsec-scripts (string)
- "Return a list of Unicode scripts used in STRING.
-The scripts returned by this function use the Unicode Script property
-as defined by the Unicode Standard Annex 24 (UAX#24)."
+ "Return a list of Unicode scripts used by characters in STRING.
+The return value is a list where for each character in STRING,
+there is a list of script symbols for that character. Thus, each
+script's symbol can appear more than once; use `textsec-covering-scripts'
+to obtain a list in which each script appears at most once.
+The script symbols returned by this function follow the Unicode Script
+property of characters as defined by the Unicode Standard Annex 24 (UAX#24).
+See the Unicode UCD file Scripts.txt for the scripts defined by Unicode."
(seq-map (lambda (char)
(elt textsec--char-scripts char))
string))
(defun textsec-single-script-p (string)
- "Return non-nil if STRING is all in a single Unicode script.
+ "Return non-nil if STRING's characters belong to a single Unicode script.
Note that the concept of \"single script\" used by this function
isn't obvious -- some mixtures of scripts count as a \"single
@@ -60,8 +65,8 @@ script\". See
https://www.unicode.org/reports/tr39/#Mixed_Script_Detection
-for details. The Unicode scripts are as defined by the
-Unicode Standard Annex 24 (UAX#24)."
+for details. The Unicode script property of a characters is defined by
+the Unicode Standard Annex 24 (UAX#24)."
(let ((scripts (mapcar
(lambda (s)
(append s
@@ -98,9 +103,11 @@ Unicode Standard Annex 24 (UAX#24)."
'(korea))))
(defun textsec-covering-scripts (string)
- "Return a minimal list of scripts used in STRING.
+ "Return a minimal list of scripts used by characters in STRING.
Note that a string may have several different minimal cover sets.
-The scripts are as defined by the Unicode Standard Annex 24 (UAX#24)."
+The return value is a list of script symbols.
+The script property of characters is defined by the Unicode Standard
+Annex 24 (UAX#24)."
(let* ((scripts (textsec-scripts string))
(set (car scripts)))
(dolist (s scripts)
@@ -108,7 +115,8 @@ The scripts are as defined by the Unicode Standard Annex 24
(UAX#24)."
(sort (delq 'common (delq 'inherited set)) #'string<)))
(defun textsec-restriction-level (string)
- "Say what restriction level STRING qualifies for.
+ "Return the restriction level for which STRING qualifies.
+The return value is a symbol.
Levels are (in decreasing order of restrictiveness) `ascii-only',
`single-script', `highly-restrictive', `moderately-restrictive',
`minimally-restrictive' and `unrestricted'."
@@ -163,7 +171,14 @@ Levels are (in decreasing order of restrictiveness)
`ascii-only',
'unrestricted))))
(defun textsec-mixed-numbers-p (string)
- "Return non-nil if STRING includes numbers from different decimal systems."
+ "Return non-nil if STRING includes numbers from different decimal systems.
+
+This function examines only characters in STRING whose Unicode general
+category, as reported by `get-char-code-property' with its second
+argument \\='general-category, is Decimal_Numbers (Nd). It returns
+non-nil if it finds numerical characters from different numerical
+systems. For example, ASCII digit characters and ARABIC-INDIC DIGIT
+characters belong to different decimal systems."
(>
(length
(seq-uniq
@@ -199,15 +214,20 @@ This algorithm is described in:
(defun textsec-resolved-script-set (string)
"Return the resolved script set for STRING.
-This is the minimal covering script set for STRING, but is nil is
-STRING isn't a single script string.
-The scripts are as defined by the Unicode Standard Annex 24 (UAX#24)."
+The value is a list whose members are symbols of the minimal covering
+script set for STRING; the value is nil if STRING isn't a single-script
+string.
+The script property of characters is defined by the Unicode Standard
+Annex 24 (UAX#24)."
(and (textsec-single-script-p string)
(textsec-covering-scripts string)))
(defun textsec-single-script-confusable-p (string1 string2)
"Say whether STRING1 and STRING2 are single-script confusables.
-The scripts are as defined by the Unicode Standard Annex 24 (UAX#24)."
+Two strings are said to be confusables if they might look very
+similarly on display.
+The script property of characters is defined by the Unicode Standard
+Annex 24 (UAX#24)."
(and (equal (textsec-unconfuse-string string1)
(textsec-unconfuse-string string2))
;; And they have to have at least one resolved script in
@@ -217,7 +237,10 @@ The scripts are as defined by the Unicode Standard Annex
24 (UAX#24)."
(defun textsec-mixed-script-confusable-p (string1 string2)
"Say whether STRING1 and STRING2 are mixed-script confusables.
-The scripts are as defined by the Unicode Standard Annex 24 (UAX#24)."
+Two strings are said to be confusables if they might look very
+similarly on display.
+The script property of characters is defined by the Unicode Standard
+Annex 24 (UAX#24)."
(and (equal (textsec-unconfuse-string string1)
(textsec-unconfuse-string string2))
;; And they have no resolved scripts in common.
@@ -225,8 +248,11 @@ The scripts are as defined by the Unicode Standard Annex
24 (UAX#24)."
(textsec-resolved-script-set string2)))))
(defun textsec-whole-script-confusable-p (string1 string2)
- "Say whether STRING1 and STRING2 are whole-script confusables.
-The scripts are as defined by the Unicode Standard Annex 24 (UAX#24)."
+ "Say whether two single-script strings STRING1 and STRING2 are confusables.
+Two strings are said to be confusables if they might look very
+similarly on display.
+The script property of characters is defined by the Unicode Standard
+Annex 24 (UAX#24)."
(and (textsec-mixed-script-confusable-p string1 string2)
(textsec-single-script-p string1)
(textsec-single-script-p string2)))
@@ -287,7 +313,7 @@ or use certain other unusual mixtures of characters."
(defun textsec-local-address-suspicious-p (local)
"Say whether LOCAL part of an email address looks suspicious.
-LOCAL is the bit before \"@\" in an email address.
+LOCAL is the part before \"@\" in an email address, a string.
If it isn't suspicious, return nil. If it is, return a string explaining
the potential problem.
@@ -307,7 +333,7 @@ certain other unusual mixtures of characters."
(format "`%s' contains invalid dots" local))))
(defun textsec-bidi-controls-suspicious-p (string)
- "Return non-nil of STRING uses bidi controls in suspicious ways.
+ "Return non-nil of STRING uses bidirectional controls in suspicious ways.
If STRING doesn't include any suspicious uses of bidirectional
formatting control characters, return nil. Otherwise, return the
index of the first character in STRING affected by such suspicious
@@ -315,8 +341,8 @@ use of bidi controls. If the returned value is beyond the
length
of STRING, it means any text following STRING on display might be
affected by bidi controls in STRING."
(with-temp-buffer
- ;; We add a string that's representative of some text that could
- ;; follow STRING, with the purpose of detecting residual bidi
+ ;; We follow STRING with text that's representative of some text
+ ;; that could follow it, with the purpose of detecting residual bidi
;; state at end of STRING which could then affect the following
;; text.
(insert string "a1א:!")
@@ -327,8 +353,8 @@ affected by bidi controls in STRING."
(defun textsec-name-suspicious-p (name)
"Say whether NAME looks suspicious.
-NAME is (for instance) the free-text display name part of an
-email address.
+NAME is a string, for instance, the free-text display name part
+of an email address.
If it isn't suspicious, return nil. If it is, return a string
explaining the potential problem.
@@ -360,6 +386,10 @@ other unusual mixtures of characters."
If it doesn't, return nil. If it does, return a string explaining
the potential problem.
+Nonspacing characters are those whose general Unicode category is
+Mn (nonspacing mark) or Me (enclosing mark). Examples include
+diacritics and accents.
+
Use of nonspacing characters is considered suspicious if there are
two or more consecutive identical nonspacing characters, or too many
consecutive nonspacing characters."
@@ -385,21 +415,22 @@ consecutive nonspacing characters."
nil)))
(defun textsec-email-address-suspicious-p (address)
- "Say whether EMAIL address looks suspicious.
+ "Say whether email ADDRESS looks suspicious.
If it isn't, return nil. If it is, return a string explaining the
potential problem.
+ADDRESS should be a string that specifies an email address.
An email address is considered suspicious if either of its two
parts -- the local address name or the domain -- are found to be
suspicious by, respectively, `textsec-local-address-suspicious-p'
and `textsec-domain-suspicious-p'."
(pcase-let ((`(,local ,domain) (split-string address "@")))
(or
- (textsec-domain-suspicious-p domain)
+ (if domain (textsec-domain-suspicious-p domain))
(textsec-local-address-suspicious-p local))))
(defun textsec-email-address-header-suspicious-p (email)
- "Say whether EMAIL looks suspicious.
+ "Say whether EMAIL address specification looks suspicious.
If it isn't, return nil. If it is, return a string explaining the
potential problem.
@@ -417,7 +448,7 @@ and `textsec-name-suspicious-p'."
(mail-header-parse-address email t)
(error (throw 'end "Email address can't be parsed.")))))
(or
- (textsec-email-address-suspicious-p address)
+ (and address (textsec-email-address-suspicious-p address))
(and name (textsec-name-suspicious-p name))))))
(defun textsec-url-suspicious-p (url)
diff --git a/lisp/isearch.el b/lisp/isearch.el
index a139a6fb84e..e8fb33ef6ea 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -2800,8 +2800,8 @@ With argument, add COUNT copies of the character."
(let ((string (if (and (integerp count) (> count 1))
(make-string count char)
(char-to-string char))))
- (setq isearch-new-string (concat isearch-string string)
- isearch-new-message (concat isearch-message
+ (setq isearch-new-string (concat isearch-new-string string)
+ isearch-new-message (concat isearch-new-message
(mapconcat
'isearch-text-char-description
string ""))))))))
@@ -2822,8 +2822,8 @@ The command accepts Unicode names like \"smiling face\" or
(when (and (integerp count) (> count 1))
(setq emoji (apply 'concat (make-list count emoji))))
(when emoji
- (setq isearch-new-string (concat isearch-string emoji)
- isearch-new-message (concat isearch-message
+ (setq isearch-new-string (concat isearch-new-string emoji)
+ isearch-new-message (concat isearch-new-message
(mapconcat
'isearch-text-char-description
emoji "")))))))
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 5037d8c5b2b..9e9a5f97fd4 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -591,15 +591,18 @@ connection object, called when the process dies.")
(cl-defmethod jsonrpc-shutdown ((conn jsonrpc-process-connection)
&optional cleanup)
"Wait for JSONRPC connection CONN to shutdown.
-With optional CLEANUP, kill any associated buffers."
+With optional CLEANUP, kill any associated buffers.
+If CONN is not shutdown within a reasonable amount of time, warn
+and delete the network process."
(unwind-protect
(cl-loop
with proc = (jsonrpc--process conn) for i from 0
while (not (process-get proc 'jsonrpc-sentinel-cleanup-started))
unless (zerop i) do
(jsonrpc--warn "Sentinel for %s still hasn't run, deleting it!" proc)
- do
(delete-process proc)
+ do
+ ;; Let sentinel have a chance to run
(accept-process-output nil 0.1))
(when cleanup
(kill-buffer (process-buffer (jsonrpc--process conn)))
diff --git a/lisp/keymap.el b/lisp/keymap.el
index b2b475c7d71..737c11dbd83 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -379,20 +379,35 @@ which is
(defun key-translate (from to)
"Translate character FROM to TO on the current terminal.
+
This function creates a `keyboard-translate-table' if necessary
and then modifies one entry in it.
-Both FROM and TO should be specified by strings that satisfy `key-valid-p'."
+Both FROM and TO should be specified by strings that satisfy `key-valid-p'.
+If TO is nil, remove any existing translation for FROM."
(declare (compiler-macro
(lambda (form) (keymap--compile-check from to) form)))
(keymap--check from)
- (keymap--check to)
- (or (char-table-p keyboard-translate-table)
- (setq keyboard-translate-table
- (make-char-table 'keyboard-translate-table nil)))
- (aset keyboard-translate-table
- (aref (key-parse from) 0)
- (aref (key-parse to) 0)))
+ (when to
+ (keymap--check to))
+ (let ((from-key (key-parse from))
+ (to-key (and to (key-parse to))))
+ (cond
+ ((= (length from-key) 0)
+ (error "FROM key is empty"))
+ ((> (length from-key) 1)
+ (error "FROM key %s is not a single key" from)))
+ (cond
+ ((and to (= (length to-key) 0))
+ (error "TO key is empty"))
+ ((and to (> (length to-key) 1))
+ (error "TO key %s is not a single key" to)))
+ (or (char-table-p keyboard-translate-table)
+ (setq keyboard-translate-table
+ (make-char-table 'keyboard-translate-table nil)))
+ (aset keyboard-translate-table
+ (aref from-key 0)
+ (and to (aref to-key 0)))))
(defun keymap-lookup (keymap key &optional accept-default no-remap position)
"Return the binding for command KEY in KEYMAP.
@@ -603,10 +618,11 @@ non-nil, all commands in the map will have the
`repeat-map'
symbol property.
More control is available over which commands are repeatable; the
-value can also be a property list with properties `:enter' and
-`:exit', for example:
+value can also be a property list with properties `:enter',
+`:exit' and `:hints', for example:
- :repeat (:enter (commands ...) :exit (commands ...))
+ :repeat (:enter (commands ...) :exit (commands ...)
+ :hints ((command . \"hint\") ...))
`:enter' specifies the list of additional commands that only
enter `repeat-mode'. When the list is empty, then only the
@@ -621,6 +637,10 @@ Specifying a list of commands is useful when those
commands exist
in this specific map, but should not have the `repeat-map' symbol
property.
+`:hints' is a list of cons pairs where car is a command and
+cdr is a string that is displayed alongside of the repeatable key
+in the echo area.
+
\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP REPEAT
&rest [KEY DEFINITION]...)"
(declare (indent 1))
(let ((opts nil)
@@ -660,7 +680,9 @@ property.
(setq def (pop defs))
(when (and (memq (car def) '(function quote))
(not (memq (cadr def) (plist-get repeat :exit))))
- (push `(put ,def 'repeat-map ',variable-name) props)))))
+ (push `(put ,def 'repeat-map ',variable-name) props)))
+ (dolist (def (plist-get repeat :hints))
+ (push `(put ',(car def) 'repeat-hint ',(cdr def)) props))))
(let ((defvar-form
`(defvar ,variable-name
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index a16f70105c1..07a13d5632c 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -342,7 +342,7 @@ information."
(setq kmacro-last-counter kmacro-counter
kmacro-counter (if (and current-prefix-arg (listp current-prefix-arg))
last
- kmacro-counter (+ kmacro-counter arg))))
+ (+ kmacro-counter arg))))
(unless executing-kbd-macro
(kmacro-display-counter)))
diff --git a/lisp/loadup.el b/lisp/loadup.el
index c6a8dcbb909..aab1231c8be 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -191,6 +191,23 @@
(setq definition-prefixes new))
(load "button") ;After loaddefs, because of define-minor-mode!
+
+(when (interpreted-function-p (symbol-function 'add-hook))
+ ;; `subr.el' is needed early and hence can't use macros like `setf'
+ ;; liberally. Yet, it does use such macros in code that it knows will not
+ ;; be executed too early, such as `add-hook'. Usually, by the time we
+ ;; run that code, either `subr.el' was already compiled to start with
+ ;; or on the contrary many files aren't compiled yet and have thus caused
+ ;; macro packages like `gv' to be loaded. But not always.
+ ;; The specific error we're trying to work around, here, occurs when
+ ;; `cl-preloaded's `provide' ends up (because of an `eval-after-load')
+ ;; calling `add-hook' which burps with a "void-function setf" on
+ ;; (setf (get hook 'hook--depth-alist) depth-sym)'.
+ ;; FIXME: We should probably split `subr.el' into one that's loaded early
+ ;; where we refrain from using macros like `setf', and another loaded later
+ ;; where we can blissfully `require' packages like `gv'.
+ (require 'gv))
+
(load "emacs-lisp/cl-preloaded")
(load "emacs-lisp/oclosure") ;Used by cl-generic
(load "obarray") ;abbrev.el is implemented in terms of obarrays.
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 48c5cb70b33..d2dcedce93e 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -437,7 +437,9 @@ headers of the messages."
(= (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)))
+ (let ((enc-msgs
+ (with-current-buffer rmail-buffer
+ (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)
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index ed21e777b28..98083c0489a 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -638,7 +638,7 @@ USER and PASSWORD should be non-nil."
235))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql xoauth2)) user password)
+ (process (_mech (eql 'xoauth2)) user password)
(smtpmail-command-or-throw
process
(concat "AUTH XOAUTH2 "
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 320fabb54cf..eba25f5cfce 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -2233,26 +2233,29 @@ updating the menu."
(not (window-minibuffer-p
(frame-selected-window menu-frame))))))
-(defun kill-this-buffer () ; for the menu bar
+(defun kill-this-buffer (&optional event) ; for the menu bar
"Kill the current buffer.
When called in the minibuffer, get out of the minibuffer
using `abort-recursive-edit'.
This command can be reliably invoked only from the menu bar,
otherwise it could decide to silently do nothing."
- (interactive)
- (cond
- ;; Don't do anything when `menu-frame' is not alive or visible
- ;; (Bug#8184).
- ((not (menu-bar-menu-frame-live-and-visible-p)))
- ((menu-bar-non-minibuffer-window-p)
- (kill-buffer (current-buffer))
- ;; Also close the current window if `menu-bar-close-window' is
- ;; set.
- (when menu-bar-close-window
- (ignore-errors (delete-window))))
- (t
- (abort-recursive-edit))))
+ (interactive "e")
+ ;; This colossus of a conditional is necessary to account for the wide
+ ;; variety of this command's callers.
+ (if (let* ((window (or (and event (event-start event)
+ (posn-window (event-start event)))
+ last-event-frame
+ (selected-frame)))
+ (frame (if (framep window) window
+ (window-frame window))))
+ (not (window-minibuffer-p (frame-selected-window frame))))
+ (progn (kill-buffer (current-buffer))
+ ;; Also close the current window if `menu-bar-close-window' is
+ ;; set.
+ (when menu-bar-close-window
+ (ignore-errors (delete-window))))
+ (abort-recursive-edit)))
(defun kill-this-buffer-enabled-p ()
"Return non-nil if the `kill-this-buffer' menu item should be enabled.
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index ad6a0928cda..f62cb2566b2 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -112,20 +112,6 @@ the closest directory separators."
(cons (or (cadr boundaries) 0)
(or (cddr boundaries) (length suffix)))))
-(defun completion-base-suffix (start end collection predicate)
- "Return suffix of completion of buffer text between START and END.
-COLLECTION and PREDICATE are, respectively, the completion's
-completion table and predicate, as in `completion-boundaries' (which see).
-Value is a substring of buffer text between point and END. It is
-the completion suffix that follows the completion boundary."
- (let ((suffix (buffer-substring (point) end)))
- (substring
- suffix
- (cdr (completion-boundaries (buffer-substring start (point))
- collection
- predicate
- suffix)))))
-
(defun completion-metadata (string table pred)
"Return the metadata of elements to complete at the end of STRING.
This metadata is an alist. Currently understood keys are:
@@ -2598,17 +2584,24 @@ The candidate will still be chosen by
`choose-completion' unless
(base-size (or (cdr last) 0))
(prefix (unless (zerop base-size) (substring string 0 base-size)))
(minibuffer-completion-base (substring string 0 base-size))
- (base-prefix (buffer-substring (minibuffer--completion-prompt-end)
- (+ start base-size)))
- (base-suffix (concat (completion-base-suffix start end
-
minibuffer-completion-table
-
minibuffer-completion-predicate)
- (buffer-substring end (point-max))))
+ (ctable minibuffer-completion-table)
+ (cpred minibuffer-completion-predicate)
+ (cprops completion-extra-properties)
+ (field-end
+ (save-excursion
+ (forward-char
+ (cdr (completion-boundaries (buffer-substring start (point))
+ ctable
+ cpred
+ (buffer-substring (point) end))))
+ (point)))
+ (field-char (and (< field-end end) (char-after field-end)))
+ (base-position (list (+ start base-size) field-end))
(all-md (completion--metadata (buffer-substring-no-properties
start (point))
base-size md
- minibuffer-completion-table
- minibuffer-completion-predicate))
+ ctable
+ cpred))
(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))
@@ -2686,39 +2679,35 @@ The candidate will still be chosen by
`choose-completion' unless
completions))))
(with-current-buffer standard-output
- (setq-local completion-base-position
- (list (+ start base-size)
- ;; FIXME: We should pay attention to
completion
- ;; boundaries here, but currently
- ;; completion-all-completions does not give
us the
- ;; necessary information.
- end))
- (setq-local completion-base-affixes
- (list base-prefix base-suffix))
+ (setq-local completion-base-position base-position)
(setq-local completion-list-insert-choice-function
- (let ((ctable minibuffer-completion-table)
- (cpred minibuffer-completion-predicate)
- (cprops completion-extra-properties))
(lambda (start end choice)
- (if (and (stringp start) (stringp end))
- (progn
- (delete-minibuffer-contents)
- (insert start choice)
- ;; Keep point after completion before
suffix
- (save-excursion (insert
-
(completion--merge-suffix
- choice
- (1- (length choice))
- end))))
- (unless (or (zerop (length prefix))
- (equal prefix
-
(buffer-substring-no-properties
- (max (point-min)
- (- start (length
prefix)))
- start)))
- (message "*Completions* out of date"))
- ;; FIXME: Use `md' to do quoting&terminator
here.
- (completion--replace start end choice))
+ (unless (or (zerop (length prefix))
+ (equal prefix
+
(buffer-substring-no-properties
+ (max (point-min)
+ (- start (length
prefix)))
+ start)))
+ (message "*Completions* out of date"))
+ (when (> (point) end)
+ ;; Completion suffix has changed, have to
adapt.
+ (setq end (+ end
+ (cdr (completion-boundaries
+ (concat prefix choice)
ctable cpred
+ (buffer-substring end
(point))))))
+ ;; Stopped before some field boundary.
+ (when (> (point) end)
+ (setq field-char (char-after end))))
+ (when (and field-char
+ (= (aref choice (1- (length
choice)))
+ field-char))
+ (setq end (1+ end)))
+ ;; Tried to use a marker to track buffer
changes
+ ;; but that clashed with another existing
marker.
+ (cl-decf (nth 1 base-position)
+ (- end start (length choice)))
+ ;; FIXME: Use `md' to do quoting&terminator
here.
+ (completion--replace start (min end
(point-max)) choice)
(let* ((minibuffer-completion-table ctable)
(minibuffer-completion-predicate cpred)
(completion-extra-properties cprops)
@@ -2729,7 +2718,7 @@ The candidate will still be chosen by `choose-completion'
unless
;; completion is not finished.
(completion--done result
(if (eq (car bounds)
(length result))
- 'exact
'finished)))))))
+ 'exact 'finished))))))
(display-completion-list completions nil group-fun)))))
nil)))
@@ -4877,8 +4866,7 @@ insert the selected completion candidate to the
minibuffer."
(next-line-completion (or n 1))
(next-completion (or n 1)))
(when auto-choose
- (let ((completion-use-base-affixes t)
- (completion-auto-deselect nil))
+ (let ((completion-auto-deselect nil))
(choose-completion nil t t))))))
(defun minibuffer-previous-completion (&optional n)
@@ -4916,8 +4904,7 @@ If NO-QUIT is non-nil, insert the completion candidate at
point to the
minibuffer, but don't quit the completions window."
(interactive "P")
(with-minibuffer-completions-window
- (let ((completion-use-base-affixes t))
- (choose-completion nil no-exit no-quit))))
+ (choose-completion nil no-exit no-quit)))
(defun minibuffer-choose-completion-or-exit (&optional no-exit no-quit)
"Choose the completion from the minibuffer or exit the minibuffer.
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index d4dfa33716c..9fb8b8ffaed 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -105,14 +105,25 @@ This port is probably always 2628 so there should be no
need to modify it."
"*"
"The dictionary which is used for searching definitions and matching.
* and ! have a special meaning, * search all dictionaries, ! search until
-one dictionary yields matches."
+one dictionary yields matches.
+Otherwise, the value should be a string, the name of the dictionary to use.
+Dictionary names are generally specific to the servers, and are obtained
+via `dictionary-dictionaries'."
:group 'dictionary
:type 'string
:version "28.1")
(defcustom dictionary-default-strategy
"."
- "The default strategy for listing matching words."
+ "The default strategy for listing matching words.
+The value should be a string. The special value \".\" means
+the default search strategy for `dictionary-server' in use.
+Other values are specific to servers and dictionaries.
+In a `dictionary-mode' buffer, you can use
+\\[dictionary-select-strategy] to change the buffer-local value;
+it will show the available strategies from which you can choose.
+To change the value for other buffers, customize this option
+using \\[customize-option]."
:group 'dictionary
:type 'string
:version "28.1")
@@ -784,10 +795,10 @@ FUNCTION is the callback which is called for each search
result."
(defun dictionary-do-search (word dictionary function &optional nomatching)
"Search for WORD in DICTIONARY and call FUNCTION for each result.
-Optional argument NOMATCHING controls whether to suppress the display
-of matching words."
-
- (insert (format-message "Searching for `%s' in `%s'\n" word dictionary))
+Optional argument NOMATCHING, if non-nil, means suppress the display
+of the \"Searching\" report and of the matching words."
+ (unless nomatching
+ (insert (format-message "Searching for `%s' in `%s'\n" word dictionary)))
(dictionary-send-command (concat "define "
(dictionary-encode-charset dictionary "")
" \""
@@ -1356,11 +1367,22 @@ prompt for DICTIONARY."
(nconc minor-mode-alist '((dictionary-tooltip-mode " Dict")))
(defcustom dictionary-tooltip-dictionary
- nil
- "This dictionary to lookup words for tooltips."
+ t
+ "The dictionary to lookup words for `dictionary-tooltip-mode'.
+If this is nil, `dictionary-tooltip-mode' is effectively disabled: no tooltips
+will be shown.
+If the value is t, `dictionary-tooltip-mode' will use the same dictionary as
+specified by `dictionary-default-dictionary'.
+Otherwise, the value should be a string, the name of a dictionary to use, and
+can use the same special values * and ! as for `dictionary-default-dictionary',
+with the same meanings.
+Dictionary names are generally specific to the servers, and are obtained
+via `dictionary-dictionaries'."
:group 'dictionary
- :type '(choice (const :tag "None" nil) string)
- :version "28.1")
+ :type '(choice (const :tag "None (disables Dictionary tooltips)" nil)
+ (const :tag "Same as `dictionary-default-dictionary'" t)
+ string)
+ :version "30.1")
(defun dictionary-definition (word &optional dictionary)
(unwind-protect
@@ -1377,14 +1399,20 @@ prompt for DICTIONARY."
nil)
(defun dictionary-word-at-mouse-event (event)
- (with-current-buffer (tooltip-event-buffer event)
- (let ((point (posn-point (event-end event))))
- (if (use-region-p)
- (when (and (<= (region-beginning) point) (<= point (region-end)))
- (buffer-substring (region-beginning) (region-end)))
- (save-excursion
- (goto-char point)
- (current-word))))))
+ (let ((buf (tooltip-event-buffer event)))
+ (when (bufferp buf)
+ (with-current-buffer buf
+ (let ((point (posn-point (event-end event))))
+ ;; posn-point can return something other than buffer position when
+ ;; the mouse pointer is over the menu bar or tool bar or tab-bar.
+ (when (number-or-marker-p point)
+ (if (use-region-p)
+ (when (and (<= (region-beginning) point)
+ (<= point (region-end)))
+ (buffer-substring (region-beginning) (region-end)))
+ (save-excursion
+ (goto-char point)
+ (current-word)))))))))
(defvar dictionary-tooltip-mouse-event nil
"Event that triggered the tooltip mode.")
@@ -1393,15 +1421,24 @@ prompt for DICTIONARY."
"Search the current word in the `dictionary-tooltip-dictionary'."
(interactive "e")
(if (and dictionary-tooltip-mode dictionary-tooltip-dictionary)
- (let ((word (dictionary-word-at-mouse-event
dictionary-tooltip-mouse-event)))
- (if word
- (let ((definition
- (dictionary-definition word
dictionary-tooltip-dictionary)))
- (if definition
- (tooltip-show (dictionary-decode-charset definition
-
dictionary-tooltip-dictionary)))))
- t)
- nil))
+ ;; This function runs from the tooltip timer. We don't want to
+ ;; signal errors from the timer due to "Unknown server answers",
+ ;; we prefer not to show anything in that case. FIXME: Perhaps
+ ;; use with-demoted-errors, to show the unknonw answers in the
+ ;; echo-area?
+ (ignore-errors
+ (let* ((word (dictionary-word-at-mouse-event
+ dictionary-tooltip-mouse-event))
+ (dict (if (eq dictionary-tooltip-dictionary t)
+ dictionary-default-dictionary
+ dictionary-tooltip-dictionary)))
+ (if word
+ (let ((definition (dictionary-definition word dict)))
+ (if definition
+ (tooltip-show (dictionary-decode-charset
+ definition dict)))))
+ t)
+ nil)))
(defun dictionary-tooltip-track-mouse (event)
"Called whenever a dictionary tooltip display is about to be triggered."
@@ -1443,6 +1480,11 @@ active it will overwrite that mode for the current
buffer."
(if on
(local-set-key [mouse-movement] 'dictionary-tooltip-track-mouse)
(local-set-key [mouse-movement] 'ignore))
+ ;; Unconditionally ignore mouse-movement events on the tool bar and
+ ;; tab-bar, since these are unrelated to the current buffer.
+ ;; FIXME: This disables help-echo for tab-bar and tool-bar buttons.
+ (local-set-key [tool-bar mouse-movement] 'ignore)
+ (local-set-key [tab-bar mouse-movement] 'ignore)
on))
;;;###autoload
@@ -1536,11 +1578,18 @@ Further arguments are currently ignored."
nil t nil 'dictionary-word-history default t)))
(defun dictionary-dictionaries ()
- "Return the list of dictionaries the server supports."
+ "Return the list of dictionaries the server supports.
+The elements of the list have the form (NAME . DESCRIPTION),
+where NAME is the string that identifies the dictionary for
+the server, and DESCRIPTION is its more detailed description,
+which usually includes the languages it supports."
(dictionary-send-command "show db")
(when (and (= (read (dictionary-read-reply)) 110))
(with-temp-buffer
(insert (dictionary-read-answer))
+ ;; We query the server using 'raw-text', so decode now to present
+ ;; human-readable names to the user.
+ (decode-coding-region (point-min) (point-max) 'utf-8)
(goto-char (point-min))
(let ((result '(("!" . "First matching dictionary")
("*" . "All dictionaries"))))
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 39ea964d47a..32e24f9e2e5 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1300,6 +1300,24 @@ This consults the entries in `eww-readable-urls' (which
see)."
map)
"Tool bar for `eww-mode'.")
+(declare-function set-text-conversion-style "textconv.c")
+
+(defun eww-check-text-conversion ()
+ "Check if point is within a field and toggle text conversion.
+Set `text-conversion-style' to the value `action' if it isn't
+already and point is within the prompt field, or if
+`text-conversion-style' is `nil', so as to guarantee that
+the input method functions properly for the purpose of typing
+within text input fields."
+ (when (and (eq major-mode 'eww-mode)
+ (fboundp 'set-text-conversion-style))
+ (if (eq (car-safe (get-text-property (point) 'field))
+ :eww-form)
+ (unless (eq text-conversion-style 'action)
+ (set-text-conversion-style 'action))
+ (unless (not text-conversion-style)
+ (set-text-conversion-style nil)))))
+
;; Autoload cookie needed by desktop.el.
;;;###autoload
(define-derived-mode eww-mode special-mode "eww"
@@ -1318,9 +1336,16 @@ This consults the entries in `eww-readable-urls' (which
see)."
;; desktop support
(setq-local desktop-save-buffer #'eww-desktop-misc-data)
(setq truncate-lines t)
+ ;; thingatpt support
(setq-local thing-at-point-provider-alist
- (append thing-at-point-provider-alist
- '((url . eww--url-at-point))))
+ (cons '(url . eww--url-at-point)
+ thing-at-point-provider-alist))
+ (setq-local forward-thing-provider-alist
+ (cons '(url . eww--forward-url)
+ forward-thing-provider-alist))
+ (setq-local bounds-of-thing-at-point-provider-alist
+ (cons '(url . eww--bounds-of-url-at-point)
+ bounds-of-thing-at-point-provider-alist))
(setq-local bookmark-make-record-function #'eww-bookmark-make-record)
(buffer-disable-undo)
(setq-local shr-url-transformer #'eww--transform-url)
@@ -1328,8 +1353,14 @@ This consults the entries in `eww-readable-urls' (which
see)."
(add-hook 'text-scale-mode-hook #'eww--rescale-images nil t)
(setq-local outline-search-function 'shr-outline-search
outline-level 'shr-outline-level)
- (setq buffer-read-only t))
-
+ (add-hook 'post-command-hook #'eww-check-text-conversion nil t)
+ (setq buffer-read-only t)
+ ;; Insertion at the first character of a field should inherit the
+ ;; field's face, form and field, not the previous character's.
+ (setq text-property-default-nonsticky '((face . t) (eww-form . t)
+ (field . t))))
+
+(declare-function imagep "image.c")
(defvar text-scale-mode)
(defvar text-scale-mode-amount)
(defun eww--rescale-images ()
@@ -1349,7 +1380,15 @@ This consults the entries in `eww-readable-urls' (which
see)."
(defun eww--url-at-point ()
"`thing-at-point' provider function."
- (get-text-property (point) 'shr-url))
+ (thing-at-point-for-char-property 'shr-url))
+
+(defun eww--forward-url (backward)
+ "`forward-thing' provider function."
+ (forward-thing-for-char-property 'shr-url backward))
+
+(defun eww--bounds-of-url-at-point ()
+ "`bounds-of-thing-at-point' provider function."
+ (bounds-of-thing-at-point-for-char-property 'shr-url))
;;;###autoload
(defun eww-browse-url (url &optional new-window)
@@ -1487,16 +1526,19 @@ just re-display the HTML already fetched."
(defvar-keymap eww-submit-map
"RET" #'eww-submit
- "C-c C-c" #'eww-submit)
+ "C-c C-c" #'eww-submit
+ "<mouse-2>" #'eww-submit)
(defvar-keymap eww-submit-file
"RET" #'eww-select-file
- "C-c C-c" #'eww-submit)
+ "C-c C-c" #'eww-submit
+ "<mouse-2>" #'eww-select-file)
(defvar-keymap eww-checkbox-map
"SPC" #'eww-toggle-checkbox
"RET" #'eww-toggle-checkbox
- "C-c C-c" #'eww-submit)
+ "C-c C-c" #'eww-submit
+ "<mouse-2>" #'eww-toggle-checkbox)
(defvar-keymap eww-text-map
:full t :parent text-mode-map
@@ -1585,6 +1627,8 @@ just re-display the HTML already fetched."
:type "submit"
:name (dom-attr dom 'name)))
(put-text-property start (point) 'keymap eww-submit-map)
+ ;; Pretend to touch-screen.el that this is a button.
+ (put-text-property start (point) 'button t)
(insert " ")))
(defun eww-form-checkbox (dom)
@@ -1600,6 +1644,8 @@ just re-display the HTML already fetched."
:checked (dom-attr dom 'checked)
:name (dom-attr dom 'name)))
(put-text-property start (point) 'keymap eww-checkbox-map)
+ ;; Pretend to touch-screen.el that this is a button.
+ (put-text-property start (point) 'button t)
(insert " ")))
(defun eww-form-file (dom)
@@ -1618,11 +1664,17 @@ just re-display the HTML already fetched."
:type (downcase (dom-attr dom 'type))
:name (dom-attr dom 'name)))
(put-text-property start (point) 'keymap eww-submit-file)
+ ;; Pretend to touch-screen.el that this is a button.
+ (put-text-property start (point) 'button t)
(insert " ")))
-(defun eww-select-file ()
- "Change the value of the upload file menu under point."
- (interactive nil eww-mode)
+(defun eww-select-file (&optional event)
+ "Change the value of the upload file menu under point.
+EVENT, if non-nil, is the mouse event that preceded this command.
+Interactively, EVENT is the value of `last-nonmenu-event'."
+ (interactive (list last-nonmenu-event) eww-mode)
+ (when (and event (setq event (event-start event)))
+ (goto-char (posn-point event)))
(let* ((input (get-text-property (point) 'eww-form)))
(let ((filename
(let ((insert-default-directory t))
@@ -1638,7 +1690,12 @@ just re-display the HTML already fetched."
(readonly-property (if (or (dom-attr dom 'disabled)
(dom-attr dom 'readonly))
'read-only
- 'inhibit-read-only)))
+ 'inhibit-read-only))
+ form)
+ (setq form (list :eww-form eww-form
+ :value value
+ :type type
+ :name (dom-attr dom 'name)))
(insert value)
(when (< (length value) width)
(insert (make-string (- width (length value)) ? )))
@@ -1646,11 +1703,9 @@ just re-display the HTML already fetched."
(put-text-property start (point) 'inhibit-read-only t)
(put-text-property start (point) 'local-map eww-text-map)
(put-text-property start (point) readonly-property t)
- (put-text-property start (point) 'eww-form
- (list :eww-form eww-form
- :value value
- :type type
- :name (dom-attr dom 'name)))
+ (put-text-property start (point) 'eww-form form)
+ (put-text-property start (point) 'field form)
+ (put-text-property start (point) 'front-sticky t)
(insert " ")))
(defconst eww-text-input-types '("text" "password" "textarea"
@@ -1661,13 +1716,7 @@ just re-display the HTML already fetched."
See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-process-text-input (beg end replace-length)
- (when-let* ((pos (and (< (1+ end) (point-max))
- (> (1- end) (point-min))
- (cond
- ((get-text-property (1+ end) 'eww-form)
- (1+ end))
- ((get-text-property (1- end) 'eww-form)
- (1- end))))))
+ (when-let* ((pos (field-beginning (point))))
(let* ((form (get-text-property pos 'eww-form))
(properties (text-properties-at pos))
(buffer-undo-list t)
@@ -1685,7 +1734,7 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(1- (line-end-position))
(eww-end-of-field)))
(while (and (> length 0)
- (eql (char-after (1- (point))) ? ))
+ (eq (char-after (1- (point))) ? ))
(delete-region (1- (point)) (point))
(cl-decf length))))
((< length 0)
@@ -1709,6 +1758,7 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(when (string-match " +\\'" value)
(setq value (substring value 0 (match-beginning 0))))
(plist-put form :value value)
+ (plist-put form :type type)
(when (equal type "password")
;; Display passwords as asterisks.
(let ((start (eww-beginning-of-field)))
@@ -1721,7 +1771,7 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(value (or (dom-text dom) ""))
(lines (string-to-number (or (dom-attr dom 'rows) "10")))
(width (string-to-number (or (dom-attr dom 'cols) "10")))
- end)
+ end form)
(shr-ensure-newline)
(insert value)
(shr-ensure-newline)
@@ -1741,11 +1791,13 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(put-text-property (line-beginning-position) (point)
'local-map eww-textarea-map)
(forward-line 1))
- (put-text-property start (point) 'eww-form
- (list :eww-form eww-form
- :value value
- :type "textarea"
- :name (dom-attr dom 'name)))
+ (setq form (list :eww-form eww-form
+ :value value
+ :type "textarea"
+ :name (dom-attr dom 'name)))
+ (put-text-property start (point) 'eww-form form)
+ (put-text-property start (point) 'front-sticky t)
+ (put-text-property start (point) 'field form)
(put-text-property start (1+ start) 'shr-tab-stop t)))
(defun eww-tag-input (dom)
@@ -1809,6 +1861,8 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(put-text-property start (point) 'eww-form menu)
(add-face-text-property start (point) 'eww-form-select)
(put-text-property start (point) 'keymap eww-select-map)
+ ;; Pretend to touch-screen.el that this is a button.
+ (put-text-property start (point) 'button t)
(unless (= start (point))
(put-text-property start (1+ start) 'help-echo "select field")
(put-text-property start (1+ start) 'shr-tab-stop t))
@@ -1867,9 +1921,13 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(set-text-properties start new-end properties))
start))
-(defun eww-toggle-checkbox ()
- "Toggle the value of the checkbox under point."
- (interactive nil eww-mode)
+(defun eww-toggle-checkbox (&optional event)
+ "Toggle the value of the checkbox under point.
+EVENT, if non-nil, is the mouse event that preceded this command.
+Interactively, EVENT is the value of `last-nonmenu-event'."
+ (interactive (list last-nonmenu-event) eww-mode)
+ (when (and event (setq event (event-start event)))
+ (goto-char (posn-point event)))
(let* ((input (get-text-property (point) 'eww-form))
(type (plist-get input :type)))
(if (equal type "checkbox")
@@ -1937,9 +1995,13 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(substring value 0 (match-beginning 0))
value)))))
-(defun eww-submit ()
- "Submit the current form."
- (interactive nil eww-mode)
+(defun eww-submit (&optional event)
+ "Submit the form under point or EVENT.
+EVENT, if non-nil, is the mouse event that preceded this command.
+Interactively, EVENT is the value of `last-nonmenu-event'."
+ (interactive (list last-nonmenu-event) eww-mode)
+ (when (and event (setq event (event-start event)))
+ (goto-char (posn-point event)))
(let* ((this-input (get-text-property (point) 'eww-form))
(form (plist-get this-input :eww-form))
values next-submit)
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 0835d25460c..b913ba9e0a3 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -3694,7 +3694,7 @@ Passwords are stored in `rcirc-authinfo' (which see)."
"Notify user of an invitation from SENDER.
ARGS should have the form (TARGET CHANNEL). PROCESS is the
process object for the current connection."
- (let ((self (buffer-local-value 'rcirc-nick rcirc-process))
+ (let ((self (with-rcirc-process-buffer process rcirc-nick))
(target (car args))
(chan (cadr args)))
;; `rcirc-channel-filter' is not used here because joining
diff --git a/lisp/net/sasl-cram.el b/lisp/net/sasl-cram.el
index ed6e00f578a..d720c4efe6b 100644
--- a/lisp/net/sasl-cram.el
+++ b/lisp/net/sasl-cram.el
@@ -42,7 +42,7 @@
(concat (sasl-client-name client) " "
(encode-hex-string
(hmac-md5 (sasl-step-data step) passphrase)))
- (fillarray passphrase 0))))
+ (clear-string passphrase))))
(put 'sasl-cram 'sasl-mechanism
(sasl-make-mechanism "CRAM-MD5" sasl-cram-md5-steps))
diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el
index 75106fceee9..c8f38abb2aa 100644
--- a/lisp/net/sasl-digest.el
+++ b/lisp/net/sasl-digest.el
@@ -107,7 +107,7 @@ charset algorithm cipher-opts auth-param)."
(concat "AUTHENTICATE:" digest-uri
(if (member qop '("auth-int" "auth-conf"))
":00000000000000000000000000000000")))))))
- (fillarray passphrase 0))))
+ (clear-string passphrase))))
(defun sasl-digest-md5-response (client step)
(let* ((plist
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index 621b873af59..eb3d94475b9 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -219,7 +219,7 @@ It contain at least 64 bits of entropy."
(not (string= authenticator-name name)))
(concat authenticator-name "\0" name "\0" passphrase)
(concat "\0" name "\0" passphrase))
- (fillarray passphrase 0))))
+ (clear-string passphrase))))
(put 'sasl-plain 'sasl-mechanism
(sasl-make-mechanism "PLAIN" sasl-plain-steps))
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 09df5f5a9bb..14b3f7aa163 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1510,7 +1510,8 @@ Based on
https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-infore
(when-let ((rep (assoc-default (car attr) shr-correct-attribute-case)))
(setcar attr rep)))
(dolist (child (dom-children dom))
- (shr-correct-dom-case child))
+ (when (consp child)
+ (shr-correct-dom-case child)))
dom)
(defun shr-tag-svg (dom)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index da23d062c2e..b794d8b481a 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -222,15 +222,14 @@ arguments to pass to the OPERATION."
;;;###tramp-autoload
(defun tramp-adb-parse-device-names (_ignore)
"Return a list of (nil host) tuples allowed to access."
- (delq nil
- (mapcar
- (lambda (line)
- (when (string-match
- (rx bol (group (+ (not blank))) (+ blank) "device" eol) line)
- ;; Replace ":" by "#".
- `(nil ,(tramp-compat-string-replace
- ":" tramp-prefix-port-format (match-string 1 line)))))
- (tramp-process-lines nil tramp-adb-program "devices"))))
+ (tramp-compat-seq-keep
+ (lambda (line)
+ (when (string-match
+ (rx bol (group (+ (not blank))) (+ blank) "device" eol) line)
+ ;; Replace ":" by "#".
+ `(nil ,(tramp-compat-string-replace
+ ":" tramp-prefix-port-format (match-string 1 line)))))
+ (tramp-process-lines nil tramp-adb-program "devices")))
(defun tramp-adb-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el
index aa7871e6a33..b2f0bab650d 100644
--- a/lisp/net/tramp-androidsu.el
+++ b/lisp/net/tramp-androidsu.el
@@ -76,20 +76,28 @@ may edit files belonging to any and all applications."
(defconst tramp-androidsu-local-tmp-directory "/data/local/tmp"
"Name of the local temporary directory on Android.")
+;;;###tramp-autoload
+(defun tramp-enable-androidsu-method ()
+ "Enable \"androidsu\" method."
+ (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
+ `(,(rx bos (literal tramp-androidsu-method) eos)
+ nil ,tramp-root-id-string)))
+
;;;###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)))
+ (when (eq system-type 'android)
+ (tramp-enable-androidsu-method)))
(defvar android-use-exec-loader) ; androidfns.c.
@@ -110,16 +118,14 @@ multibyte mode and waits for the shell prompt to appear."
(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)))
+ (format "Opening connection%s for %s%s using %s"
+ (if (tramp-string-empty-or-nil-p process-name)
+ "" (concat " " process-name))
+ (if (tramp-string-empty-or-nil-p
+ (tramp-file-name-user vec))
+ "" (concat (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
@@ -134,12 +140,25 @@ multibyte mode and waits for the shell prompt to appear."
;; `android-use-exec-loader' off.
tramp-androidsu-local-shell-name "-i"))
(user (tramp-file-name-user vec))
- command)
+ su-binary path 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))
+ ;; Replace `login-args' place holders. `PATH' must be
+ ;; set to `tramp-androidsu-remote-path', as some `su'
+ ;; implementations propagate their callers' environments
+ ;; to the root session, which might be contaminated with
+ ;; incompatible `ls' binaries or similar.
+ (setq path (tramp-shell-quote-argument
+ (string-join tramp-androidsu-remote-path ":"))
+ su-binary
+ (shell-quote-argument
+ (or (executable-find "su")
+ (tramp-user-error
+ vec
+ "No su binary is available in any of
`exec-path'")))
+ command (format "PATH=%s exec %s - %s || exit"
+ path su-binary user))
;; Attempt to execute the shell inside the global mount
;; namespace if requested.
(when tramp-androidsu-mount-global-namespace
@@ -155,12 +174,13 @@ multibyte mode and waits for the shell prompt to appear."
(setq tramp-androidsu-su-mm-supported
;; Detect support for `su -mm'.
(tramp-adb-send-command-and-check
- vec "su -mm -c 'exit 24'" 24)))
+ vec (format "%s -mm -c 'exit 24'" su-binary)
+ 24)))
(when tramp-androidsu-su-mm-supported
(tramp-set-connection-property
vec "remote-namespace" t)
- (setq command (format "exec su -mm - %s || exit"
- user)))))
+ (setq command (format "PATH=%s exec %s -mm - %s || exit"
+ path su-binary user)))))
;; Send the command.
(tramp-message vec 3 "Sending command `%s'" command)
(tramp-adb-send-command vec command t t)
@@ -365,19 +385,31 @@ FUNCTION."
;; Generate a command to start the process using `su' with
;; suitable options for specifying the mount namespace and
;; suchlike.
+ ;; Suppress `internal-default-process-sentinel', which is
+ ;; set when :sentinel is nil. (Bug#71049)
(setq
p (let ((android-use-exec-loader nil))
(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))
+ (if (equal user "root")
+ ;; Invoke su in the simplest manner possible, that
+ ;; is to say, without specifying the user, which
+ ;; certain implementations cannot parse when a
+ ;; command is also present, if it may be omitted, so
+ ;; that starting inferior shells on systems with
+ ;; such implementations does not needlessly fail.
+ (if (tramp-get-connection-property v "remote-namespace")
+ (append (list "su" "-mm" "-c") command)
+ (append (list "su" "-c") 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
+ :sentinel (or sentinel #'ignore)
:stderr stderr)))
;; Set filter. Prior Emacs 29.1, it doesn't work reliably
;; to provide it as `make-process' argument when filter is
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 225a26ad1cd..30c38d19fb7 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -540,13 +540,13 @@ PROPERTIES is a list of file properties (strings)."
(defun tramp-list-connections ()
"Return all active `tramp-file-name' structs according to
`tramp-cache-data'."
(let ((tramp-verbose 0))
- (delq nil (mapcar
- (lambda (key)
- (and (tramp-file-name-p key)
- (null (tramp-file-name-localname key))
- (tramp-connection-property-p key "process-buffer")
- key))
- (hash-table-keys tramp-cache-data)))))
+ (tramp-compat-seq-keep
+ (lambda (key)
+ (and (tramp-file-name-p key)
+ (null (tramp-file-name-localname key))
+ (tramp-connection-property-p key "process-buffer")
+ key))
+ (hash-table-keys tramp-cache-data))))
(defun tramp-dump-connection-properties ()
"Write persistent connection properties into file \
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index d3af7a009ec..6cd856c10e5 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -70,12 +70,10 @@ SYNTAX can be one of the symbols `default' (default),
;;;###tramp-autoload
(defun tramp-list-remote-buffers ()
"Return a list of all buffers with remote `default-directory'."
- (delq
- nil
- (mapcar
- (lambda (x)
- (when (tramp-tramp-file-p (tramp-get-default-directory x)) x))
- (buffer-list))))
+ (tramp-compat-seq-keep
+ (lambda (x)
+ (when (tramp-tramp-file-p (tramp-get-default-directory x)) x))
+ (buffer-list)))
;;; Cleanup
@@ -567,6 +565,7 @@ For details, see `tramp-rename-files'."
:type '(choice (const "su")
(const "sudo")
(const "doas")
+ (const "run0")
(const "ksu")))
(defun tramp-file-name-with-sudo (filename)
@@ -691,25 +690,25 @@ This is needed if there are compatibility problems."
(format "tramp (%s %s/%s)" ; package name and version
tramp-version tramp-repository-branch tramp-repository-version)
(sort
- (delq nil (mapcar
- (lambda (x)
- (and x (boundp x) (not (get x 'tramp-suppress-trace))
- (cons x 'tramp-reporter-dump-variable)))
- (append
- (mapcar #'intern (all-completions "tramp-" obarray #'boundp))
- ;; Non-Tramp variables of interest.
- '(shell-prompt-pattern
- backup-by-copying
- backup-by-copying-when-linked
- backup-by-copying-when-mismatch
- backup-by-copying-when-privileged-mismatch
- backup-directory-alist
- password-cache
- password-cache-expiry
- remote-file-name-inhibit-cache
- connection-local-profile-alist
- connection-local-criteria-alist
- file-name-handler-alist))))
+ (tramp-compat-seq-keep
+ (lambda (x)
+ (and x (boundp x) (not (get x 'tramp-suppress-trace))
+ (cons x 'tramp-reporter-dump-variable)))
+ (append
+ (mapcar #'intern (all-completions "tramp-" obarray #'boundp))
+ ;; Non-Tramp variables of interest.
+ '(shell-prompt-pattern
+ backup-by-copying
+ backup-by-copying-when-linked
+ backup-by-copying-when-mismatch
+ backup-by-copying-when-privileged-mismatch
+ backup-directory-alist
+ password-cache
+ password-cache-expiry
+ remote-file-name-inhibit-cache
+ connection-local-profile-alist
+ connection-local-criteria-alist
+ file-name-handler-alist)))
(lambda (x y) (string< (symbol-name (car x)) (symbol-name (car y)))))
'tramp-load-report-modules ; pre-hook
@@ -792,12 +791,10 @@ buffer in your bug report.
;; Dump buffer local variables.
(insert "\nlocal variables:\n================")
- (dolist (buffer
- (delq nil
- (mapcar
- (lambda (b)
- (when (string-match-p "\\*tramp/" (buffer-name b)) b))
- (buffer-list))))
+ (dolist (buffer (tramp-compat-seq-keep
+ (lambda (b)
+ (when (string-match-p "\\*tramp/" (buffer-name b)) b))
+ (buffer-list)))
(let ((reporter-eval-buffer buffer)
(elbuf (get-buffer-create " *tmp-reporter-buffer*")))
(with-current-buffer elbuf
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 98de0dba7ff..bbffdf7f3d9 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -55,6 +55,9 @@
(with-eval-after-load 'kubernetes-tramp
(warn (concat "Package `kubernetes-tramp' has been obsoleted, "
"please use integrated package `tramp-container'")))
+(with-eval-after-load 'tramp-nspawn
+ (warn (concat "Package `tramp-nspawn' has been obsoleted, "
+ "please use integrated package `tramp-container'")))
;; For not existing functions, obsolete functions, or functions with a
;; changed argument list, there are compiler warnings. We want to
@@ -294,6 +297,13 @@ Also see `ignore'."
(autoload 'netrc-parse "netrc")
(netrc-parse file))))
+;; Function `seq-keep' is new in Emacs 29.1.
+(defalias 'tramp-compat-seq-keep
+ (if (fboundp 'seq-keep)
+ #'seq-keep
+ (lambda (function sequence)
+ (delq nil (seq-map function sequence)))))
+
;; User option `password-colon-equivalents' is new in Emacs 30.1.
(if (boundp 'password-colon-equivalents)
(defvaralias
@@ -307,15 +317,46 @@ Also see `ignore'."
?\N{KHMER SIGN CAMNUC PII KUUH})
"List of characters equivalent to trailing colon in \"password\"
prompts."))
-;; Macro `connection-local-p' is new in Emacs 30.1.
+;; Macros `connection-local-p' and `connection-local-value' are new in
+;; Emacs 30.1.
(if (macrop '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)
- (hack-connection-local-variables
- (connection-local-criteria-for-default-directory))
- (and (assq ',variable connection-local-variables-alist) t))))
+ (defmacro tramp-compat-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 ((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)))))
+
+(if (macrop 'connection-local-value)
+ (defalias 'tramp-compat-connection-local-value 'connection-local-value)
+ (defmacro tramp-compat-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
+value is the default binding of the variable."
+ (declare (debug (symbolp &optional form)))
+ (unless (symbolp variable)
+ (signal 'wrong-type-argument (list 'symbolp 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)))))
(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
(function-put (intern elt) 'tramp-suppress-trace t))
diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el
index 30639cbeb85..2886e25d16b 100644
--- a/lisp/net/tramp-container.el
+++ b/lisp/net/tramp-container.el
@@ -81,8 +81,27 @@
;; C-x C-f /flatpak:SANDBOX:/path/to/file
;;
;; Where:
-;; SANDBOX is the running sandbox to connect to.
-;; It could be an application ID, an instance ID, or a PID.
+;; SANDBOX is the running sandbox to connect to.
+;; It could be an application ID, an instance ID, or a PID.
+;;
+;;
+;;
+;; Open a file on a running Apptainer instance:
+;;
+;; C-x C-f /apptainer:INSTANCE:/path/to/file
+;;
+;; Where:
+;; INSTANCE is the running instance to connect to.
+;;
+;;
+;;
+;; Open a file on a running systemd-nspawn container:
+;;
+;; C-x C-f /nspawn:USER@CONTAINER:/path/to/file
+;;
+;; Where:
+;; USER is the user on the container to connect as (optional)
+;; CONTAINER is the container to connect to
;;; Code:
@@ -142,6 +161,21 @@ If it is nil, the default context will be used."
:type '(choice (const "flatpak")
(string)))
+;;;###tramp-autoload
+(defcustom tramp-apptainer-program "apptainer"
+ "Name of the Apptainer client program."
+ :group 'tramp
+ :version "30.1"
+ :type '(choice (const "apptainer")
+ (string)))
+
+(defcustom tramp-nspawn-program "machinectl"
+ "Name of the machinectl program."
+ :group 'tramp
+ :version "30.1"
+ :type '(choice (const "machinectl")
+ (string)))
+
;;;###tramp-autoload
(defconst tramp-docker-method "docker"
"Tramp method name to use to connect to Docker containers.")
@@ -172,6 +206,14 @@ This is for out-of-band connections.")
(defconst tramp-flatpak-method "flatpak"
"Tramp method name to use to connect to Flatpak sandboxes.")
+;;;###tramp-autoload
+(defconst tramp-apptainer-method "apptainer"
+ "Tramp method name to use to connect to Apptainer instances.")
+
+;;;###tramp-autoload
+(defconst tramp-nspawn-method "nspawn"
+ "Tramp method name to use to connect to systemd-nspawn containers.")
+
;;;###tramp-autoload
(defmacro tramp-skeleton-completion-function (method &rest body)
"Skeleton for `tramp-*-completion-function' with multi-hop support.
@@ -209,7 +251,7 @@ see its function help for a description of the format."
(concat program " ps --format '{{.ID}}\t{{.Names}}'")))
(lines (split-string raw-list "\n" 'omit))
(names
- (mapcar
+ (tramp-compat-seq-keep
(lambda (line)
(when (string-match
(rx bol (group (1+ nonl))
@@ -217,7 +259,7 @@ see its function help for a description of the format."
line)
(or (match-string 2 line) (match-string 1 line))))
lines)))
- (mapcar (lambda (name) (list nil name)) (delq nil names)))))
+ (mapcar (lambda (name) (list nil name)) names))))
;;;###tramp-autoload
(defun tramp-kubernetes--completion-function (method)
@@ -339,7 +381,7 @@ see its function help for a description of the format."
(when-let ((raw-list (shell-command-to-string (concat program " list -c")))
;; Ignore header line.
(lines (cdr (split-string raw-list "\n" 'omit)))
- (names (mapcar
+ (names (tramp-compat-seq-keep
(lambda (line)
(when (string-match
(rx bol (1+ (not space))
@@ -347,7 +389,7 @@ see its function help for a description of the format."
line)
(match-string 1 line)))
lines)))
- (mapcar (lambda (name) (list nil name)) (delq nil names)))))
+ (mapcar (lambda (name) (list nil name)) names))))
;;;###tramp-autoload
(defun tramp-flatpak--completion-function (method)
@@ -363,7 +405,7 @@ see its function help for a description of the format."
;; Ignore header line.
(concat program " ps --columns=instance,application | cat -")))
(lines (split-string raw-list "\n" 'omit))
- (names (mapcar
+ (names (tramp-compat-seq-keep
(lambda (line)
(when (string-match
(rx bol (* space) (group (+ (not space)))
@@ -371,7 +413,44 @@ see its function help for a description of the format."
line)
(or (match-string 2 line) (match-string 1 line))))
lines)))
- (mapcar (lambda (name) (list nil name)) (delq nil names)))))
+ (mapcar (lambda (name) (list nil name)) names))))
+
+;;;###tramp-autoload
+(defun tramp-apptainer--completion-function (method)
+ "List Apptainer instances available for connection.
+
+This function is used by `tramp-set-completion-function', please
+see its function help for a description of the format."
+ (tramp-skeleton-completion-function method
+ (when-let ((raw-list
+ (shell-command-to-string (concat program " instance list")))
+ ;; Ignore header line.
+ (lines (cdr (split-string raw-list "\n" 'omit)))
+ (names (tramp-compat-seq-keep
+ (lambda (line)
+ (when (string-match
+ (rx bol (group (1+ (not space)))
+ (1+ space) (1+ (not space))
+ (1+ space) (1+ (not space)))
+ line)
+ (match-string 1 line)))
+ lines)))
+ (mapcar (lambda (name) (list nil name)) names))))
+
+(defun tramp-nspawn--completion-function (method)
+ "List systemd-nspawn containers available for connection.
+
+This function is used by `tramp-set-completion-function', please
+see its function help for a description of the format."
+ (tramp-skeleton-completion-function method
+ (when-let ((raw-list
+ (shell-command-to-string (concat program " list --all -q")))
+ ;; Ignore header line.
+ (lines (cdr (split-string raw-list "\n")))
+ (first-words (mapcar (lambda (line) (car (split-string line)))
+ lines))
+ (machines (seq-take-while (lambda (name) name) first-words)))
+ (mapcar (lambda (m) (list nil m)) machines))))
;;;###tramp-autoload
(defvar tramp-default-remote-shell) ;; Silence byte compiler.
@@ -453,29 +532,9 @@ see its function help for a description of the format."
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-i" "-c"))))
- (add-to-list 'tramp-methods
- `(,tramp-toolbox-method
- (tramp-login-program ,tramp-toolbox-program)
- (tramp-login-args (("run")
- ("-c" "%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 ("-c"))))
-
- (add-to-list 'tramp-default-host-alist `(,tramp-toolbox-method nil ""))
-
- (add-to-list 'tramp-methods
- `(,tramp-flatpak-method
- (tramp-login-program ,tramp-flatpak-program)
- (tramp-login-args (("enter")
- ("%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 ("-c"))))
+ (add-to-list 'tramp-completion-multi-hop-methods tramp-docker-method)
+ (add-to-list 'tramp-completion-multi-hop-methods tramp-podman-method)
+ (add-to-list 'tramp-completion-multi-hop-methods tramp-kubernetes-method)
(tramp-set-completion-function
tramp-docker-method
@@ -497,30 +556,14 @@ see its function help for a description of the format."
tramp-kubernetes-method
`((tramp-kubernetes--completion-function ,tramp-kubernetes-method)))
- (tramp-set-completion-function
- tramp-toolbox-method
- `((tramp-toolbox--completion-function ,tramp-toolbox-method)))
-
- (tramp-set-completion-function
- tramp-flatpak-method
- `((tramp-flatpak--completion-function ,tramp-flatpak-method)))
-
- (add-to-list 'tramp-completion-multi-hop-methods tramp-docker-method)
- (add-to-list 'tramp-completion-multi-hop-methods tramp-podman-method)
- (add-to-list 'tramp-completion-multi-hop-methods tramp-kubernetes-method)
- (add-to-list 'tramp-completion-multi-hop-methods tramp-toolbox-method)
- (add-to-list 'tramp-completion-multi-hop-methods tramp-flatpak-method)
-
- ;; Default connection-local variables for Tramp.
-
(defconst tramp-kubernetes-connection-local-default-variables
'((tramp-config-check . tramp-kubernetes--current-context-data)
;; This variable will be eval'ed in `tramp-expand-args'.
(tramp-extra-expand-args
. (?a (tramp-kubernetes--container (car tramp-current-connection))
- ?h (tramp-kubernetes--pod (car tramp-current-connection))
- ?x (tramp-kubernetes--context-namespace
- (car tramp-current-connection)))))
+ ?h (tramp-kubernetes--pod (car tramp-current-connection))
+ ?x (tramp-kubernetes--context-namespace
+ (car tramp-current-connection)))))
"Default connection-local variables for remote kubernetes connections.")
(connection-local-set-profile-variables
@@ -529,19 +572,101 @@ see its function help for a description of the format."
(connection-local-set-profiles
`(:application tramp :protocol ,tramp-kubernetes-method)
- 'tramp-kubernetes-connection-local-default-profile)
+ 'tramp-kubernetes-connection-local-default-profile))
- (defconst tramp-flatpak-connection-local-default-variables
- `((tramp-remote-path . ,(cons "/app/bin" tramp-remote-path)))
- "Default connection-local variables for remote flatpak connections.")
+;;;###tramp-autoload
+(defun tramp-enable-toolbox-method ()
+ "Enable connection to Toolbox containers."
+ (add-to-list 'tramp-methods
+ `(,tramp-toolbox-method
+ (tramp-login-program ,tramp-toolbox-program)
+ (tramp-login-args (("run")
+ ("-c" "%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 ("-c"))))
+
+ (add-to-list 'tramp-default-host-alist `(,tramp-toolbox-method nil ""))
+ (add-to-list 'tramp-completion-multi-hop-methods tramp-toolbox-method)
+
+ (tramp-set-completion-function
+ tramp-toolbox-method
+ `((tramp-toolbox--completion-function ,tramp-toolbox-method))))
- (connection-local-set-profile-variables
- 'tramp-flatpak-connection-local-default-profile
- tramp-flatpak-connection-local-default-variables)
+;;;###tramp-autoload
+(defun tramp-enable-flatpak-method ()
+ "Enable connection to Flatpak sandboxes."
+ (add-to-list 'tramp-methods
+ `(,tramp-flatpak-method
+ (tramp-login-program ,tramp-flatpak-program)
+ (tramp-login-args (("enter")
+ ("%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 ("-c"))))
+
+ (add-to-list 'tramp-completion-multi-hop-methods tramp-flatpak-method)
+
+ (tramp-set-completion-function
+ tramp-flatpak-method
+ `((tramp-flatpak--completion-function ,tramp-flatpak-method)))
+
+ (defconst tramp-flatpak-connection-local-default-variables
+ `((tramp-remote-path . ,(cons "/app/bin" tramp-remote-path)))
+ "Default connection-local variables for remote flatpak connections.")
+
+ (connection-local-set-profile-variables
+ 'tramp-flatpak-connection-local-default-profile
+ tramp-flatpak-connection-local-default-variables)
+
+ (connection-local-set-profiles
+ `(:application tramp :protocol ,tramp-flatpak-method)
+ 'tramp-flatpak-connection-local-default-profile))
- (connection-local-set-profiles
- `(:application tramp :protocol ,tramp-flatpak-method)
- 'tramp-flatpak-connection-local-default-profile))
+;;;###tramp-autoload
+(defun tramp-enable-apptainer-method ()
+ "Enable connection to Apptainer instances."
+ (add-to-list 'tramp-methods
+ `(,tramp-apptainer-method
+ (tramp-login-program ,tramp-apptainer-program)
+ (tramp-login-args (("shell")
+ ("instance://%h")
+ ("%h"))) ; Needed for multi-hop check.
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))))
+
+ (add-to-list 'tramp-completion-multi-hop-methods tramp-apptainer-method)
+
+ (tramp-set-completion-function
+ tramp-apptainer-method
+ `((tramp-apptainer--completion-function ,tramp-apptainer-method))))
+
+;; todo: check tramp-async-args and tramp-direct-async
+;;;###tramp-autoload
+(defun tramp-enable-nspawn-method ()
+ "Enable connection to nspawn containers."
+ (add-to-list 'tramp-methods
+ `(,tramp-nspawn-method
+ (tramp-login-program ,tramp-nspawn-program)
+ (tramp-login-args (("shell")
+ ("-q")
+ ("--uid" "%u")
+ ("%h")))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i" "-c"))))
+
+ (add-to-list 'tramp-default-host-alist `(,tramp-nspawn-method nil ".host"))
+ (add-to-list 'tramp-completion-multi-hop-methods tramp-nspawn-method)
+
+ (tramp-set-completion-function
+ tramp-nspawn-method
+ `((tramp-nspawn--completion-function ,tramp-nspawn-method))))
(add-hook 'tramp-unload-hook
(lambda ()
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 93071ed7350..b1820b3e2fe 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -2245,10 +2245,10 @@ connection if a previous connection has died for some
reason."
(tramp-make-tramp-file-name vec 'noloc))))
(with-tramp-progress-reporter
- vec 3
- (if (tramp-string-empty-or-nil-p user)
- (format "Opening connection for %s using %s" host method)
- (format "Opening connection for %s@%s using %s" user host method))
+ vec 3 (format "Opening connection for %s%s using %s"
+ (if (tramp-string-empty-or-nil-p user)
+ "" (concat user "@"))
+ host method)
;; Enable `auth-source'.
(tramp-set-connection-property
diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el
index 97e94a51e7a..685b14d14db 100644
--- a/lisp/net/tramp-message.el
+++ b/lisp/net/tramp-message.el
@@ -459,6 +459,16 @@ the resulting error message."
(progn ,@body)
(error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
+(defsubst tramp-warning (vec-or-proc fmt-string &rest arguments)
+ "Show a warning.
+VEC-OR-PROC identifies the connection to use, remaining arguments passed
+to `tramp-message'."
+ (declare (tramp-suppress-trace t))
+ (let (signal-hook-function)
+ (apply 'tramp-message vec-or-proc 2 fmt-string arguments)
+ (display-warning
+ 'tramp (apply #'format-message fmt-string arguments) :warning)))
+
(defun tramp-test-message (fmt-string &rest arguments)
"Emit a Tramp message according `default-directory'."
(declare (tramp-suppress-trace t))
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index ced3c1b5aa8..03b0dedbb70 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -189,12 +189,11 @@ arguments to pass to the OPERATION."
(defun tramp-rclone-parse-device-names (_ignore)
"Return a list of (nil host) tuples allowed to access."
(with-tramp-connection-property nil "rclone-device-names"
- (delq nil
- (mapcar
- (lambda (line)
- (when (string-match (rx bol (group (+ (not blank))) ":" eol) line)
- `(nil ,(match-string 1 line))))
- (tramp-process-lines nil tramp-rclone-program "listremotes")))))
+ (tramp-compat-seq-keep
+ (lambda (line)
+ (when (string-match (rx bol (group (+ (not blank))) ":" eol) line)
+ `(nil ,(match-string 1 line))))
+ (tramp-process-lines nil tramp-rclone-program "listremotes"))))
;; File name primitives.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 66e648624b2..c079455a444 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -272,22 +272,6 @@ The string is used in `tramp-methods'.")
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
- (add-to-list 'tramp-methods
- `("nc"
- (tramp-login-program "telnet")
- (tramp-login-args (("%h") ("%p") ("%n")))
- (tramp-remote-shell ,tramp-default-remote-shell)
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))
- (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
- ;; can be achieved by tweaking `tramp-connection-properties'.
- (tramp-remote-copy-args (("-l") ("-p" "%r") ("%n")))))
(add-to-list 'tramp-methods
`("su"
(tramp-login-program "su")
@@ -328,21 +312,6 @@ The string is used in `tramp-methods'.")
(tramp-connection-timeout 10)
(tramp-session-timeout 300)
(tramp-password-previous-hop t)))
- (add-to-list 'tramp-methods
- `("ksu"
- (tramp-login-program "ksu")
- (tramp-login-args (("%u") ("-q")))
- (tramp-remote-shell ,tramp-default-remote-shell)
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))
- (tramp-connection-timeout 10)))
- (add-to-list 'tramp-methods
- `("krlogin"
- (tramp-login-program "krlogin")
- (tramp-login-args (("%h") ("-l" "%u") ("-x")))
- (tramp-remote-shell ,tramp-default-remote-shell)
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))))
(add-to-list 'tramp-methods
`("plink"
(tramp-login-program "plink")
@@ -403,30 +372,18 @@ The string is used in `tramp-methods'.")
(tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp")
("-p" "%k")))
(tramp-copy-keep-date t)))
- (add-to-list 'tramp-methods
- `("fcp"
- (tramp-login-program "fsh")
- (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i")))
- (tramp-remote-shell ,tramp-default-remote-shell)
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-i") ("-c"))
- (tramp-copy-program "fcp")
- (tramp-copy-args (("-p" "%k")))
- (tramp-copy-keep-date t)))
(add-to-list 'tramp-default-method-alist
`(,tramp-local-host-regexp
,(rx bos (literal tramp-root-id-string) eos) "su"))
(add-to-list 'tramp-default-user-alist
- `(,(rx bos (| "su" "sudo" "doas" "ksu") eos)
+ `(,(rx bos (| "su" "sudo" "doas") eos)
nil ,tramp-root-id-string))
;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored.
;; Do not add "plink" based methods, they ask interactively for the user.
(add-to-list 'tramp-default-user-alist
- `(,(rx bos
- (| "rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp")
- eos)
+ `(,(rx bos (| "rcp" "remcp" "rsh" "telnet") eos)
nil ,(user-login-name))))
(defconst tramp-default-copy-file-name '(("%u" "@") ("%h" ":") ("%f"))
@@ -508,20 +465,112 @@ The string is used in `tramp-methods'.")
(tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh)
(tramp-set-completion-function
"telnet" tramp-completion-function-alist-telnet)
- (tramp-set-completion-function "nc" tramp-completion-function-alist-telnet)
(tramp-set-completion-function "su" tramp-completion-function-alist-su)
(tramp-set-completion-function "sudo" tramp-completion-function-alist-su)
(tramp-set-completion-function "doas" tramp-completion-function-alist-su)
- (tramp-set-completion-function "ksu" tramp-completion-function-alist-su)
(tramp-set-completion-function "sg" tramp-completion-function-alist-sg)
- (tramp-set-completion-function
- "krlogin" tramp-completion-function-alist-rsh)
(tramp-set-completion-function "plink" tramp-completion-function-alist-ssh)
(tramp-set-completion-function
"plinkx" tramp-completion-function-alist-putty)
(tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "psftp" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh))
+ (tramp-set-completion-function "psftp" tramp-completion-function-alist-ssh))
+
+;;;###tramp-autoload
+(defun tramp-enable-nc-method ()
+ "Enable \"ksu\" method."
+ (add-to-list 'tramp-methods
+ `("nc"
+ (tramp-login-program "telnet")
+ (tramp-login-args (("%h") ("%p") ("%n")))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (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 can be achieved by tweaking
+ ;; `tramp-connection-properties'.
+ (tramp-remote-copy-args (("-l") ("-p" "%r") ("%n")))))
+
+ (add-to-list 'tramp-default-user-alist
+ `(,(rx bos "nc" eos) nil ,(user-login-name)))
+
+ (tramp-set-completion-function "nc" tramp-completion-function-alist-telnet))
+
+;;;###tramp-autoload
+(defun tramp-enable-run0-method ()
+ "Enable \"run0\" method."
+ (add-to-list 'tramp-methods
+ `("run0"
+ (tramp-login-program "systemd-run")
+ (tramp-login-args (("--uid" "%u") ("-t") ("%l")))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-args ("-c"))
+ (tramp-connection-timeout 10)
+ (tramp-session-timeout 300)
+ (tramp-password-previous-hop t)))
+
+ (add-to-list 'tramp-default-user-alist
+ `(,(rx bos "run0" eos) nil ,tramp-root-id-string))
+
+ (tramp-set-completion-function "run0" tramp-completion-function-alist-su))
+
+;;;###tramp-autoload
+(defun tramp-enable-ksu-method ()
+ "Enable \"ksu\" method."
+ (add-to-list 'tramp-methods
+ `("ksu"
+ (tramp-login-program "ksu")
+ (tramp-login-args (("%u") ("-q")))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-connection-timeout 10)))
+
+ (add-to-list 'tramp-default-user-alist
+ `(,(rx bos "ksu" eos) nil ,tramp-root-id-string))
+
+ (tramp-set-completion-function "ksu" tramp-completion-function-alist-su))
+
+;;;###tramp-autoload
+(defun tramp-enable-krlogin-method ()
+ "Enable \"krlogin\" method."
+ (add-to-list 'tramp-methods
+ `("krlogin"
+ (tramp-login-program "krlogin")
+ (tramp-login-args (("%h") ("-l" "%u") ("-x")))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))))
+
+ (add-to-list 'tramp-default-user-alist
+ `(,(rx bos "krlogin" eos) nil ,(user-login-name)))
+
+ (tramp-set-completion-function
+ "krlogin" tramp-completion-function-alist-rsh))
+
+;;;###tramp-autoload
+(defun tramp-enable-fcp-method ()
+ "Enable \"fcp\" method."
+ (add-to-list 'tramp-methods
+ `("fcp"
+ (tramp-login-program "fsh")
+ (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i")))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i") ("-c"))
+ (tramp-copy-program "fcp")
+ (tramp-copy-args (("-p" "%k")))
+ (tramp-copy-keep-date t)))
+
+ (add-to-list 'tramp-default-user-alist
+ `(,(rx bos "fcp" eos) nil ,(user-login-name)))
+
+ (tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh))
(defcustom tramp-sh-extra-args
`((,(rx (| bos "/") "bash" eos) . "-noediting -norc -noprofile")
@@ -2653,6 +2702,18 @@ The method used must be an out-of-band method."
(let ((dired (tramp-get-ls-command-with v "--dired")))
(when (stringp switches)
(setq switches (split-string switches)))
+ ;; Newer coreutil versions of ls (9.5 and up) imply long format
+ ;; output when "--dired" is given. Suppress this implicit rule.
+ (when dired
+ (let ((tem switches)
+ case-fold-search)
+ (catch 'long
+ (while tem
+ (when (and (not (string-match-p "--" (car tem)))
+ (string-match-p "l" (car tem)))
+ (throw 'long nil))
+ (setq tem (cdr tem)))
+ (setq dired nil))))
(setq switches
(append switches (split-string (tramp-sh--quoting-style-options
v))
(when dired `(,dired))))
@@ -2859,7 +2920,7 @@ the result will be a local, non-Tramp, file name."
;; use a user name from the config file.
(when (and (tramp-string-empty-or-nil-p uname)
(string-match-p
- (rx bos (| "su" "sudo" "doas" "ksu") eos) method))
+ (rx bos (| "su" "sudo" "doas" "run0" "ksu") eos)
method))
(setq uname user))
(when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname)))))
@@ -4407,8 +4468,8 @@ file exists and nonzero exit status otherwise."
;; Maybe it works at least for some other commands.
(prog1
default-shell
- (tramp-message
- vec 2
+ (tramp-warning
+ vec
(concat
"Couldn't find a remote shell which groks tilde "
"expansion, using `%s'")
@@ -4942,8 +5003,8 @@ Goes through the list `tramp-inline-compress-commands'."
(tramp-set-connection-property p "inline-compress" nil)
(tramp-set-connection-property p "inline-decompress" nil)
- (tramp-message
- vec 2 "Couldn't find an inline transfer compress command")))))
+ (tramp-warning
+ vec "Couldn't find an inline transfer compress command")))))
(defun tramp-ssh-option-exists-p (vec option)
"Check, whether local ssh OPTION is applicable."
@@ -5202,194 +5263,194 @@ connection if a previous connection has died for some
reason."
;; New connection must be opened.
(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)))
-
- (catch 'uname-changed
- ;; Start new process.
- (when (and p (processp p))
- (delete-process p))
- (setenv "TERM" tramp-terminal-type)
- (setenv "LC_ALL" (tramp-get-local-locale vec))
- (if (stringp tramp-histfile-override)
- (setenv "HISTFILE" tramp-histfile-override)
- (if tramp-histfile-override
- (progn
- (setenv "HISTFILE")
- (setenv "HISTFILESIZE" "0")
- (setenv "HISTSIZE" "0"))))
- (setenv "PROMPT_COMMAND")
- (setenv "PS1" tramp-initial-end-of-output)
- (unless (stringp tramp-encoding-shell)
- (tramp-error vec 'file-error "`tramp-encoding-shell' not
set"))
- (let* ((current-host tramp-system-name)
- (target-alist (tramp-compute-multi-hops vec))
- (previous-hop tramp-null-hop)
- ;; We will apply `tramp-ssh-controlmaster-options'
- ;; only for the first hop.
- (options (tramp-ssh-controlmaster-options vec))
- (process-connection-type tramp-process-connection-type)
- (process-adaptive-read-buffering nil)
- ;; There are unfortunate settings for
- ;; "cmdproxy" on W32 systems.
- (process-coding-system-alist nil)
- (coding-system-for-read nil)
- (extra-args
- (tramp-get-sh-extra-args tramp-encoding-shell))
- ;; This must be done in order to avoid our file
- ;; name handler.
- (p (let ((default-directory
- tramp-compat-temporary-file-directory))
- (apply
- #'start-process
- (tramp-get-connection-name vec)
- (tramp-get-connection-buffer vec)
- (append
- `(,tramp-encoding-shell)
- (and extra-args (split-string extra-args))
- (and tramp-encoding-command-interactive
- `(,tramp-encoding-command-interactive)))))))
-
- ;; 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)
- ;; Set sentinel. Initialize variables.
- (set-process-sentinel p #'tramp-process-sentinel)
- (tramp-post-process-creation p vec)
- (setq tramp-current-connection (cons vec (current-time)))
-
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
- ;; Check whether process is alive.
- (tramp-barf-if-no-shell-prompt
- p 10
- "Couldn't find local shell prompt for %s"
- tramp-encoding-shell)
-
- ;; Now do all the connections as specified.
- (while target-alist
- (let* ((hop (car target-alist))
- (l-method (tramp-file-name-method hop))
- (l-user (tramp-file-name-user hop))
- (l-domain (tramp-file-name-domain hop))
- (l-host (tramp-file-name-host hop))
- (l-port (tramp-file-name-port hop))
- (remote-shell
- (tramp-get-method-parameter hop
'tramp-remote-shell))
- (extra-args (tramp-get-sh-extra-args remote-shell))
- (async-args
- (flatten-tree
- (tramp-get-method-parameter hop
'tramp-async-args)))
- (connection-timeout
- (tramp-get-method-parameter
- hop 'tramp-connection-timeout
- tramp-connection-timeout))
- (command
- (tramp-get-method-parameter
- hop 'tramp-login-program))
- ;; We don't create the temporary file. In
- ;; fact, it is just a prefix for the
- ;; ControlPath option of ssh; the real
- ;; temporary file has another name, and it
- ;; is created and protected by ssh. It is
- ;; also removed by ssh when the connection
- ;; is closed. The temporary file name is
- ;; cached in the main connection process,
- ;; therefore we cannot use
- ;; `tramp-get-connection-process'.
- (tmpfile
- (with-tramp-connection-property
- (tramp-get-process vec) "temp-file"
- (tramp-compat-make-temp-name)))
- r-shell)
-
- ;; Check, whether there is a restricted shell.
- (dolist (elt tramp-restricted-shell-hosts-alist)
- (when (string-match-p elt current-host)
- (setq r-shell t)))
- (setq current-host l-host)
-
- ;; Set password prompt vector.
+ (catch 'uname-changed
+ ;; Start new process.
+ (when (and p (processp p))
+ (delete-process p))
+ (setenv "TERM" tramp-terminal-type)
+ (setenv "LC_ALL" (tramp-get-local-locale vec))
+ (if (stringp tramp-histfile-override)
+ (setenv "HISTFILE" tramp-histfile-override)
+ (if tramp-histfile-override
+ (progn
+ (setenv "HISTFILE")
+ (setenv "HISTFILESIZE" "0")
+ (setenv "HISTSIZE" "0"))))
+ (setenv "PROMPT_COMMAND")
+ (setenv "PS1" tramp-initial-end-of-output)
+ (unless (stringp tramp-encoding-shell)
+ (tramp-error vec 'file-error "`tramp-encoding-shell' not set"))
+ (let* ((current-host tramp-system-name)
+ (target-alist (tramp-compute-multi-hops vec))
+ (previous-hop tramp-null-hop)
+ ;; We will apply `tramp-ssh-controlmaster-options'
+ ;; only for the first hop.
+ (options (tramp-ssh-controlmaster-options vec))
+ (process-connection-type tramp-process-connection-type)
+ (process-adaptive-read-buffering nil)
+ ;; There are unfortunate settings for "cmdproxy"
+ ;; on W32 systems.
+ (process-coding-system-alist nil)
+ (coding-system-for-read nil)
+ (extra-args (tramp-get-sh-extra-args tramp-encoding-shell))
+ ;; This must be done in order to avoid our file
+ ;; name handler.
+ (p (let ((default-directory
+ tramp-compat-temporary-file-directory))
+ (apply
+ #'start-process
+ (tramp-get-connection-name vec)
+ (tramp-get-connection-buffer vec)
+ (append
+ `(,tramp-encoding-shell)
+ (and extra-args (split-string extra-args))
+ (and tramp-encoding-command-interactive
+ `(,tramp-encoding-command-interactive)))))))
+
+ ;; 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)
+ ;; Set sentinel. Initialize variables.
+ (set-process-sentinel p #'tramp-process-sentinel)
+ (tramp-post-process-creation p vec)
+ (setq tramp-current-connection (cons vec (current-time)))
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
+ ;; Check whether process is alive.
+ (tramp-barf-if-no-shell-prompt
+ p 10
+ "Couldn't find local shell prompt for %s"
+ tramp-encoding-shell)
+
+ ;; Now do all the connections as specified.
+ (while target-alist
+ (let* ((hop (car target-alist))
+ (l-method (tramp-file-name-method hop))
+ (l-user (tramp-file-name-user hop))
+ (l-domain (tramp-file-name-domain hop))
+ (l-host (tramp-file-name-host hop))
+ (l-port (tramp-file-name-port hop))
+ (remote-shell
+ (tramp-get-method-parameter hop 'tramp-remote-shell))
+ (extra-args (tramp-get-sh-extra-args remote-shell))
+ (async-args
+ (flatten-tree
+ (tramp-get-method-parameter hop 'tramp-async-args)))
+ (connection-timeout
+ (tramp-get-method-parameter
+ hop 'tramp-connection-timeout
+ tramp-connection-timeout))
+ (command
+ (tramp-get-method-parameter
+ hop 'tramp-login-program))
+ ;; We don't create the temporary file. In
+ ;; fact, it is just a prefix for the
+ ;; ControlPath option of ssh; the real
+ ;; temporary file has another name, and it is
+ ;; created and protected by ssh. It is also
+ ;; removed by ssh when the connection is
+ ;; closed. The temporary file name is cached
+ ;; in the main connection process, therefore
+ ;; we cannot use
+ ;; `tramp-get-connection-process'.
+ (tmpfile
+ (with-tramp-connection-property
+ (tramp-get-process vec) "temp-file"
+ (tramp-compat-make-temp-name)))
+ r-shell)
+
+ ;; Check, whether there is a restricted shell.
+ (dolist (elt tramp-restricted-shell-hosts-alist)
+ (when (string-match-p elt current-host)
+ (setq r-shell t)))
+ (setq current-host l-host)
+
+ ;; Set password prompt vector.
+ (tramp-set-connection-property
+ p "password-vector"
+ (if (tramp-get-method-parameter
+ hop 'tramp-password-previous-hop)
+ (let ((pv (copy-tramp-file-name previous-hop)))
+ (setf (tramp-file-name-method pv) l-method)
+ pv)
+ (make-tramp-file-name
+ :method l-method :user l-user :domain l-domain
+ :host l-host :port l-port)))
+
+ ;; Set session timeout.
+ (when-let ((timeout
+ (tramp-get-method-parameter
+ hop 'tramp-session-timeout)))
(tramp-set-connection-property
- p "password-vector"
- (if (tramp-get-method-parameter
- hop 'tramp-password-previous-hop)
- (let ((pv (copy-tramp-file-name previous-hop)))
- (setf (tramp-file-name-method pv) l-method)
- pv)
- (make-tramp-file-name
- :method l-method :user l-user :domain l-domain
- :host l-host :port l-port)))
-
- ;; Set session timeout.
- (when (tramp-get-method-parameter
- hop 'tramp-session-timeout)
- (tramp-set-connection-property
- p "session-timeout"
- (tramp-get-method-parameter
- hop 'tramp-session-timeout)))
-
- ;; Replace `login-args' place holders.
- (setq
- command
- (string-join
- (append
- ;; We do not want to see the trailing local
- ;; prompt in `start-file-process'.
- (unless r-shell '("exec"))
- `(,command)
- ;; Add arguments for asynchronous processes.
- (when process-name async-args)
- (tramp-expand-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"))
- " "))
-
- ;; Send the command.
- (tramp-message vec 3 "Sending command `%s'" command)
+ p "session-timeout" timeout))
+
+ ;; Replace `login-args' place holders.
+ (setq
+ command
+ (string-join
+ (append
+ ;; We do not want to see the trailing local
+ ;; prompt in `start-file-process'.
+ (unless r-shell '("exec"))
+ `(,command)
+ ;; Add arguments for asynchronous processes.
+ (when process-name async-args)
+ (tramp-expand-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"))
+ " "))
+
+ ;; Send the command.
+ (with-tramp-progress-reporter
+ vec 3
+ (format "Opening connection%s for %s%s using %s"
+ (if (tramp-string-empty-or-nil-p process-name)
+ "" (concat " " process-name))
+ (if (tramp-string-empty-or-nil-p l-user)
+ "" (concat l-user "@"))
+ l-host l-method)
(tramp-send-command vec command t t)
(tramp-process-actions
p vec
(min
pos (with-current-buffer (process-buffer p)
(point-max)))
- tramp-actions-before-shell connection-timeout)
- (tramp-message
- vec 3 "Found remote shell prompt on `%s'" l-host)
+ tramp-actions-before-shell connection-timeout))
- ;; Next hop.
- (setq options ""
- target-alist (cdr target-alist)
- previous-hop hop)))
+ ;; Next hop.
+ (setq options ""
+ target-alist (cdr target-alist)
+ previous-hop hop)))
- ;; Activate session timeout.
- (when (tramp-get-connection-property p "session-timeout")
- (run-at-time
- (tramp-get-connection-property p "session-timeout") nil
- #'tramp-timeout-session vec))
+ ;; Activate session timeout.
+ (when (tramp-get-connection-property p "session-timeout")
+ (run-at-time
+ (tramp-get-connection-property p "session-timeout") nil
+ #'tramp-timeout-session vec))
- ;; Make initial shell settings.
- (tramp-open-connection-setup-interactive-shell p vec)
+ ;; Make initial shell settings.
+ (with-tramp-progress-reporter
+ vec 3
+ (format "Setup connection%s for %s%s using %s"
+ (if (tramp-string-empty-or-nil-p process-name)
+ "" (concat " " process-name))
+ (if (tramp-string-empty-or-nil-p
+ (tramp-file-name-user vec))
+ "" (concat (tramp-file-name-user vec) "@"))
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec))
+ (tramp-open-connection-setup-interactive-shell p vec))
- ;; Mark it as connected.
- (tramp-set-connection-property p "connected" t)))))
+ ;; Mark it as connected.
+ (tramp-set-connection-property p "connected" t))))
;; Cleanup, and propagate the signal.
((error quit)
@@ -5654,8 +5715,8 @@ Nonexistent directories are removed from spec."
(tramp-shell-quote-argument tramp-end-of-heredoc))
'noerror (rx (literal tramp-end-of-heredoc)))
(progn
- (tramp-message
- vec 2 "Could not retrieve `tramp-own-remote-path'")
+ (tramp-warning
+ vec "Could not retrieve `tramp-own-remote-path'")
nil)))))
;; Replace place holder `tramp-default-remote-path'.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 3616cad2fb3..c6c3caabdcf 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1068,17 +1068,15 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Filter entries.
(setq entries
- (delq
- nil
(if (or wildcard (string-empty-p base))
;; Check for matching entries.
- (mapcar
+ (tramp-compat-seq-keep
(lambda (x)
(when (string-match-p (rx bol (literal base)) (nth 0 x))
x))
entries)
;; We just need the only and only entry FILENAME.
- (list (assoc base entries)))))
+ (list (assoc base entries))))
;; Sort entries.
(setq entries
@@ -1233,7 +1231,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
((car destination)
(setq outbuf (current-buffer))))
;; stderr.
- (tramp-message v 2 "%s" "STDERR not supported"))
+ (tramp-warning v "%s" "STDERR not supported"))
;; 't
(destination
(setq outbuf (current-buffer))))
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index d0d56b8967e..218cf30dea5 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -67,9 +67,6 @@
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
- (add-to-list 'tramp-connection-properties
- `(,(format "/%s:" tramp-sshfs-method) "direct-async-process" t))
-
(tramp-set-completion-function
tramp-sshfs-method tramp-completion-function-alist-ssh))
@@ -445,6 +442,16 @@ connection if a previous connection has died for some
reason."
(with-tramp-connection-property
vec "gid-string" (tramp-get-local-gid 'string))))
+;; Default connection-local variables for Tramp.
+
+(connection-local-set-profile-variables
+ 'tramp-sshfs-connection-local-default-profile
+ '((tramp-direct-async-process t)))
+
+(connection-local-set-profiles
+ `(:application tramp :protocol ,tramp-sshfs-method)
+ 'tramp-sshfs-connection-local-default-profile)
+
;; `shell-mode' tries to open remote files like "/sshfs:user@host:~/.history".
;; This fails, because the tilde cannot be expanded. Tell
;; `tramp-handle-expand-file-name' to tolerate this.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 5b101000926..9385b023392 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -562,11 +562,13 @@ host runs a restricted shell, it shall be added to this
list, too."
;; Fedora.
"localhost4" "localhost6"
;; Ubuntu.
- "ip6-localhost" "ip6-loopback"))
+ "ip6-localhost" "ip6-loopback"
+ ;; OpenSUSE.
+ "ipv6-localhost" "ipv6-loopback"))
eos)
"Host names which are regarded as local host.
If the local host runs a chrooted environment, set this to nil."
- :version "29.3"
+ :version "30.1"
:type '(choice (const :tag "Chrooted environment" nil)
(regexp :tag "Host regexp")))
@@ -1460,6 +1462,35 @@ calling HANDLER.")
;;; Internal functions which must come first:
+(defun tramp-enable-method (method)
+ "Enable optional METHOD if possible."
+ (interactive
+ (list
+ (completing-read
+ "method: "
+ (tramp-compat-seq-keep
+ (lambda (x)
+ (when-let ((name (symbol-name x))
+ ;; It must match `tramp-enable-METHOD-method'.
+ ((string-match
+ (rx "tramp-enable-"
+ (group (regexp tramp-method-regexp))
+ "-method")
+ name))
+ (method (match-string 1 name))
+ ;; It must not be enabled yet.
+ ((not (assoc method tramp-methods))))
+ method))
+ ;; All method enabling functions.
+ (mapcar
+ #'intern (all-completions "tramp-enable-" obarray #'functionp))))))
+
+ (when-let (((not (assoc method tramp-methods)))
+ (fn (intern (format "tramp-enable-%s-method" method)))
+ ((functionp fn)))
+ (funcall fn)
+ (message "Tramp method \"%s\" enabled" method)))
+
;; Conversion functions between external representation and
;; internal data structure. Convenience functions for internal
;; data structure.
@@ -2949,17 +2980,15 @@ They are collected by
`tramp-completion-dissect-file-name1'."
(regexp tramp-prefix-ipv6-regexp)
(group (? (regexp tramp-ipv6-regexp))) eol)
1 2 3 nil)))
- (delq
- nil
- (mapcar
- (lambda (structure) (tramp-completion-dissect-file-name1 structure name))
- (list
- tramp-completion-file-name-structure1
- tramp-completion-file-name-structure2
- tramp-completion-file-name-structure3
- tramp-completion-file-name-structure4
- tramp-completion-file-name-structure5
- tramp-completion-file-name-structure6)))))
+ (tramp-compat-seq-keep
+ (lambda (structure) (tramp-completion-dissect-file-name1 structure name))
+ (list
+ tramp-completion-file-name-structure1
+ tramp-completion-file-name-structure2
+ tramp-completion-file-name-structure3
+ tramp-completion-file-name-structure4
+ tramp-completion-file-name-structure5
+ tramp-completion-file-name-structure6))))
(defun tramp-completion-dissect-file-name1 (structure name)
"Return a `tramp-file-name' structure for NAME matching STRUCTURE.
@@ -3533,6 +3562,11 @@ on the same host. Otherwise, TARGET is quoted."
,@body)))
+(defcustom tramp-inhibit-errors-if-setting-file-attributes-fail nil
+ "Whether to warn only if `tramp-*-set-file-{modes,times,uid-gid}' fails."
+ :version "30.1"
+ :type 'boolean)
+
(defmacro tramp-skeleton-set-file-modes-times-uid-gid
(filename &rest body)
"Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'.
@@ -3548,7 +3582,11 @@ BODY is the backend specific code."
;; "file-writable-p".
'("file-directory-p" "file-exists-p" "file-symlinkp" "file-truename")
(tramp-flush-file-properties v localname))
- ,@body))
+ (condition-case err
+ (progn ,@body)
+ (error (if tramp-inhibit-errors-if-setting-file-attributes-fail
+ (display-warning 'tramp (error-message-string err))
+ (signal (car err) (cdr err)))))))
(defmacro tramp-skeleton-write-region
(start end filename append visit lockname mustbenew &rest body)
@@ -4536,7 +4574,7 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
(rx bos (group (+ nonl))
"@" (group (+ nonl))
"." (group (+ digit))
- (? ":" (+ digit)) eos)
+ (? ":" (? "-") (+ digit)) eos)
"The format of a lock file.")
(defun tramp-handle-file-locked-p (file)
@@ -4622,8 +4660,11 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
((process-live-p (tramp-get-process v)))
(lockname (tramp-compat-make-lock-file-name file)))
(delete-file lockname)
- ;; Trigger the unlock error.
- (signal 'file-error `("Cannot remove lock file for" ,file)))
+ ;; Trigger the unlock error. Be quiet if user isn't
+ ;; interested in lock files. See Bug#70900.
+ (unless (or (not create-lockfiles)
+ (bound-and-true-p remote-file-name-inhibit-locks))
+ (signal 'file-error `("Cannot remove lock file for" ,file))))
;; `userlock--handle-unlock-error' exists since Emacs 28.1. It
;; checks for `create-lockfiles' since Emacs 30.1, we don't need
;; this check here, then.
@@ -4739,10 +4780,10 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
vec "Method `%s' is not supported for multi-hops"
(tramp-file-name-method item)))))
- ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the
- ;; host name in their command template. In this case, the remote
- ;; file name must use either a local host name (first hop), or a
- ;; host name matching the previous hop.
+ ;; Some methods ("su", "sg", "sudo", "doas", "run0", "ksu") do not
+ ;; use the host name in their command template. In this case, the
+ ;; remote file name must use either a local host name (first hop),
+ ;; or a host name matching the previous hop.
(let ((previous-host (or tramp-local-host-regexp "")))
(setq choices target-alist)
(while (setq item (pop choices))
@@ -4806,15 +4847,42 @@ a connection-local variable."
(when (process-command proc)
(tramp-message vec 6 "%s" (string-join (process-command proc) " "))))
+(defvar tramp-direct-async-process nil
+ "Whether direct asynchronous processes should be used.
+It is not recommended to change this variable globally. Instead, it
+should be set conmnection-local.")
+
(defun tramp-direct-async-process-p (&rest args)
"Whether direct async `make-process' can be called."
(let ((v (tramp-dissect-file-name default-directory))
(buffer (plist-get args :buffer))
(stderr (plist-get args :stderr)))
+ ;; Since Tramp 2.7.1. In a future release, we'll ignore this
+ ;; connection property.
+ (when (and (not (tramp-compat-connection-local-p
+ tramp-direct-async-process))
+ (tramp-connection-property-p v "direct-async-process"))
+ (let ((msg (concat
+ "Connection property \"direct-async-process\" is deprecated, "
+ "use connection-local variable `tramp-direct-async-process'\n"
+ "See (info \"(tramp) Improving performance of "
+ "asynchronous remote processes\")")))
+ (if (tramp-get-connection-property
+ tramp-null-hop "direct-async-process-warned")
+ (tramp-message v 2 msg)
+ (tramp-set-connection-property
+ tramp-null-hop "direct-async-process-warned" t)
+ (tramp-warning v msg))))
+
(and ;; The method supports it.
(tramp-get-method-parameter v 'tramp-direct-async)
- ;; It has been indicated.
- (tramp-get-connection-property v "direct-async-process")
+ ;; It has been indicated. We don't use the global value of
+ ;; `tramp-direct-async-process'.
+ (or (and (tramp-compat-connection-local-p tramp-direct-async-process)
+ (tramp-compat-connection-local-value
+ tramp-direct-async-process))
+ ;; Deprecated setting.
+ (tramp-get-connection-property v "direct-async-process"))
;; There's no multi-hop.
(or (not (tramp-multi-hop-p v))
(null (cdr (tramp-compute-multi-hops v))))
@@ -4943,9 +5011,9 @@ a connection-local variable."
(string-join command) (tramp-get-remote-pipe-buf v)))
(signal 'error (cons "Command too long:" command)))
- ;; Replace `login-args' place holders. Split ControlMaster
- ;; options.
(setq
+ ;; Replace `login-args' place holders. Split ControlMaster
+ ;; options.
login-args
(append
(flatten-tree (tramp-get-method-parameter v 'tramp-async-args))
@@ -4957,11 +5025,13 @@ a connection-local variable."
?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 ""))))
+ ;; Suppress `internal-default-process-sentinel', which is
+ ;; set when :sentinel is nil. (Bug#71049)
p (make-process
:name name :buffer buffer
:command (append `(,login-program) login-args command)
:coding coding :noquery noquery :connection-type connection-type
- :sentinel sentinel :stderr stderr))
+ :sentinel (or sentinel #'ignore) :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.
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 4bf912e54c0..1f963ee8114 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -501,8 +501,8 @@ Otherwise, redisplay will reset the window's vscroll."
;;;###autoload
(defun pixel-scroll-precision-scroll-down-page (delta)
"Scroll the current window down by DELTA pixels.
-Note that this function doesn't work if DELTA is larger than
-the height of the current window."
+Note that this function doesn't work if DELTA is larger than or
+equal to the text height of the current window in pixels."
(let* ((desired-pos (posn-at-x-y 0 (+ delta
(window-tab-line-height)
(window-header-line-height))))
@@ -551,8 +551,7 @@ the height of the current window."
(defun pixel-scroll-precision-scroll-down (delta)
"Scroll the current window down by DELTA pixels."
- (let ((max-height (- (window-text-height nil t)
- (frame-char-height))))
+ (let ((max-height (1- (window-text-height nil t))))
(while (> delta max-height)
(pixel-scroll-precision-scroll-down-page max-height)
(setq delta (- delta max-height)))
@@ -666,8 +665,7 @@ to `pixel-scroll-precision-interpolation-factor'."
(defun pixel-scroll-precision-scroll-up (delta)
"Scroll the current window up by DELTA pixels."
- (let ((max-height (- (window-text-height nil t)
- (frame-char-height))))
+ (let ((max-height (window-text-height nil t)))
(when (> max-height 0)
(while (> delta max-height)
(pixel-scroll-precision-scroll-up-page max-height)
diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el
index 79ddc4fc929..fa07fe3b09c 100644
--- a/lisp/play/doctor.el
+++ b/lisp/play/doctor.el
@@ -587,6 +587,8 @@ reads the sentence before point, and prints the Doctor's
answer."
(doctor-put-meaning vms 'mach)
(doctor-put-meaning ibm 'mach)
(doctor-put-meaning pc 'mach)
+(doctor-put-meaning gnu 'mach)
+(doctor-put-meaning linux 'mach)
(doctor-put-meaning bitching 'foul)
(doctor-put-meaning shit 'foul)
(doctor-put-meaning bastard 'foul)
@@ -624,6 +626,8 @@ reads the sentence before point, and prints the Doctor's
answer."
(doctor-put-meaning cocaine 'drug)
(doctor-put-meaning uppers 'drug)
(doctor-put-meaning downers 'drug)
+(doctor-put-meaning opium 'drug)
+(doctor-put-meaning valium 'drug)
(doctor-put-meaning loves 'loves)
(doctor-put-meaning love 'love)
(doctor-put-meaning loved 'love)
@@ -653,6 +657,8 @@ reads the sentence before point, and prints the Doctor's
answer."
(doctor-put-meaning likes 'desire)
(doctor-put-meaning needs 'desire)
(doctor-put-meaning need 'desire)
+(doctor-put-meaning crave 'desire)
+(doctor-put-meaning craves 'desires)
(doctor-put-meaning frustrated 'mood)
(doctor-put-meaning depressed 'mood)
(doctor-put-meaning annoyed 'mood)
@@ -670,6 +676,9 @@ reads the sentence before point, and prints the Doctor's
answer."
(doctor-put-meaning fear 'fear)
(doctor-put-meaning scared 'fear)
(doctor-put-meaning frightened 'fear)
+(doctor-put-meaning panic 'fear)
+(doctor-put-meaning phobia 'fear)
+(doctor-put-meaning phobias 'fear)
(doctor-put-meaning virginity 'sexnoun)
(doctor-put-meaning virgins 'sexnoun)
(doctor-put-meaning virgin 'sexnoun)
@@ -699,6 +708,11 @@ reads the sentence before point, and prints the Doctor's
answer."
(doctor-put-meaning grandfather 'family)
(doctor-put-meaning maternal 'family)
(doctor-put-meaning paternal 'family)
+(doctor-put-meaning cousin 'family)
+(doctor-put-meaning aunt 'family)
+(doctor-put-meaning uncle 'family)
+(doctor-put-meaning niece 'family)
+(doctor-put-meaning nephew 'family)
(doctor-put-meaning stab 'death)
(doctor-put-meaning murder 'death)
(doctor-put-meaning murders 'death)
@@ -728,6 +742,8 @@ reads the sentence before point, and prints the Doctor's
answer."
(doctor-put-meaning barf 'symptoms)
(doctor-put-meaning toothache 'symptoms)
(doctor-put-meaning hurt 'symptoms)
+(doctor-put-meaning nausea 'symptoms)
+(doctor-put-meaning cough 'symptoms)
(doctor-put-meaning rum 'alcohol)
(doctor-put-meaning gin 'alcohol)
(doctor-put-meaning vodka 'alcohol)
@@ -737,6 +753,8 @@ reads the sentence before point, and prints the Doctor's
answer."
(doctor-put-meaning wine 'alcohol)
(doctor-put-meaning whiskey 'alcohol)
(doctor-put-meaning scotch 'alcohol)
+(doctor-put-meaning tequila 'alcohol)
+(doctor-put-meaning martini 'alcohol)
(doctor-put-meaning fuck 'sexverb)
(doctor-put-meaning fucked 'sexverb)
(doctor-put-meaning screw 'sexverb)
@@ -778,6 +796,9 @@ reads the sentence before point, and prints the Doctor's
answer."
(doctor-put-meaning profs 'school)
(doctor-put-meaning professors 'school)
(doctor-put-meaning mit 'school)
+(doctor-put-meaning university 'school)
+(doctor-put-meaning college 'school)
+(doctor-put-meaning homework 'school)
(doctor-put-meaning emacs 'eliza)
(doctor-put-meaning eliza 'eliza)
(doctor-put-meaning liza 'eliza)
@@ -815,6 +836,7 @@ reads the sentence before point, and prints the Doctor's
answer."
(doctor-put-meaning geometric 'math)
(doctor-put-meaning calculus 'math)
(doctor-put-meaning arithmetic 'math)
+(doctor-put-meaning topology 'math)
(doctor-put-meaning zippy 'zippy)
(doctor-put-meaning zippy 'zippy)
(doctor-put-meaning pinhead 'zippy)
@@ -1522,7 +1544,7 @@ Hack on previous word, setting global variable
DOCTOR-OWNER to correct result."
(defun doctor-symptoms ()
(doctor-type '((doc$ doctor--maybe) you should consult a medical doctor\;
- i am a psychotherapist. \.)))
+ i am a psychotherapist \.)))
(defun doctor-hates ()
(doctor-svo doctor-sent doctor-found 1 t)
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 4e02cd1d890..eb72f128c07 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -275,10 +275,7 @@ Optional argument MODE means only check for the specified
mode (cpu or mem)."
(define-hash-table-test 'profiler-function-equal #'function-equal
- (lambda (f) (cond
- ((byte-code-function-p f) (aref f 1))
- ((eq (car-safe f) 'closure) (cddr f))
- (t f))))
+ (lambda (f) (if (closurep f) (aref f 1) f)))
(defun profiler-calltree-build-unified (tree log)
;; Let's try to unify all those partial backtraces into a single
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 977a3d72cb7..4a691e5bf67 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -196,7 +196,10 @@ subexpression 10."
(funcall bug-reference-url-format)))))))
;; Delete remaining but unused overlays.
(dolist (ov overlays)
- (delete-overlay ov)))))
+ (delete-overlay ov))
+ ;; Signal the bounds we actually fontified to jit-lock to allow for
+ ;; optimizations (bug#70796).
+ `(jit-lock-bounds ,beg-line . ,end-line))))
;; Taken from button.el.
(defun bug-reference-push-button (&optional pos _use-mouse-action)
@@ -658,19 +661,39 @@ have been run, the auto-setup is inhibited.")
(defun bug-reference--url-at-point ()
"`thing-at-point' provider function."
- (get-char-property (point) 'bug-reference-url))
+ (thing-at-point-for-char-property 'bug-reference-url))
+
+(defun bug-reference--forward-url (backward)
+ "`forward-thing' provider function."
+ (forward-thing-for-char-property 'bug-reference-url backward))
+
+(defun bug-reference--bounds-of-url-at-point ()
+ "`bounds-of-thing-at-point' provider function."
+ (bounds-of-thing-at-point-for-char-property 'bug-reference-url))
(defun bug-reference--init (enable)
(if enable
(progn
(jit-lock-register #'bug-reference-fontify)
(setq-local thing-at-point-provider-alist
- (append thing-at-point-provider-alist
- '((url . bug-reference--url-at-point)))))
+ (cons '(url . bug-reference--url-at-point)
+ thing-at-point-provider-alist))
+ (setq-local forward-thing-provider-alist
+ (cons '(url . bug-reference--forward-url)
+ forward-thing-provider-alist))
+ (setq-local bounds-of-thing-at-point-provider-alist
+ (cons '(url . bug-reference--bounds-of-url-at-point)
+ bounds-of-thing-at-point-provider-alist)))
(jit-lock-unregister #'bug-reference-fontify)
(setq thing-at-point-provider-alist
(delete '((url . bug-reference--url-at-point))
thing-at-point-provider-alist))
+ (setq forward-thing-provider-alist
+ (delete '((url . bug-reference--forward-url))
+ forward-thing-provider-alist))
+ (setq bounds-of-thing-at-point-provider-alist
+ (delete '((url . bug-reference--bounds-of-url-at-point))
+ bounds-of-thing-at-point-provider-alist))
(save-restriction
(widen)
(bug-reference-unfontify (point-min) (point-max)))))
diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el
index e48bcc64f14..b1520db22e9 100644
--- a/lisp/progmodes/c-ts-common.el
+++ b/lisp/progmodes/c-ts-common.el
@@ -123,9 +123,16 @@ ARG is passed to `fill-paragraph'."
(let ((node (treesit-node-at (point))))
(when (string-match-p c-ts-common--comment-regexp
(treesit-node-type node))
- (if (save-excursion
- (goto-char (treesit-node-start node))
- (looking-at "//"))
+ (if (or (save-excursion
+ (goto-char (treesit-node-start node))
+ (looking-at "//"))
+ ;; In rust, NODE will be the body of a comment, and the
+ ;; parent will be the whole comment.
+ (if-let ((start (treesit-node-start
+ (treesit-node-parent node))))
+ (save-excursion
+ (goto-char start)
+ (looking-at "//"))))
(fill-comment-paragraph arg)
(c-ts-common--fill-block-comment arg)))
;; Return t so `fill-paragraph' doesn't attempt to fill by
@@ -221,7 +228,9 @@ Set up:
- `adaptive-fill-first-line-regexp'
- `paragraph-start'
- `paragraph-separate'
- - `fill-paragraph-function'"
+ - `fill-paragraph-function'
+ - `comment-line-break-function'
+ - `comment-multi-line'"
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
@@ -267,7 +276,66 @@ Set up:
eol)
"\f")))
(setq-local paragraph-separate paragraph-start)
- (setq-local fill-paragraph-function #'c-ts-common--fill-paragraph))
+ (setq-local fill-paragraph-function #'c-ts-common--fill-paragraph)
+
+ (setq-local comment-line-break-function
+ #'c-ts-common-comment-indent-new-line)
+ (setq-local comment-multi-line t))
+
+(defun c-ts-common-comment-indent-new-line (&optional soft)
+ "Break line at point and indent, continuing comment if within one.
+
+This is like `comment-indent-new-line', but specialized for C-style //
+and /* */ comments. SOFT works the same as in
+`comment-indent-new-line'."
+ ;; I want to experiment with explicitly listing out all each cases and
+ ;; handle them separately, as opposed to fiddling with `comment-start'
+ ;; and friends. This will have more duplicate code and will be less
+ ;; generic, but in the same time might save us from writting cryptic
+ ;; code to handle all sorts of edge cases.
+ ;;
+ ;; For this command, let's try to make it basic: if the current line
+ ;; is a // comment, insert a newline and a // prefix; if the current
+ ;; line is in a /* comment, insert a newline and a * prefix. No
+ ;; auto-fill or other smart features.
+ (cond
+ ;; Line starts with //, or ///, or ////...
+ ;; Or //! (used in rust).
+ ((save-excursion
+ (beginning-of-line)
+ (looking-at (rx "//" (group (* (any "/!")) (* " ")))))
+ (let ((whitespaces (match-string 1)))
+ (if soft (insert-and-inherit ?\n) (newline 1))
+ (delete-region (line-beginning-position) (point))
+ (insert "//" whitespaces)))
+
+ ;; Line starts with /* or /**.
+ ((save-excursion
+ (beginning-of-line)
+ (looking-at (rx "/*" (group (? "*") (* " ")))))
+ (let ((whitespace-and-star-len (length (match-string 1))))
+ (if soft (insert-and-inherit ?\n) (newline 1))
+ (delete-region (line-beginning-position) (point))
+ (insert " *" (make-string whitespace-and-star-len ?\s))))
+
+ ;; Line starts with *.
+ ((save-excursion
+ (beginning-of-line)
+ (looking-at (rx (group (* " ") (any "*|") (* " ")))))
+ (let ((prefix (match-string 1)))
+ (if soft (insert-and-inherit ?\n) (newline 1))
+ (delete-region (line-beginning-position) (point))
+ (insert prefix)))
+
+ ;; Line starts with whitespaces or no space. This is basically the
+ ;; default case since (rx (* " ")) matches anything.
+ ((save-excursion
+ (beginning-of-line)
+ (looking-at (rx (* " "))))
+ (let ((whitespaces (match-string 0)))
+ (if soft (insert-and-inherit ?\n) (newline 1))
+ (delete-region (line-beginning-position) (point))
+ (insert whitespaces)))))
;;; Statement indent
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el
index a1b2b1f500c..f453392ff7f 100644
--- a/lisp/progmodes/c-ts-mode.el
+++ b/lisp/progmodes/c-ts-mode.el
@@ -597,8 +597,9 @@ MODE is either `c' or `cpp'."
(treesit-font-lock-rules
:language mode
:feature 'comment
- `((comment) @font-lock-comment-face
- (comment) @contextual)
+ `(((comment) @font-lock-doc-face
+ (:match ,(rx bos "/**") @font-lock-doc-face))
+ (comment) @font-lock-comment-face)
:language mode
:feature 'preprocessor
@@ -616,8 +617,11 @@ MODE is either `c' or `cpp'."
(preproc_params
(identifier) @font-lock-variable-name-face)
- (preproc_defined) @font-lock-preprocessor-face
- (preproc_defined (identifier) @font-lock-variable-name-face)
+ (preproc_defined
+ "defined" @font-lock-preprocessor-face
+ "(" @font-lock-preprocessor-face
+ (identifier) @font-lock-variable-name-face
+ ")" @font-lock-preprocessor-face)
[,@c-ts-mode--preproc-keywords] @font-lock-preprocessor-face)
:language mode
@@ -659,9 +663,11 @@ MODE is either `c' or `cpp'."
'((type_qualifier) @font-lock-type-face
(qualified_identifier
- scope: (namespace_identifier) @font-lock-type-face)
+ scope: (namespace_identifier) @font-lock-constant-face)
- (operator_cast) type: (type_identifier) @font-lock-type-face))
+ (operator_cast) type: (type_identifier) @font-lock-type-face
+
+ (namespace_identifier) @font-lock-constant-face))
[,@c-ts-mode--type-keywords] @font-lock-type-face)
:language mode
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 8c505e9556a..0b50844732f 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -7146,7 +7146,7 @@ comment at the start of cc-engine.el for more info."
;; FIXME!!! This routine ignores the possibility of macros entirely.
;; 2010-01-29.
- (when (> end beg)
+ (when (or old-len (> end beg))
;; Extend the region (BEG END) to deal with any complicating literals.
(let* ((lit-search-beg (if (memq (char-before beg) '(?/ ?*))
(1- beg) beg))
@@ -7220,7 +7220,8 @@ comment at the start of cc-engine.el for more info."
(c-put-char-properties beg end 'syntax-table '(1))
;; If an open string's opener has just been neutralized,
;; do the same to the terminating LF.
- (when (and end-literal-end
+ (when (and (> end beg)
+ end-literal-end
(eq (char-before end-literal-end) ?\n)
(equal (c-get-char-property
(1- end-literal-end) 'syntax-table)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index b18eb81fee1..2e4eb11811a 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -224,6 +224,13 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
\\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning\\(?:
[0-9]+\\)?:\\)?\\)"
2 (3 . 4) (5 . 6) (7))
+ (cargo
+ "\\(?:\\(?4:error\\)\\|\\(?5:warning\\)\\):[^\0]+?-->
\\(?1:[^:]+\\):\\(?2:[[:digit:]]+\\):\\(?3:[[:digit:]]+\\)"
+ 1 2 3 (5)
+ nil
+ (5 compilation-warning-face)
+ (4 compilation-error-face))
+
(cmake
"^CMake \\(?:Error\\|\\(Warning\\)\\) at \\(.*\\):\\([1-9][0-9]*\\)
([^)]+):$"
2 3 nil (1))
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 11709bfe00b..cbc23507fca 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1178,7 +1178,12 @@ The expansion is entirely correct because it uses the C
preprocessor."
(eval-and-compile
(defconst cperl--basic-identifier-rx
- '(sequence (or alpha "_") (* (or word "_")))
+ ;; The rx expression in the following line is a workaround for
+ ;; bug#70948 under Emacs 29
+ '(regex "[_[:alpha:]][_[:word:]]*")
+ ;; The rx expression in the following line is equivalent but
+ ;; inefficient under Emacs 29.3
+ ;; '(sequence (or alpha "_") (* (or word "_")))
"A regular expression for the name of a \"basic\" Perl variable.
Neither namespace separators nor sigils are included. As is,
this regular expression applies to labels,subroutine calls where
@@ -1934,7 +1939,8 @@ 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))
+(when (fboundp 'derived-mode-add-parents) ; to run under Emacs <30
+ (derived-mode-add-parents 'cperl-mode '(perl-mode)))
(defun cperl--set-file-style ()
(when cperl-file-style
diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el
index 10ac73d9691..29325ab9632 100644
--- a/lisp/progmodes/csharp-mode.el
+++ b/lisp/progmodes/csharp-mode.el
@@ -689,7 +689,9 @@ compilation and evaluation time conflicts."
((parent-is "binary_expression") parent 0)
((parent-is "block") parent-bol csharp-ts-mode-indent-offset)
((parent-is "local_function_statement") parent-bol 0)
- ((parent-is "if_statement") parent-bol 0)
+ ((match "block" "if_statement") parent-bol 0)
+ ((match "else" "if_statement") parent-bol 0)
+ ((parent-is "if_statement") parent-bol csharp-ts-mode-indent-offset)
((parent-is "for_statement") parent-bol 0)
((parent-is "for_each_statement") parent-bol 0)
((parent-is "while_statement") parent-bol 0)
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index c395efd9f55..94b45abe1d8 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -7,7 +7,7 @@
;; 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.24") (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") (compat "27.1") (eldoc "1.14.0")
(external-completion "0.1") (flymake "1.2.1") (jsonrpc "1.0.24") (project
"0.9.8") (seq "2.23") (track-changes "1.2") (xref "1.6.2"))
;; This is a GNU ELPA :core package. Avoid adding functionality
;; that is not available in the version of Emacs recorded above or any
@@ -103,14 +103,13 @@
(require 'pcase)
(require 'compile) ; for some faces
(require 'warnings)
-(eval-when-compile
- (require 'subr-x))
(require 'filenotify)
(require 'ert)
(require 'text-property-search nil t)
(require 'diff-mode)
(require 'diff)
-(require 'track-changes nil t)
+(require 'track-changes)
+(require 'compat)
;; These dependencies are also GNU ELPA core packages. Because of
;; bug#62576, since there is a risk that M-x package-install, despite
@@ -134,6 +133,10 @@
;; the loaded file is not the one that should have been loaded.
(mapc reload '(project flymake xref jsonrpc external-completion))))
+;; Keep the eval-when-compile requires at the end, in case it's already been
+;; required unconditionally by some earlier `require'.
+(eval-when-compile (require 'subr-x))
+
;; forward-declare, but don't require (Emacs 28 doesn't seem to care)
(defvar markdown-fontify-code-blocks-natively)
(defvar company-backends)
@@ -190,8 +193,8 @@ path of the PROGRAM that was chosen (interactively or
automatically)."
(lambda (&optional interactive _project)
;; JT@2021-06-13: This function is way more complicated than it
- ;; could be because it accounts for the fact that
- ;; `eglot--executable-find' may take much longer to execute on
+ ;; could be because it accounts for the fact that Compat's
+ ;; `executable-find' may take much longer to execute on
;; remote files.
(let* ((listified (cl-loop for a in alternatives
collect (if (listp a) a (list a))))
@@ -203,7 +206,7 @@ automatically)."
nil)
(interactive
(let* ((augmented (mapcar (lambda (a)
- (let ((found (eglot--executable-find
+ (let ((found (compat-call
executable-find
(car a) t)))
(and found
(cons (car a) (cons found (cdr
a))))))
@@ -223,7 +226,7 @@ automatically)."
nil))))
(t
(cl-loop for (p . args) in listified
- for probe = (eglot--executable-find p t)
+ for probe = (compat-call executable-find p t)
when probe return (cons probe args)
finally (funcall err)))))))
@@ -242,7 +245,7 @@ automatically)."
'("pylsp" "pyls" ("basedpyright-langserver" "--stdio")
("pyright-langserver" "--stdio")
"jedi-language-server" "ruff-lsp")))
- ((js-json-mode json-mode json-ts-mode)
+ ((js-json-mode json-mode json-ts-mode jsonc-mode)
. ,(eglot-alternatives '(("vscode-json-language-server" "--stdio")
("vscode-json-languageserver" "--stdio")
("json-languageserver" "--stdio"))))
@@ -302,6 +305,7 @@ automatically)."
(futhark-mode . ("futhark" "lsp"))
((lua-mode lua-ts-mode) . ,(eglot-alternatives
'("lua-language-server" "lua-lsp")))
+ (yang-mode . ("yang-language-server"))
(zig-mode . ("zls"))
((css-mode css-ts-mode)
. ,(eglot-alternatives '(("vscode-css-language-server" "--stdio")
@@ -328,7 +332,8 @@ automatically)."
((uiua-ts-mode uiua-mode) . ("uiua" "lsp"))
(sml-mode
. ,(lambda (_interactive project)
- (list "millet-ls" (project-root project)))))
+ (list "millet-ls" (project-root project))))
+ ((blueprint-mode blueprint-ts-mode) . ("blueprint-compiler" "lsp")))
"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
@@ -563,13 +568,6 @@ This can be useful when using docker to run a language
server.")
;;; Constants
;;;
-(defconst eglot--version
- (eval-when-compile
- (when byte-compile-current-file
- (require 'lisp-mnt)
- (lm-version byte-compile-current-file)))
- "The version as a string of this version of Eglot.
-It is nil if Eglot is not byte-complied.")
(defconst eglot--symbol-kind-names
`((1 . "File") (2 . "Module")
@@ -599,11 +597,6 @@ It is nil if Eglot is not byte-complied.")
(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."
- (if (>= emacs-major-version 27) (executable-find command remote)
- (executable-find command)))
-
(defun eglot--accepted-formats ()
(if (and (not eglot-prefer-plaintext) (fboundp 'gfm-view-mode))
["markdown" "plaintext"] ["plaintext"]))
@@ -1057,8 +1050,8 @@ ACTION is an LSP object of either `CodeAction' or
`Command' type."
:documentation "Map (DIR -> (WATCH ID1 ID2...)) for
`didChangeWatchedFiles'."
:initform (make-hash-table :test #'equal) :accessor eglot--file-watches)
(managed-buffers
- :documentation "Map (PATH -> BUFFER) for buffers managed by server."
- :initform (make-hash-table :test #'equal)
+ :initform nil
+ :documentation "List of buffers managed by server."
:accessor eglot--managed-buffers)
(saved-initargs
:documentation "Saved initargs for reconnection purposes."
@@ -1087,26 +1080,32 @@ ACTION is an LSP object of either `CodeAction' or
`Command' type."
(concat remote-prefix normalized))
uri)))
-(defun eglot-path-to-uri (path)
- "Convert PATH, a file name, to LSP URI string and return it."
- (let ((expanded-path (expand-file-name path)))
+(cl-defun eglot-path-to-uri (path &key truenamep)
+ "Convert PATH, a file name, to LSP URI string and return it.
+TRUENAMEP indicated PATH is already a truename."
+ ;; LSP servers should not be expected to access the filesystem, and
+ ;; therefore are generally oblivious that some filenames are
+ ;; different, but point to the same file, like a symlink and its
+ ;; target. Make sure we hand the server the true name of a file by
+ ;; calling file-truename.
+ (let ((truepath (if truenamep path (file-truename path))))
(if (and (url-type (url-generic-parse-url path))
- ;; It might be MS Windows path which includes a drive
- ;; letter that looks like a URL scheme (bug#59338)
+ ;; PATH might be MS Windows file name which includes a
+ ;; drive letter that looks like a URL scheme (bug#59338).
(not (and (eq system-type 'windows-nt)
- (file-name-absolute-p expanded-path))))
- ;; Path is already a URI, so forward it to the LSP server
+ (file-name-absolute-p truepath))))
+ ;; PATH is already a URI, so forward it to the LSP server
;; untouched. The server should be able to handle it, since
;; it provided this URI to clients in the first place.
path
(concat "file://"
;; Add a leading "/" for local MS Windows-style paths.
(if (and (eq system-type 'windows-nt)
- (not (file-remote-p expanded-path)))
+ (not (file-remote-p truepath)))
"/")
(url-hexify-string
;; Again watch out for trampy paths.
- (directory-file-name (file-local-name expanded-path))
+ (directory-file-name (file-local-name truepath))
eglot--uri-path-allowed-chars)))))
(defun eglot-range-region (range &optional markers)
@@ -1191,7 +1190,7 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see."
(defun eglot--on-shutdown (server)
"Called by jsonrpc.el when SERVER is already dead."
;; Turn off `eglot--managed-mode' where appropriate.
- (dolist (buffer (map-values (eglot--managed-buffers server)))
+ (dolist (buffer (eglot--managed-buffers server))
(let (;; Avoid duplicate shutdowns (github#389)
(eglot-autoshutdown nil))
(eglot--when-live-buffer buffer (eglot--managed-mode-off))))
@@ -1317,7 +1316,7 @@ be guessed."
main-mode base-prompt))
((and program
(not (file-name-absolute-p program))
- (not (eglot--executable-find program t)))
+ (not (compat-call executable-find program t)))
(if full-program-invocation
(concat (format "[eglot] I guess you want to run
`%s'"
full-program-invocation)
@@ -1603,8 +1602,10 @@ This docstring appeases checkdoc, that's all."
'network))
(emacs-pid))
:clientInfo
- `(:name "Eglot" ,@(when eglot--version
- `(:version ,eglot--version)))
+ (append
+ '(:name "Eglot")
+ (let ((v (package-get-version)))
+ (and v (list :version v))))
;; Maybe turn trampy `/ssh:foo@bar:/path/to/baz.py'
;; into `/path/to/baz.py', so LSP groks it.
:rootPath (file-local-name
@@ -1874,10 +1875,9 @@ Doubles as an indicator of snippet support."
(font-lock-ensure)
(goto-char (point-min))
(let ((inhibit-read-only t))
- (when (fboundp 'text-property-search-forward) ;; FIXME: use compat
- (while (setq match (text-property-search-forward 'invisible))
- (delete-region (prop-match-beginning match)
- (prop-match-end match)))))
+ (while (setq match (text-property-search-forward 'invisible))
+ (delete-region (prop-match-beginning match)
+ (prop-match-end match))))
(string-trim (buffer-string))))))
(defun eglot--read-server (prompt &optional dont-if-just-the-one)
@@ -1975,7 +1975,7 @@ Use `eglot-managed-p' to determine if current buffer is
managed.")
(define-minor-mode eglot--managed-mode
"Mode for source buffers managed by some Eglot project."
- :init-value nil :lighter nil :keymap eglot-mode-map
+ :init-value nil :lighter nil :keymap eglot-mode-map :interactive nil
(cond
(eglot--managed-mode
(pcase (plist-get (eglot--capabilities (eglot-current-server))
@@ -1986,13 +1986,10 @@ Use `eglot-managed-p' to determine if current buffer is
managed.")
("utf-8"
(eglot--setq-saving eglot-current-linepos-function
#'eglot-utf-8-linepos)
(eglot--setq-saving eglot-move-to-linepos-function
#'eglot-move-to-utf-8-linepos)))
- (if (fboundp 'track-changes-register)
- (unless eglot--track-changes
- (setq eglot--track-changes
- (track-changes-register
- #'eglot--track-changes-signal :disjoint t)))
- (add-hook 'after-change-functions #'eglot--after-change nil t)
- (add-hook 'before-change-functions #'eglot--before-change nil t))
+ (unless eglot--track-changes
+ (setq eglot--track-changes
+ (track-changes-register
+ #'eglot--track-changes-signal :disjoint t)))
(add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t)
;; Prepend "didClose" to the hook after the "nonoff", so it will run first
(add-hook 'kill-buffer-hook #'eglot--signal-textDocument/didClose nil t)
@@ -2024,17 +2021,8 @@ Use `eglot-managed-p' to determine if current buffer is
managed.")
(add-hook 'eldoc-documentation-functions #'eglot-signature-eldoc-function
nil t)
(eldoc-mode 1))
-
- (let ((buffer (current-buffer)))
- (puthash (expand-file-name (buffer-file-name buffer))
- buffer
- (eglot--managed-buffers (eglot-current-server)))))
+ (cl-pushnew (current-buffer) (eglot--managed-buffers
(eglot-current-server))))
(t
- (when eglot--track-changes
- (track-changes-unregister eglot--track-changes)
- (setq eglot--track-changes nil))
- (remove-hook 'after-change-functions #'eglot--after-change t)
- (remove-hook 'before-change-functions #'eglot--before-change t)
(remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t)
(remove-hook 'kill-buffer-hook #'eglot--signal-textDocument/didClose t)
(remove-hook 'before-revert-hook #'eglot--signal-textDocument/didClose t)
@@ -2059,11 +2047,14 @@ Use `eglot-managed-p' to determine if current buffer is
managed.")
(let ((server eglot--cached-server))
(setq eglot--cached-server nil)
(when server
- (remhash (expand-file-name (buffer-file-name (current-buffer)))
- (eglot--managed-buffers server))
+ (setf (eglot--managed-buffers server)
+ (delq (current-buffer) (eglot--managed-buffers server)))
(when (and eglot-autoshutdown
- (null (map-values (eglot--managed-buffers server))))
- (eglot-shutdown server)))))))
+ (null (eglot--managed-buffers server)))
+ (eglot-shutdown server))))
+ (when eglot--track-changes
+ (track-changes-unregister eglot--track-changes)
+ (setq eglot--track-changes nil)))))
(defun eglot--managed-mode-off ()
"Turn off `eglot--managed-mode' unconditionally."
@@ -2384,6 +2375,12 @@ still unanswered LSP requests to the server\n")))
(lambda ()
(remhash token (eglot--progress-reporters
server))))))))))
+(defvar-local eglot--TextDocumentIdentifier-cache nil
+ "LSP TextDocumentIdentifier-related cached info for current buffer.
+Value is (TRUENAME . (:uri STR)), where STR is what is sent to the
+server on textDocument/didOpen and similar calls. TRUENAME is the
+expensive cached value of `file-truename'.")
+
(cl-defmethod eglot-handle-notification
(server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics
&allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode'
@@ -2394,9 +2391,17 @@ still unanswered LSP requests to the server\n")))
((= sev 2) 'eglot-warning)
(t 'eglot-note)))
(mess (source code message)
- (concat source (and code (format " [%s]" code)) ": " message)))
+ (concat source (and code (format " [%s]" code)) ": " message))
+ (find-it (abspath)
+ ;; `find-buffer-visiting' would be natural, but calls the
+ ;; potentially slow `file-truename' (bug#70036).
+ (cl-loop for b in (eglot--managed-buffers server)
+ when (with-current-buffer b
+ (equal (car eglot--TextDocumentIdentifier-cache)
+ abspath))
+ return b)))
(if-let* ((path (expand-file-name (eglot-uri-to-path uri)))
- (buffer (gethash path (eglot--managed-buffers server))))
+ (buffer (find-it path)))
(with-current-buffer buffer
(cl-loop
initially
@@ -2522,11 +2527,16 @@ THINGS are either registrations or unregisterations
(sic)."
`(:success ,success)))
(defun eglot--TextDocumentIdentifier ()
- "Compute TextDocumentIdentifier object for current buffer."
- `(:uri ,(eglot-path-to-uri (or buffer-file-name
- (ignore-errors
- (buffer-file-name
- (buffer-base-buffer)))))))
+ "Compute TextDocumentIdentifier object for current buffer.
+Sets `eglot--TextDocumentIdentifier-uri' (which see) as a side effect."
+ (unless eglot--TextDocumentIdentifier-cache
+ (let ((truename (file-truename (or buffer-file-name
+ (ignore-errors
+ (buffer-file-name
+ (buffer-base-buffer)))))))
+ (setq eglot--TextDocumentIdentifier-cache
+ `(,truename . (:uri ,(eglot-path-to-uri truename :truenamep t))))))
+ (cdr eglot--TextDocumentIdentifier-cache))
(defvar-local eglot--versioned-identifier 0)
@@ -2595,7 +2605,7 @@ buffer."
`(:triggerKind 2 :triggerCharacter ,trigger) `(:triggerKind 1)))))
(defvar-local eglot--recent-changes nil
- "Recent buffer changes as collected by `eglot--before-change'.")
+ "Recent buffer changes as collected by `eglot--track-changes-fetch'.")
(cl-defmethod jsonrpc-connection-ready-p ((_server eglot-lsp-server) _what)
"Tell if SERVER is ready for WHAT in current buffer."
@@ -2603,59 +2613,14 @@ buffer."
(defvar-local eglot--change-idle-timer nil "Idle timer for didChange signals.")
-(defun eglot--before-change (beg end)
- "Hook onto `before-change-functions' with BEG and END."
- (when (listp eglot--recent-changes)
- ;; Records BEG and END, crucially convert them into LSP
- ;; (line/char) positions before that information is lost (because
- ;; the after-change thingy doesn't know if newlines were
- ;; deleted/added). Also record markers of BEG and END
- ;; (github#259)
- (push `(,(eglot--pos-to-lsp-position beg)
- ,(eglot--pos-to-lsp-position end)
- (,beg . ,(copy-marker beg nil))
- (,end . ,(copy-marker end t)))
- eglot--recent-changes)))
-
(defvar eglot--document-changed-hook '(eglot--signal-textDocument/didChange)
"Internal hook for doing things when the document changes.")
-(defun eglot--after-change (beg end pre-change-length)
- "Hook onto `after-change-functions'.
-Records BEG, END and PRE-CHANGE-LENGTH locally."
- (pcase (car-safe eglot--recent-changes)
- (`(,lsp-beg ,lsp-end
- (,b-beg . ,b-beg-marker)
- (,b-end . ,b-end-marker))
- ;; github#259 and github#367: with `capitalize-word' & friends,
- ;; `before-change-functions' records the whole word's `b-beg' and
- ;; `b-end'. Similarly, when `fill-paragraph' coalesces two
- ;; lines, `b-beg' and `b-end' mark end of first line and end of
- ;; second line, resp. In both situations, `beg' and `end'
- ;; received here seemingly contradict that: they will differ by 1
- ;; and encompass the capitalized character or, in the coalescing
- ;; case, the replacement of the newline with a space. We keep
- ;; both markers and positions to detect and correct this. In
- ;; this specific case, we ignore `beg', `len' and
- ;; `pre-change-len' and send richer information about the region
- ;; from the markers. I've also experimented with doing this
- ;; unconditionally but it seems to break when newlines are added.
- (if (and (= b-end b-end-marker) (= b-beg b-beg-marker)
- (or (/= beg b-beg) (/= end b-end)))
- (setcar eglot--recent-changes
- `(,lsp-beg ,lsp-end ,(- b-end-marker b-beg-marker)
- ,(buffer-substring-no-properties b-beg-marker
- b-end-marker)))
- (setcar eglot--recent-changes
- `(,lsp-beg ,lsp-end ,pre-change-length
- ,(buffer-substring-no-properties beg end)))))
- (_ (setf eglot--recent-changes :emacs-messup)))
- (eglot--track-changes-signal nil))
-
(defun eglot--track-changes-fetch (id)
(if (eq eglot--recent-changes :pending) (setq eglot--recent-changes nil))
(track-changes-fetch
id (lambda (beg end before)
+ (cl-incf eglot--versioned-identifier)
(cond
((eq eglot--recent-changes :emacs-messup) nil)
((eq before 'error) (setf eglot--recent-changes :emacs-messup))
@@ -2665,8 +2630,16 @@ Records BEG, END and PRE-CHANGE-LENGTH locally."
,(buffer-substring-no-properties beg end))
eglot--recent-changes))))))
+(defun eglot--add-one-shot-hook (hook function &optional append local)
+ "Like `add-hook' but calls FUNCTION only once."
+ (let* ((fname (make-symbol (format "eglot--%s-once" function)))
+ (fun (lambda (&rest args)
+ (remove-hook hook fname local)
+ (apply function args))))
+ (fset fname fun)
+ (add-hook hook fname append local)))
+
(defun eglot--track-changes-signal (id &optional distance)
- (cl-incf eglot--versioned-identifier)
(cond
(distance
;; When distance is <100, we may as well coalesce the changes.
@@ -2676,14 +2649,23 @@ Records BEG, END and PRE-CHANGE-LENGTH locally."
;; who check it as a boolean.
(t (setq eglot--recent-changes :pending)))
(when eglot--change-idle-timer (cancel-timer eglot--change-idle-timer))
- (let ((buf (current-buffer)))
- (setq eglot--change-idle-timer
- (run-with-idle-timer
- eglot-send-changes-idle-time
- nil (lambda () (eglot--when-live-buffer buf
- (when eglot--managed-mode
- (run-hooks 'eglot--document-changed-hook)
- (setq eglot--change-idle-timer nil))))))))
+ (setq eglot--change-idle-timer
+ (run-with-idle-timer
+ eglot-send-changes-idle-time nil
+ (lambda (buf)
+ (eglot--when-live-buffer buf
+ (when eglot--managed-mode
+ (if (track-changes-inconsistent-state-p)
+ ;; Not a good time (e.g. in the middle of Quail thingy,
+ ;; bug#70541): reschedule for the next idle period.
+ (eglot--add-one-shot-hook
+ 'post-command-hook
+ (lambda ()
+ (eglot--when-live-buffer buf
+ (eglot--track-changes-signal id))))
+ (run-hooks 'eglot--document-changed-hook)
+ (setq eglot--change-idle-timer nil)))))
+ (current-buffer))))
(defvar-local eglot-workspace-configuration ()
"Configure LSP servers specifically for a given project.
@@ -2787,9 +2769,8 @@ When called interactively, use the currently active
server"
(defun eglot--signal-textDocument/didChange ()
"Send textDocument/didChange to server."
+ (eglot--track-changes-fetch eglot--track-changes)
(when eglot--recent-changes
- (when eglot--track-changes
- (eglot--track-changes-fetch eglot--track-changes))
(let* ((server (eglot--current-server-or-lose))
(sync-capability (eglot-server-capable :textDocumentSync))
(sync-kind (if (numberp sync-capability) sync-capability
@@ -2806,12 +2787,6 @@ When called interactively, use the currently active
server"
(buffer-substring-no-properties (point-min)
(point-max)))))
(cl-loop for (beg end len text) in (reverse eglot--recent-changes)
- ;; github#259: `capitalize-word' and commands based
- ;; on `casify_region' will cause multiple duplicate
- ;; empty entries in `eglot--before-change' calls
- ;; without an `eglot--after-change' reciprocal.
- ;; Weed them out here.
- when (numberp len) ;FIXME: Not needed with `track-changes'.
vconcat `[,(list :range `(:start ,beg :end ,end)
:rangeLength len :text text)]))))
(setq eglot--recent-changes nil)
@@ -2819,7 +2794,9 @@ When called interactively, use the currently active
server"
(defun eglot--signal-textDocument/didOpen ()
"Send textDocument/didOpen to server."
- (setq eglot--recent-changes nil eglot--versioned-identifier 0)
+ (setq eglot--recent-changes nil
+ eglot--versioned-identifier 0
+ eglot--TextDocumentIdentifier-cache nil)
(jsonrpc-notify
(eglot--current-server-or-lose)
:textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem))))
@@ -2907,7 +2884,7 @@ may be called multiple times (respecting the protocol of
Try to visit the target file for a richer summary line."
(pcase-let*
((file (eglot-uri-to-path uri))
- (visiting (or (gethash file (eglot--managed-buffers
(eglot-current-server)))
+ (visiting (or (find-buffer-visiting file)
(gethash uri eglot--temp-location-buffers)))
(collect (lambda ()
(eglot--widening
@@ -3607,14 +3584,13 @@ list ((FILENAME EDITS VERSION)...)."
(with-current-buffer (get-buffer-create "*EGLOT proposed server changes*")
(buffer-disable-undo (current-buffer))
(let ((inhibit-read-only t)
- (target (current-buffer))
- (managed-buffers (eglot--managed-buffers (eglot-current-server))))
+ (target (current-buffer)))
(diff-mode)
(erase-buffer)
(pcase-dolist (`(,path ,edits ,_) prepared)
(with-temp-buffer
(let* ((diff (current-buffer))
- (existing-buf (gethash path (gethash path managed-buffers)))
+ (existing-buf (find-buffer-visiting path))
(existing-buf-label (prin1-to-string existing-buf)))
(with-temp-buffer
(if existing-buf
@@ -3649,8 +3625,7 @@ edit proposed by the server."
(eglot--dbind ((VersionedTextDocumentIdentifier) uri
version)
textDocument
(list (eglot-uri-to-path uri) edits version)))
- documentChanges))
- (managed-buffers (eglot--managed-buffers (eglot-current-server))))
+ documentChanges)))
(unless (and changes documentChanges)
;; We don't want double edits, and some servers send both
;; changes and documentChanges. This unless ensures that we
@@ -3658,7 +3633,7 @@ edit proposed by the server."
(cl-loop for (uri edits) on changes by #'cddr
do (push (list (eglot-uri-to-path uri) edits) prepared)))
(cl-flet ((notevery-visited-p ()
- (cl-notevery (lambda (p) (gethash p managed-buffers))
+ (cl-notevery #'find-buffer-visiting
(mapcar #'car prepared)))
(accept-p ()
(y-or-n-p
@@ -3936,6 +3911,7 @@ If NOERROR, return predicate, else erroring function."
(define-derived-mode eglot-list-connections-mode tabulated-list-mode
"" "Eglot mode for listing server connections
\\{eglot-list-connections-mode-map}"
+ :interactive nil
(setq-local tabulated-list-format
`[("Language server" 16) ("Project name" 16) ("Modes handled"
16)])
(tabulated-list-init-header))
@@ -4125,6 +4101,27 @@ If NOERROR, return predicate, else erroring function."
"https://debbugs.gnu.org/%s";)
(match-string 3))))
+;; Add command-mode property manually for compatibility with Emacs < 28.
+(dolist (sym '(eglot-clear-status
+ eglot-code-action-inline
+ eglot-code-action-organize-imports
+ eglot-code-action-quickfix
+ eglot-code-action-rewrite
+ eglot-code-action-rewrite
+ eglot-code-actions
+ eglot-find-declaration
+ eglot-find-implementation
+ eglot-find-typeDefinition
+ eglot-forget-pending-continuations
+ eglot-format
+ eglot-format-buffer
+ eglot-inlay-hints-mode
+ eglot-reconnect
+ eglot-rename
+ eglot-signal-didChangeConfiguration
+ eglot-stderr-buffer))
+ (function-put sym 'command-modes '(eglot--managed-mode)))
+
(provide 'eglot)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 84814c9eaac..7d0312eb2a4 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1557,13 +1557,16 @@ character)."
(pcase-let*
((`(,insert-value ,no-truncate ,char-print-limit)
(eval-expression-get-print-arguments eval-last-sexp-arg-internal)))
- ;; Setup the lexical environment if lexical-binding is enabled.
- (elisp--eval-last-sexp-print-value
- (eval (macroexpand-all
- (eval-sexp-add-defvars
- (elisp--eval-defun-1 (macroexpand (elisp--preceding-sexp)))))
- lexical-binding)
- (if insert-value (current-buffer) t) no-truncate char-print-limit)))
+ ;; The expression might change to a different buffer, so record the
+ ;; desired output stream now.
+ (let ((output (if insert-value (current-buffer) t)))
+ ;; Setup the lexical environment if lexical-binding is enabled.
+ (elisp--eval-last-sexp-print-value
+ (eval (macroexpand-all
+ (eval-sexp-add-defvars
+ (elisp--eval-defun-1 (macroexpand (elisp--preceding-sexp)))))
+ lexical-binding)
+ output no-truncate char-print-limit))))
(defun elisp--eval-last-sexp-print-value
(value output &optional no-truncate char-print-limit)
diff --git a/lisp/progmodes/etags-regen.el b/lisp/progmodes/etags-regen.el
index 02d666ceff7..dc778b14061 100644
--- a/lisp/progmodes/etags-regen.el
+++ b/lisp/progmodes/etags-regen.el
@@ -1,6 +1,6 @@
;;; etags-regen.el --- Auto-(re)regenerating tags -*- lexical-binding: t -*-
-;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
;; Author: Dmitry Gutov <dmitry@gutov.dev>
;; Keywords: tools
@@ -52,7 +52,7 @@
(declare-function project-files "project")
(declare-function dired-glob-regexp "dired")
-(defcustom etags-regen-program (executable-find "etags")
+(defcustom etags-regen-program etags-program-name
"Name of the etags program used by `etags-regen-mode'.
If you only have `ctags' installed, you can also set this to
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index f2750a026ce..2e602658ea7 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -180,6 +180,59 @@ See `flymake-error-bitmap' and `flymake-warning-bitmap'."
(const right-fringe)
(const :tag "No fringe indicators" nil)))
+(defcustom flymake-indicator-type (if (display-graphic-p)
+ 'fringes
+ 'margins)
+ "Indicate which indicator type to use for display errors.
+
+The value can be nil (don't indicate errors but just highlight them),
+fringes (use fringes) or margins (use margins)
+
+Difference between fringes and margin is that fringes support diplaying
+bitmaps on graphical displays and margins display text in a blank area
+from current buffer that works in both graphical and text displays.
+
+See Info node `Fringes' and Info node `(elisp)Display Margins'."
+ :version "30.1"
+ :type '(choice (const :tag "Use Fringes" fringes)
+ (const :tag "Use Margins "margins)
+ (const :tag "No indicators" nil)))
+
+(defcustom flymake-margin-indicators-string
+ '((error "!!" compilation-error)
+ (warning "!" compilation-warning)
+ (note "!" compilation-info))
+ "Strings used for margins indicators.
+The value of each list may be a list of 3 elements where specifies the
+error type, the string to use and its face,
+or a list of 2 elements specifying only the error type and
+the corresponding string.
+
+The option `flymake-margin-indicator-position' controls how and where
+this is used."
+ :version "30.1"
+ :type '(repeat :tag "Error types lists"
+ (list :tag "String and face for error types"
+ (symbol :tag "Error type")
+ (string :tag "String")
+ (face :tag "Face"))))
+
+(defcustom flymake-autoresize-margins t
+ "If non-nil, automatically resize margin-width calling
flymake--resize-margins.
+
+Only relevant if `flymake-indicator-type' is set to margins."
+ :version "30.1"
+ :type 'boolean)
+
+(defcustom flymake-margin-indicator-position 'left-margin
+ "The position to put Flymake margin indicator.
+The value can be nil (do not use indicators), `left-margin' or `right-margin'.
+See `flymake-margin-indicators-string'."
+ :version "30.1"
+ :type '(choice (const left-margin)
+ (const right-margin)
+ (const :tag "No margin indicators" nil)))
+
(make-obsolete-variable 'flymake-start-syntax-check-on-newline
"can check on newline in post-self-insert-hook"
"27.1")
@@ -258,6 +311,11 @@ If set to nil, don't suppress any zero counters."
(defvar-local flymake-check-start-time nil
"Time at which syntax check was started.")
+(defvar-local flymake--original-margin-width nil
+ "Store original margin width.
+Used by `flymake--resize-margins' for restoring original margin width
+when flymake is turned off.")
+
(defun flymake--log-1 (level sublog msg &rest args)
"Do actual work for `flymake-log'."
(let (;; never popup the log buffer
@@ -630,6 +688,7 @@ Node `(Flymake)Flymake error types'"
(put 'flymake-error 'face 'flymake-error)
(put 'flymake-error 'flymake-bitmap 'flymake-error-bitmap)
+(put 'flymake-error 'flymake-margin-string (alist-get 'error
flymake-margin-indicators-string))
(put 'flymake-error 'severity (warning-numeric-level :error))
(put 'flymake-error 'mode-line-face 'flymake-error-echo)
(put 'flymake-error 'echo-face 'flymake-error-echo)
@@ -638,6 +697,7 @@ Node `(Flymake)Flymake error types'"
(put 'flymake-warning 'face 'flymake-warning)
(put 'flymake-warning 'flymake-bitmap 'flymake-warning-bitmap)
+(put 'flymake-warning 'flymake-margin-string (alist-get 'warning
flymake-margin-indicators-string))
(put 'flymake-warning 'severity (warning-numeric-level :warning))
(put 'flymake-warning 'mode-line-face 'flymake-warning-echo)
(put 'flymake-warning 'echo-face 'flymake-warning-echo)
@@ -646,6 +706,7 @@ Node `(Flymake)Flymake error types'"
(put 'flymake-note 'face 'flymake-note)
(put 'flymake-note 'flymake-bitmap 'flymake-note-bitmap)
+(put 'flymake-note 'flymake-margin-string (alist-get 'note
flymake-margin-indicators-string))
(put 'flymake-note 'severity (warning-numeric-level :debug))
(put 'flymake-note 'mode-line-face 'flymake-note-echo)
(put 'flymake-note 'echo-face 'flymake-note-echo)
@@ -682,19 +743,55 @@ associated `flymake-category' return DEFAULT."
(flymake--lookup-type-property type 'severity
(warning-numeric-level :error)))
-(defun flymake--fringe-overlay-spec (bitmap &optional recursed)
- (if (and (symbolp bitmap)
- (boundp bitmap)
- (not recursed))
- (flymake--fringe-overlay-spec
- (symbol-value bitmap) t)
- (and flymake-fringe-indicator-position
- bitmap
- (propertize "!" 'display
- (cons flymake-fringe-indicator-position
- (if (listp bitmap)
- bitmap
- (list bitmap)))))))
+(defun flymake--indicator-overlay-spec (indicator)
+ "Return INDICATOR as propertized string to use in error indicators."
+ (let* ((value (if (symbolp indicator)
+ (symbol-value indicator)
+ indicator))
+ (indicator-car (if (listp value)
+ (car value)
+ value))
+ (indicator-cdr (if (listp value)
+ (cdr value))))
+ (cond
+ ((and (symbolp indicator-car)
+ flymake-fringe-indicator-position)
+ (propertize "!" 'display
+ (cons flymake-fringe-indicator-position
+ (if (listp value)
+ value
+ (list value)))))
+ ((and (stringp indicator-car)
+ flymake-margin-indicator-position)
+ (propertize "!"
+ 'display
+ `((margin ,flymake-margin-indicator-position)
+ ,(propertize
+ indicator-car
+ 'face
+ `(:inherit (,indicator-cdr
+ default)))))))))
+
+(defun flymake--resize-margins (&optional orig-width)
+ "Resize current window margins according to
`flymake-margin-indicator-position'.
+Return to original margin width if ORIG-WIDTH is non-nil."
+ (when (and (eq flymake-indicator-type 'margins)
+ flymake-autoresize-margins)
+ (cond
+ ((and orig-width flymake--original-margin-width)
+ (if (eq flymake-margin-indicator-position 'left-margin)
+ (setq-local left-margin-width flymake--original-margin-width)
+ (setq-local right-margin-width flymake--original-margin-width)))
+ (t
+ (if (eq flymake-margin-indicator-position 'left-margin)
+ (setq-local flymake--original-margin-width left-margin-width
+ left-margin-width 2)
+ (setq-local flymake--original-margin-width right-margin-width
+ right-margin-width 2))))
+ ;; Apply margin to all windows avalaibles
+ (mapc (lambda (x)
+ (set-window-buffer x (window-buffer x)))
+ (get-buffer-window-list nil nil 'visible))))
(defun flymake--equal-diagnostic-p (a b)
"Tell if A and B are equivalent `flymake--diag' objects."
@@ -840,10 +937,13 @@ Return nil or the overlay created."
type prop value)))))
(default-maybe 'face 'flymake-error)
(default-maybe 'before-string
- (flymake--fringe-overlay-spec
+ (flymake--indicator-overlay-spec
(flymake--lookup-type-property
type
- 'flymake-bitmap
+ (cond ((eq flymake-indicator-type 'fringes)
+ 'flymake-bitmap)
+ ((eq flymake-indicator-type 'margins)
+ 'flymake-margin-string))
(alist-get 'bitmap (alist-get type ; backward compat
flymake-diagnostic-types-alist)))))
;; (default-maybe 'after-string
@@ -1233,7 +1333,10 @@ Interactively, with a prefix arg, FORCE is t."
nil))))))))
(defvar flymake-mode-map
- (let ((map (make-sparse-keymap))) map)
+ (let ((map (make-sparse-keymap)))
+ (define-key map `[,flymake-fringe-indicator-position mouse-1]
+ #'flymake-show-buffer-diagnostics)
+ map)
"Keymap for `flymake-mode'.")
;;;###autoload
@@ -1285,6 +1388,9 @@ special *Flymake log* buffer." :group 'flymake :lighter
(add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
(add-hook 'eldoc-documentation-functions 'flymake-eldoc-function t t)
+ ;; AutoResize margins.
+ (flymake--resize-margins)
+
;; If Flymake happened to be already ON, we must cleanup
;; existing diagnostic overlays, lest we forget them by blindly
;; reinitializing `flymake--state' in the next line.
@@ -1333,6 +1439,9 @@ special *Flymake log* buffer." :group 'flymake :lighter
;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t)
(remove-hook 'eldoc-documentation-functions 'flymake-eldoc-function t)
+ ;; return margin to original size
+ (flymake--resize-margins t)
+
(when flymake-timer
(cancel-timer flymake-timer)
(setq flymake-timer nil))
@@ -1868,8 +1977,12 @@ buffer."
(current-buffer)))))
(with-current-buffer target
(setq flymake--diagnostics-buffer-source source)
- (display-buffer (current-buffer))
- (revert-buffer))))
+ (revert-buffer)
+ (display-buffer (current-buffer)
+ `((display-buffer-reuse-window
+ display-buffer-below-selected)
+ (window-height . (lambda (window)
+ (fit-window-to-buffer window 10))))))))
;;; Per-project diagnostic listing
@@ -1969,8 +2082,11 @@ some of this variable's contents the diagnostic
listings.")
(with-current-buffer buffer
(flymake-project-diagnostics-mode)
(setq-local flymake--project-diagnostic-list-project prj)
- (display-buffer (current-buffer))
- (revert-buffer))))
+ (revert-buffer)
+ (display-buffer (current-buffer)
+ `((display-buffer-reuse-window
+ display-buffer-at-bottom)
+ (window-height . fit-window-to-buffer))))))
(defun flymake--update-diagnostics-listings (buffer)
"Update diagnostics listings somehow relevant to BUFFER."
diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el
index 92de2a2581f..18ab4911c89 100644
--- a/lisp/progmodes/glasses.el
+++ b/lisp/progmodes/glasses.el
@@ -232,8 +232,7 @@ CATEGORY is the overlay category. If it is nil, use the
`glasses' category."
(save-match-data
(re-search-backward "\\<.")
(looking-at glasses-uncapitalize-regexp))))
- (overlay-put o 'invisible t)
- (overlay-put o 'after-string (downcase (match-string n))))))
+ (overlay-put o 'display (downcase (match-string n))))))
;; Separator change
(when (and (not (string= glasses-original-separator glasses-separator))
(not (string= glasses-original-separator "")))
diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el
index b82bc2364dc..aef224ab3fa 100644
--- a/lisp/progmodes/go-ts-mode.el
+++ b/lisp/progmodes/go-ts-mode.el
@@ -108,6 +108,11 @@
">>" "%=" ">>=" "--" "!" "..." "&^" "&^=" "~")
"Go operators for tree-sitter font-locking.")
+(defvar go-ts-mode--builtin-functions
+ '("append" "cap" "clear" "close" "complex" "copy" "delete" "imag" "len"
"make"
+ "max" "min" "new" "panic" "print" "println" "real" "recover")
+ "Go built-in functions for tree-sitter font-locking.")
+
(defun go-ts-mode--iota-query-supported-p ()
"Return t if the iota query is supported by the tree-sitter-go grammar."
(ignore-errors
@@ -130,6 +135,16 @@
:feature 'comment
'((comment) @font-lock-comment-face)
+ :language 'go
+ :feature 'builtin
+ `((call_expression
+ function: ((identifier) @font-lock-builtin-face
+ (:match ,(rx-to-string
+ `(seq bol
+ (or ,@go-ts-mode--builtin-functions)
+ eol))
+ @font-lock-builtin-face))))
+
:language 'go
:feature 'constant
`([(false) (nil) (true)] @font-lock-constant-face
@@ -269,7 +284,7 @@
(setq-local treesit-font-lock-feature-list
'(( comment definition)
( keyword string type)
- ( constant escape-sequence label number)
+ ( builtin constant escape-sequence label number)
( bracket delimiter error function operator property
variable)))
(treesit-major-mode-setup)))
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 657349cbdff..0a9de04fce1 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -1176,6 +1176,19 @@ REGEXP is used as a string in the prompt."
(defvar grep-use-directories-skip 'auto-detect)
+(defun grep--filter-list-by-dir (list dir)
+ "Include elements of LIST which are applicable to DIR."
+ (delq nil (mapcar
+ (lambda (ignore)
+ (cond ((stringp ignore) ignore)
+ ((consp ignore)
+ (and (funcall (car ignore) dir) (cdr ignore)))))
+ list)))
+
+(defun grep-find-ignored-files (dir)
+ "Return the list of ignored files applicable to DIR."
+ (grep--filter-list-by-dir grep-find-ignored-files dir))
+
;;;###autoload
(defun lgrep (regexp &optional files dir confirm)
"Run grep, searching for REGEXP in FILES in directory DIR.
@@ -1236,20 +1249,13 @@ command before it's run."
regexp
files
nil
- (and grep-find-ignored-files
- (concat " --exclude="
- (mapconcat
- (lambda (ignore)
- (cond ((stringp ignore)
- (shell-quote-argument
- ignore grep-quoting-style))
- ((consp ignore)
- (and (funcall (car ignore) dir)
- (shell-quote-argument
- (cdr ignore)
- grep-quoting-style)))))
- grep-find-ignored-files
- " --exclude=")))
+ (when-let ((ignores (grep-find-ignored-files dir)))
+ (concat " --exclude="
+ (mapconcat
+ (lambda (ignore)
+ (shell-quote-argument ignore
grep-quoting-style))
+ ignores
+ " --exclude=")))
(and (eq grep-use-directories-skip t)
'("--directories=skip"))))
(when command
@@ -1353,13 +1359,8 @@ to indicate whether the grep should be case sensitive or
not."
(setq default-directory dir)))))))
(defun rgrep-find-ignored-directories (dir)
- "Return the list of ignored directories applicable to `dir'."
- (delq nil (mapcar
- (lambda (ignore)
- (cond ((stringp ignore) ignore)
- ((consp ignore)
- (and (funcall (car ignore) dir) (cdr ignore)))))
- grep-find-ignored-directories)))
+ "Return the list of ignored directories applicable to DIR."
+ (grep--filter-list-by-dir grep-find-ignored-directories dir))
(defun rgrep-default-command (regexp files dir)
"Compute the command for \\[rgrep] to use by default."
@@ -1377,37 +1378,31 @@ to indicate whether the grep should be case sensitive
or not."
(shell-quote-argument ")" grep-quoting-style))
dir
(concat
- (and grep-find-ignored-directories
- (concat "-type d "
- (shell-quote-argument "(" grep-quoting-style)
- ;; we should use shell-quote-argument here
- " -path "
- (mapconcat
- (lambda (d)
- (shell-quote-argument (concat "*/" d) grep-quoting-style))
- (rgrep-find-ignored-directories dir)
- " -o -path ")
- " "
- (shell-quote-argument ")" grep-quoting-style)
- " -prune -o "))
- (and grep-find-ignored-files
- (concat (shell-quote-argument "!" grep-quoting-style) " -type d "
- (shell-quote-argument "(" grep-quoting-style)
- ;; we should use shell-quote-argument here
- " -name "
- (mapconcat
- (lambda (ignore)
- (cond ((stringp ignore)
- (shell-quote-argument ignore grep-quoting-style))
- ((consp ignore)
- (and (funcall (car ignore) dir)
- (shell-quote-argument
- (cdr ignore) grep-quoting-style)))))
- grep-find-ignored-files
- " -o -name ")
- " "
- (shell-quote-argument ")" grep-quoting-style)
- " -prune -o ")))))
+ (when-let ((ignored-dirs (rgrep-find-ignored-directories dir)))
+ (concat "-type d "
+ (shell-quote-argument "(" grep-quoting-style)
+ ;; we should use shell-quote-argument here
+ " -path "
+ (mapconcat
+ (lambda (d)
+ (shell-quote-argument (concat "*/" d) grep-quoting-style))
+ ignored-dirs
+ " -o -path ")
+ " "
+ (shell-quote-argument ")" grep-quoting-style)
+ " -prune -o "))
+ (when-let ((ignored-files (grep-find-ignored-files dir)))
+ (concat (shell-quote-argument "!" grep-quoting-style) " -type d "
+ (shell-quote-argument "(" grep-quoting-style)
+ ;; we should use shell-quote-argument here
+ " -name "
+ (mapconcat
+ (lambda (ignore) (shell-quote-argument ignore
grep-quoting-style))
+ ignored-files
+ " -o -name ")
+ " "
+ (shell-quote-argument ")" grep-quoting-style)
+ " -prune -o ")))))
(defun grep-find-toggle-abbreviation ()
"Toggle showing the hidden part of rgrep/lgrep/zrgrep command line."
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index 141bd18cf1e..687b176009e 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -308,7 +308,8 @@ quoted using shell quote syntax.
"inferior-lisp" (car cmdlist) nil (cdr cmdlist)))
(inferior-lisp-mode)))
(setq inferior-lisp-buffer "*inferior-lisp*")
- (pop-to-buffer "*inferior-lisp*" display-comint-buffer-action))
+ (with-suppressed-warnings ((obsolete display-comint-buffer-action))
+ (pop-to-buffer "*inferior-lisp*" display-comint-buffer-action)))
;;;###autoload
(defalias 'run-lisp 'inferior-lisp)
diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el
index 45ea8ec9a81..0568e0d273c 100644
--- a/lisp/progmodes/lua-ts-mode.el
+++ b/lisp/progmodes/lua-ts-mode.el
@@ -40,8 +40,10 @@
(declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c")
(declare-function treesit-node-child-count "treesit.c")
+(declare-function treesit-node-eq "treesit.c")
(declare-function treesit-node-first-child-for-pos "treesit.c")
(declare-function treesit-node-parent "treesit.c")
+(declare-function treesit-node-prev-sibling "treesit.c")
(declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-end "treesit.c")
(declare-function treesit-node-type "treesit.c")
@@ -291,6 +293,14 @@ values of OVERRIDE."
(parent-is "string_content")
(node-is "]]"))
no-indent 0)
+ ((and (n-p-gp "field" "table_constructor" "arguments")
+ lua-ts--multi-arg-function-call-matcher
+ lua-ts--last-arg-function-call-matcher)
+ standalone-parent lua-ts-indent-offset)
+ ((and (n-p-gp "}" "table_constructor" "arguments")
+ lua-ts--multi-arg-function-call-matcher
+ lua-ts--last-arg-function-call-matcher)
+ standalone-parent 0)
((and (n-p-gp "field" "table_constructor" "arguments")
lua-ts--multi-arg-function-call-matcher)
parent lua-ts-indent-offset)
@@ -311,10 +321,15 @@ values of OVERRIDE."
(and (parent-is "parameters") lua-ts--first-child-matcher)
(and (parent-is "table_constructor") lua-ts--first-child-matcher))
standalone-parent lua-ts-indent-offset)
+ ((and (not lua-ts--comment-first-sibling-matcher)
+ (or (parent-is "arguments")
+ (parent-is "parameters")
+ (parent-is "table_constructor")))
+ lua-ts--first-real-sibling-anchor 0)
((or (parent-is "arguments")
(parent-is "parameters")
(parent-is "table_constructor"))
- (nth-sibling 1) 0)
+ standalone-parent lua-ts-indent-offset)
((and (n-p-gp "block" "function_definition" "parenthesized_expression")
lua-ts--nested-function-block-matcher
lua-ts--nested-function-block-include-matcher)
@@ -337,6 +352,9 @@ values of OVERRIDE."
lua-ts--nested-function-end-matcher
lua-ts--nested-function-last-function-matcher)
parent 0)
+ ((and (n-p-gp "end" "function_definition" "arguments")
+ lua-ts--top-level-function-call-matcher)
+ standalone-parent 0)
((n-p-gp "end" "function_definition" "arguments") parent 0)
((or (match "end" "function_definition")
(node-is "end"))
@@ -385,24 +403,39 @@ values of OVERRIDE."
"Return t if NODE is a function_definition."
(equal "function_definition" (treesit-node-type node)))
+(defun lua-ts--g-parent (node)
+ "Return the grand-parent of NODE."
+ (let ((parent (treesit-node-parent node)))
+ (treesit-node-parent parent)))
+
+(defun lua-ts--g-g-parent (node)
+ "Return the great-grand-parent of NODE."
+ (treesit-node-parent (lua-ts--g-parent node)))
+
(defun lua-ts--g-g-g-parent (node)
"Return the great-great-grand-parent of NODE."
- (let* ((parent (treesit-node-parent node))
- (g-parent (treesit-node-parent parent))
- (g-g-parent (treesit-node-parent g-parent)))
- (treesit-node-parent g-g-parent)))
+ (treesit-node-parent (lua-ts--g-g-parent node)))
(defun lua-ts--multi-arg-function-call-matcher (_n parent &rest _)
"Matches if PARENT has multiple arguments."
(> (treesit-node-child-count (treesit-node-parent parent)) 3))
+(defun lua-ts--last-arg-function-call-matcher (node parent &rest _)
+ "Matches if NODE's PARENT is the last argument in a function call."
+ (let* ((g-parent (lua-ts--g-parent node))
+ (last (1- (treesit-node-child-count g-parent t))))
+ (treesit-node-eq parent (seq-elt (treesit-node-children g-parent t)
last))))
+
(defun lua-ts--nested-function-argument-matcher (node &rest _)
"Matches if NODE is in a nested function argument."
(save-excursion
(goto-char (treesit-node-start node))
(treesit-beginning-of-defun)
(backward-char 2)
- (not (looking-at ")("))))
+ (and (not (looking-at ")("))
+ (not (equal "chunk"
+ (treesit-node-type
+ (lua-ts--g-parent (treesit-node-at (point)))))))))
(defun lua-ts--nested-function-block-matcher (node &rest _)
"Matches if NODE is in a nested function block."
@@ -438,6 +471,26 @@ values of OVERRIDE."
(treesit-induce-sparse-tree parent #'lua-ts--function-definition-p)))
(= 1 (length (cadr sparse-tree)))))
+(defun lua-ts--comment-first-sibling-matcher (node &rest _)
+ "Matches if NODE if it's previous sibling is a comment."
+ (let ((sibling (treesit-node-prev-sibling node)))
+ (equal "comment" (treesit-node-type sibling))))
+
+(defun lua-ts--top-level-function-call-matcher (node &rest _)
+ "Matches if NODE is within a top-level function call."
+ (let* ((g-g-p (lua-ts--g-g-parent node))
+ (g-g-g-p (lua-ts--g-g-g-parent node)))
+ (and (equal "function_call" (treesit-node-type g-g-p))
+ (equal "chunk" (treesit-node-type g-g-g-p)))))
+
+(defun lua-ts--first-real-sibling-anchor (_n parent _)
+ "Return the start position of the first non-comment child of PARENT."
+ (treesit-node-start
+ (seq-first
+ (seq-filter
+ (lambda (n) (not (equal "comment" (treesit-node-type n))))
+ (treesit-node-children parent t)))))
+
(defun lua-ts--variable-declaration-continuation (node &rest _)
"Matches if NODE is part of a multi-line variable declaration."
(treesit-parent-until node
@@ -764,7 +817,7 @@ Calls REPORT-FN directly."
"vararg_expression"))))
(text "comment"))))
- ;; Imenu/Outline.
+ ;; Imenu/Outline/Which-function.
(setq-local treesit-simple-imenu-settings
`(("Requires"
"\\`function_call\\'"
@@ -776,9 +829,6 @@ Calls REPORT-FN directly."
lua-ts--named-function-p
nil)))
- ;; Which-function.
- (setq-local which-func-functions (treesit-defun-at-point))
-
;; Align.
(setq-local align-indent-before-aligning t)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 000a05804a8..c57c16073b9 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -295,7 +295,7 @@ headers search path, load path, class path, and so on."
Nominally unique, but not enforced."
(file-name-nondirectory (directory-file-name (project-root project))))
-(cl-defgeneric project-ignores (_project _dir)
+(cl-defgeneric project-ignores (_project dir)
"Return the list of glob patterns to ignore inside DIR.
Patterns can match both regular files and directories.
To root an entry, start it with `./'. To match directories only,
@@ -305,12 +305,15 @@ end it with `/'. DIR must be either `project-root' or
one of
;; TODO: Support whitelist entries.
(require 'grep)
(defvar grep-find-ignored-files)
+ (declare-function grep-find-ignored-files "grep" (dir))
(nconc
(mapcar
(lambda (dir)
(concat dir "/"))
vc-directory-exclusion-list)
- grep-find-ignored-files))
+ (if (fboundp 'grep-find-ignored-files)
+ (grep-find-ignored-files dir)
+ grep-find-ignored-files)))
(defun project--file-completion-table (all-files)
(lambda (string pred action)
@@ -323,6 +326,13 @@ end it with `/'. DIR must be either `project-root' or one
of
(cl-defmethod project-root ((project (head transient)))
(cdr project))
+(defvar project-files-relative-names nil
+ "If non-nil, `project-files' is allowed to return relative file names.
+The file names should be relative to the project root. And this can
+only happen when all returned files are in the same directory.
+In other words, the DIRS argument of `project-files' has to be nil or a
+list of only one element.")
+
(cl-defgeneric project-files (project &optional dirs)
"Return a list of files in directories DIRS in PROJECT.
DIRS is a list of absolute directories; it should be some
@@ -340,12 +350,12 @@ to find the list of ignores for each directory."
(defun project--files-in-directory (dir ignores &optional files)
(require 'find-dired)
(require 'xref)
- (let* ((default-directory dir)
+ (let* ((dir (file-name-as-directory dir))
+ (default-directory dir)
;; Make sure ~/ etc. in local directory name is
;; expanded and not left for the shell command
;; to interpret.
(localdir (file-name-unquote (file-local-name (expand-file-name
dir))))
- (dfn (directory-file-name localdir))
(command (format "%s -H . %s -type f %s -print0"
find-program
(xref--find-ignores-arguments ignores "./")
@@ -376,12 +386,14 @@ to find the list of ignores for each directory."
(error "File listing failed: %s" (buffer-string))))
(goto-char pt)
(while (search-forward "\0" nil t)
- (push (buffer-substring-no-properties (1+ pt) (1- (point)))
+ (push (buffer-substring-no-properties (+ pt 2) (1- (point)))
res)
(setq pt (point)))))
- (project--remote-file-names
- (mapcar (lambda (s) (concat dfn s))
- (sort res #'string<)))))
+ (if project-files-relative-names
+ (sort res #'string<)
+ (project--remote-file-names
+ (mapcar (lambda (s) (concat localdir s))
+ (sort res #'string<))))))
(defun project--remote-file-names (local-files)
"Return LOCAL-FILES as if they were on the system of `default-directory'.
@@ -640,7 +652,7 @@ See `project-vc-extra-root-markers' for the marker value
format.")
(list (project-root project)))))
(declare-function vc-git--program-version "vc-git")
-(declare-function vc-git--run-command-string "vc-git")
+(declare-function vc-git-command "vc-git")
(declare-function vc-hg-command "vc-hg")
(defun project--vc-list-files (dir backend extra-ignores)
@@ -689,9 +701,12 @@ See `project-vc-extra-root-markers' for the marker value
format.")
(mapcar
(lambda (file)
(unless (member file submodules)
- (concat default-directory file)))
+ (if project-files-relative-names
+ file
+ (concat default-directory file))))
(split-string
- (apply #'vc-git--run-command-string nil "ls-files" args)
+ (with-output-to-string
+ (apply #'vc-git-command standard-output 0 nil
"ls-files" args))
"\0" t))))
(when (project--vc-merge-submodules-p default-directory)
;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'.
@@ -716,7 +731,8 @@ See `project-vc-extra-root-markers' for the marker value
format.")
dir))
(args (list (concat "-mcard" (and include-untracked "u"))
"--no-status"
- "-0")))
+ "-0"))
+ files)
(when extra-ignores
(setq args (nconc args
(mapcan
@@ -725,9 +741,12 @@ See `project-vc-extra-root-markers' for the marker value
format.")
extra-ignores))))
(with-temp-buffer
(apply #'vc-hg-command t 0 "." "status" args)
- (mapcar
- (lambda (s) (concat default-directory s))
- (split-string (buffer-string) "\0" t)))))))
+ (setq files (split-string (buffer-string) "\0" t))
+ (unless project-files-relative-names
+ (setq files (mapcar
+ (lambda (s) (concat default-directory s))
+ files)))
+ files)))))
(defun project--vc-merge-submodules-p (dir)
(project--value-in-dir
@@ -970,11 +989,13 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
(let* ((caller-dir default-directory)
(pr (project-current t))
(default-directory (project-root pr))
+ (project-files-relative-names t)
(files
(if (not current-prefix-arg)
(project-files pr)
- (let ((dir (read-directory-name "Base directory: "
- caller-dir nil t)))
+ (let* ((dir (read-directory-name "Base directory: "
+ caller-dir nil t)))
+ (setq default-directory dir)
(project--files-in-directory dir
nil
(grep-read-files regexp))))))
@@ -1000,6 +1021,8 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
(require 'xref)
(let* ((pr (project-current t))
(default-directory (project-root pr))
+ ;; TODO: Make use of `project-files-relative-names' by
+ ;; searching each root separately (maybe in parallel, too).
(files
(project-files pr (cons
(project-root pr)
@@ -1054,7 +1077,8 @@ for VCS directories listed in
`vc-directory-exclusion-list'."
(interactive "P")
(let* ((pr (project-current t))
(root (project-root pr))
- (dirs (list root)))
+ (dirs (list root))
+ (project-files-relative-names t))
(project-find-file-in
(or (thing-at-point 'filename)
(and buffer-file-name (project--find-default-from buffer-file-name
pr)))
@@ -1130,7 +1154,12 @@ by the user at will."
(if (> (length common-prefix) 0)
(file-name-directory common-prefix))))
(cpd-length (length common-parent-directory))
- (prompt (if (zerop cpd-length)
+ (common-parent-directory (if (file-name-absolute-p (car all-files))
+ common-parent-directory
+ (concat default-directory
common-parent-directory)))
+ (prompt (if (and (zerop cpd-length)
+ all-files
+ (file-name-absolute-p (car all-files)))
prompt
(concat prompt (format " in %s" common-parent-directory))))
(included-cpd (when (member common-parent-directory all-files)
@@ -1167,10 +1196,19 @@ by the user at will."
(defun project--read-file-absolute (prompt
all-files &optional predicate
hist mb-default)
- (project--completing-read-strict prompt
- (project--file-completion-table all-files)
- predicate
- hist mb-default))
+ (let* ((new-prompt (if (file-name-absolute-p (car all-files))
+ prompt
+ (concat prompt " in " default-directory)))
+ ;; FIXME: Map relative names to absolute?
+ (ct (project--file-completion-table all-files))
+ (file
+ (project--completing-read-strict new-prompt
+ ct
+ predicate
+ hist mb-default)))
+ (unless (file-name-absolute-p file)
+ (setq file (expand-file-name file)))
+ file))
(defun project--read-file-name ( project prompt
all-files &optional predicate
@@ -1215,6 +1253,7 @@ directories listed in `vc-directory-exclusion-list'."
dirs)
(project-files project dirs)))
(completion-ignore-case read-file-name-completion-ignore-case)
+ (default-directory (project-root project))
(file (project--read-file-name
project "Find file"
all-files nil 'file-name-history
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 85279d3e84b..79e383a1c1a 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -350,6 +350,7 @@ To customize the Python interpreter for interactive use,
modify
(define-key map "\C-c\C-e" #'python-shell-send-statement)
(define-key map "\C-c\C-r" #'python-shell-send-region)
(define-key map "\C-\M-x" #'python-shell-send-defun)
+ (define-key map "\C-c\C-b" #'python-shell-send-block)
(define-key map "\C-c\C-c" #'python-shell-send-buffer)
(define-key map "\C-c\C-l" #'python-shell-send-file)
(define-key map "\C-c\C-z" #'python-shell-switch-to-shell)
@@ -390,6 +391,8 @@ To customize the Python interpreter for interactive use,
modify
:help "Switch to running inferior Python process"]
["Eval string" python-shell-send-string
:help "Eval string in inferior Python session"]
+ ["Eval block" python-shell-send-block
+ :help "Eval block in inferior Python session"]
["Eval buffer" python-shell-send-buffer
:help "Eval buffer in inferior Python session"]
["Eval statement" python-shell-send-statement
@@ -785,11 +788,31 @@ sign in chained assignment."
"InterruptedError" "IsADirectoryError" "NotADirectoryError"
"PermissionError" "ProcessLookupError" "RecursionError"
"ResourceWarning" "StopAsyncIteration" "TimeoutError"
+ "ExceptionGroup"
;; OS specific
"VMSError" "WindowsError"
)
symbol-end)
. font-lock-type-face)
+ ;; single assignment with/without type hints, e.g.
+ ;; a: int = 5
+ ;; b: Tuple[Optional[int], Union[Sequence[str], str]] = (None, 'foo')
+ ;; c: Collection = {1, 2, 3}
+ ;; d: Mapping[int, str] = {1: 'bar', 2: 'baz'}
+ (,(python-font-lock-assignment-matcher
+ (python-rx (or line-start ?\;) (* space)
+ grouped-assignment-target (* space)
+ (? ?: (* space) (group (+ not-simple-operator)) (* space))
+ (group assignment-operator)))
+ (1 font-lock-variable-name-face)
+ (3 'font-lock-operator-face)
+ (,(python-rx symbol-name)
+ (progn
+ (when-let ((type-start (match-beginning 2)))
+ (goto-char type-start))
+ (match-end 0))
+ nil
+ (0 font-lock-type-face)))
;; multiple assignment
;; (note that type hints are not allowed for multiple assignments)
;; a, b, c = 1, 2, 3
@@ -828,8 +851,7 @@ sign in chained assignment."
;; c: Collection = {1, 2, 3}
;; d: Mapping[int, str] = {1: 'bar', 2: 'baz'}
(,(python-font-lock-assignment-matcher
- (python-rx (or line-start ?\;) (* space)
- grouped-assignment-target (* space)
+ (python-rx grouped-assignment-target (* space)
(? ?: (* space) (+ not-simple-operator) (* space))
(group assignment-operator)))
(1 font-lock-variable-name-face)
@@ -1018,9 +1040,9 @@ It makes underscores and dots word constituent chars.")
"copyright" "credits" "exit" "license" "quit"))
(defvar python--treesit-operators
- '("-" "-=" "!=" "*" "**" "**=" "*=" "/" "//" "//=" "/=" "&" "%" "%="
- "^" "+" "->" "+=" "<" "<<" "<=" "<>" "=" ":=" "==" ">" ">=" ">>" "|"
- "~" "@" "@="))
+ '("-" "-=" "!=" "*" "**" "**=" "*=" "/" "//" "//=" "/=" "&" "&=" "%" "%="
+ "^" "^=" "+" "->" "+=" "<" "<<" "<<=" "<=" "<>" "=" ":=" "==" ">" ">="
+ ">>" ">>=" "|" "|=" "~" "@" "@="))
(defvar python--treesit-special-attributes
'("__annotations__" "__closure__" "__code__"
@@ -1052,6 +1074,7 @@ It makes underscores and dots word constituent chars.")
"InterruptedError" "IsADirectoryError" "NotADirectoryError"
"PermissionError" "ProcessLookupError" "RecursionError"
"ResourceWarning" "StopAsyncIteration" "TimeoutError"
+ "ExceptionGroup"
;; OS specific
"VMSError" "WindowsError"
))
@@ -1202,17 +1225,20 @@ fontified."
(class_definition
name: (identifier) @font-lock-type-face)
(parameters (identifier) @font-lock-variable-name-face)
+ (parameters (typed_parameter (identifier) @font-lock-variable-name-face))
(parameters (default_parameter name: (identifier)
@font-lock-variable-name-face)))
:feature 'builtin
:language 'python
- `(((identifier) @font-lock-builtin-face
- (:match ,(rx-to-string
- `(seq bol
- (or ,@python--treesit-builtins
- ,@python--treesit-special-attributes)
- eol))
- @font-lock-builtin-face)))
+ `((call function: (identifier) @font-lock-builtin-face
+ (:match ,(rx-to-string
+ `(seq bol (or ,@python--treesit-builtins) eol))
+ @font-lock-builtin-face))
+ (attribute attribute: (identifier) @font-lock-builtin-face
+ (:match ,(rx-to-string
+ `(seq bol
+ (or ,@python--treesit-special-attributes) eol))
+ @font-lock-builtin-face)))
:feature 'decorator
:language 'python
@@ -1243,6 +1269,7 @@ fontified."
@font-lock-variable-name-face)
(named_expression name: (identifier)
@font-lock-variable-name-face)
+ (for_statement left: (identifier) @font-lock-variable-name-face)
(pattern_list [(identifier)
(list_splat_pattern (identifier))]
@font-lock-variable-name-face)
@@ -2852,7 +2879,7 @@ virtualenv."
:type '(repeat symbol))
(defcustom python-shell-compilation-regexp-alist
- `((,(rx line-start (1+ (any " \t")) "File \""
+ `((,(rx line-start (1+ (any " \t")) (? ?| (1+ (any " \t"))) "File \""
(group (1+ (not (any "\"<")))) ; avoid `<stdin>' &c
"\", line " (group (1+ digit)))
1 2)
@@ -2863,7 +2890,8 @@ virtualenv."
"(" (group (1+ digit)) ")" (1+ (not (any "("))) "()")
1 2))
"`compilation-error-regexp-alist' for inferior Python."
- :type '(alist regexp))
+ :type '(alist regexp)
+ :version "30.1")
(defcustom python-shell-dedicated nil
"Whether to make Python shells dedicated by default.
@@ -4136,6 +4164,28 @@ interactively."
(save-excursion (python-nav-end-of-statement))
send-main msg t)))
+(defun python-shell-send-block (&optional arg msg)
+ "Send the block at point to inferior Python process.
+The block is delimited by `python-nav-beginning-of-block' and
+`python-nav-end-of-block'. If optional argument ARG is non-nil
+(interactively, the prefix argument), send the block body without
+its header. If optional argument MSG is non-nil, force display
+of a user-friendly message if there's no process running; this
+always happens interactively."
+ (interactive (list current-prefix-arg t))
+ (let ((beg (save-excursion
+ (when (python-nav-beginning-of-block)
+ (if (null arg)
+ (beginning-of-line)
+ (python-nav-end-of-statement)
+ (beginning-of-line 2)))
+ (point-marker)))
+ (end (save-excursion (python-nav-end-of-block)))
+ (python-indent-guess-indent-offset-verbose nil))
+ (if (and beg end)
+ (python-shell-send-region beg end nil msg t)
+ (user-error "Can't get code block from current position."))))
+
(defun python-shell-send-buffer (&optional send-main msg)
"Send the entire buffer to inferior Python process.
When optional argument SEND-MAIN is non-nil, allow execution of
@@ -4706,6 +4756,8 @@ as one line, which is required by native completion."
Optional argument PROCESS forces completions to be retrieved
using that one instead of current buffer's process."
(setq process (or process (get-buffer-process (current-buffer))))
+ (unless process
+ (user-error "No active python inferior process"))
(let* ((is-shell-buffer (derived-mode-p 'inferior-python-mode))
(line-start (if is-shell-buffer
;; Working on a shell buffer: use prompt end.
@@ -7176,6 +7228,7 @@ implementations: `python-mode' and `python-ts-mode'."
python-nav-if-name-main
python-nav-up-list
python-remove-import
+ python-shell-send-block
python-shell-send-buffer
python-shell-send-defun
python-shell-send-statement
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 999fbebfb08..f6ef175e11e 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -2553,6 +2553,16 @@ If there is no Rubocop config file, Rubocop will be
passed a flag
:type 'string
:safe 'stringp)
+(defcustom ruby-rubocop-use-bundler 'check
+ "Non-nil with allow `ruby-flymake-rubocop' to use `bundle exec'.
+When the value is `check', it will first see whether Gemfile exists in
+the same directory as the configuration file, and whether it mentions
+the gem \"rubocop\". When t, it's used unconditionally. "
+ :type '(choice (const :tag "Always" t)
+ (const :tag "No" nil)
+ (const :tag "If rubocop is in Gemfile" check))
+ :safe 'booleanp)
+
(defun ruby-flymake-rubocop (report-fn &rest _args)
"RuboCop backend for Flymake."
(unless (executable-find "rubocop")
@@ -2614,11 +2624,17 @@ If there is no Rubocop config file, Rubocop will be
passed a flag
finally (funcall report-fn diags)))))))
(defun ruby-flymake-rubocop--use-bundler-p (dir)
- (let ((file (expand-file-name "Gemfile" dir)))
- (and (file-exists-p file)
- (with-temp-buffer
- (insert-file-contents file)
- (re-search-forward "^ *gem ['\"]rubocop['\"]" nil t)))))
+ (cond
+ ((eq t ruby-rubocop-use-bundler)
+ t)
+ ((null ruby-rubocop-use-bundler)
+ nil)
+ (t
+ (let ((file (expand-file-name "Gemfile" dir)))
+ (and (file-exists-p file)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (re-search-forward "^ *gem ['\"]rubocop['\"]" nil t)))))))
(defun ruby-flymake-auto (report-fn &rest args)
(apply
diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el
index 7133cb0b5b0..5f4e11e0b4c 100644
--- a/lisp/progmodes/ruby-ts-mode.el
+++ b/lisp/progmodes/ruby-ts-mode.el
@@ -1171,7 +1171,22 @@ leading double colon is not added."
"global_variable"
)
eol)
- #'ruby-ts--sexp-p)))))
+ #'ruby-ts--sexp-p))
+ (text ,(lambda (node)
+ (or (member (treesit-node-type node)
+ '("comment" "string_content"
"heredoc_content"))
+ ;; for C-M-f in hash[:key] and hash['key']
+ (and (member (treesit-node-text node)
+ '("[" "]"))
+ (equal (treesit-node-type
+ (treesit-node-parent node))
+ "element_reference"))
+ ;; for C-M-f in "abc #{ghi} def"
+ (and (member (treesit-node-text node)
+ '("#{" "}"))
+ (equal (treesit-node-type
+ (treesit-node-parent node))
+ "interpolation"))))))))
;; AFAIK, Ruby can not nest methods
(setq-local treesit-defun-prefer-top-level nil)
diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el
index 7112ceced57..baf0e1ec013 100644
--- a/lisp/progmodes/rust-ts-mode.el
+++ b/lisp/progmodes/rust-ts-mode.el
@@ -129,7 +129,7 @@ to be checked as its standard input."
"Rust built-in macros for tree-sitter font-locking.")
(defvar rust-ts-mode--keywords
- '("as" "async" "await" "break" "const" "continue" "dyn" "else"
+ '("as" "async" "await" "break" "const" "continue" "default" "dyn" "else"
"enum" "extern" "fn" "for" "if" "impl" "in" "let" "loop" "match"
"mod" "move" "pub" "ref" "return" "static" "struct" "trait" "type"
"union" "unsafe" "use" "where" "while" (crate) (self) (super)
@@ -176,8 +176,11 @@ to be checked as its standard input."
:language 'rust
:feature 'definition
'((function_item name: (identifier) @font-lock-function-name-face)
+ (function_signature_item name: (identifier) @font-lock-function-name-face)
(macro_definition "macro_rules!" @font-lock-constant-face)
(macro_definition (identifier) @font-lock-preprocessor-face)
+ (token_binding_pattern
+ name: (metavariable) @font-lock-variable-name-face)
(field_declaration name: (field_identifier) @font-lock-property-name-face)
(parameter pattern: (_) @rust-ts-mode--fontify-pattern)
(closure_parameters (_) @rust-ts-mode--fontify-pattern)
@@ -210,7 +213,11 @@ to be checked as its standard input."
:language 'rust
:feature 'keyword
- `([,@rust-ts-mode--keywords] @font-lock-keyword-face)
+ `([,@rust-ts-mode--keywords] @font-lock-keyword-face
+ ;; If these keyword are in a macro body, they're marked as
+ ;; identifiers.
+ ((identifier) @font-lock-keyword-face
+ (:match ,(rx bos (or "else" "in" "move") eos) @font-lock-keyword-face)))
:language 'rust
:feature 'number
@@ -218,7 +225,9 @@ to be checked as its standard input."
:language 'rust
:feature 'operator
- `([,@rust-ts-mode--operators] @font-lock-operator-face)
+ `([,@rust-ts-mode--operators] @font-lock-operator-face
+ (token_repetition_pattern ["$" "*" "+"] @font-lock-operator-face)
+ (token_repetition ["$" "*" "+"] @font-lock-operator-face))
:language 'rust
:feature 'string
@@ -248,8 +257,7 @@ to be checked as its standard input."
(_ type: (scoped_identifier
path: (identifier) @font-lock-type-face))))
(mod_item name: (identifier) @font-lock-constant-face)
- (primitive_type) @font-lock-type-face
- (type_identifier) @font-lock-type-face
+ [(fragment_specifier) (primitive_type) (type_identifier)]
@font-lock-type-face
((scoped_identifier name: (identifier) @rust-ts-mode--fontify-tail))
((scoped_identifier path: (identifier) @font-lock-type-face)
(:match ,(rx bos
@@ -259,8 +267,7 @@ to be checked as its standard input."
eos)
@font-lock-type-face))
((scoped_identifier path: (identifier) @rust-ts-mode--fontify-scope))
- ((scoped_type_identifier path: (identifier) @rust-ts-mode--fontify-scope))
- (type_identifier) @font-lock-type-face)
+ ((scoped_type_identifier path: (identifier)
@rust-ts-mode--fontify-scope)))
:language 'rust
:feature 'property
@@ -294,7 +301,8 @@ to be checked as its standard input."
(return_expression (identifier) @font-lock-variable-use-face)
(tuple_expression (identifier) @font-lock-variable-use-face)
(unary_expression (identifier) @font-lock-variable-use-face)
- (while_expression condition: (identifier) @font-lock-variable-use-face))
+ (while_expression condition: (identifier) @font-lock-variable-use-face)
+ (metavariable) @font-lock-variable-use-face)
:language 'rust
:feature 'escape-sequence
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 20c9e00edbf..a348e9ba6fd 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1435,7 +1435,8 @@ If FORCE is non-nil and no process found, create one."
(defun sh-show-shell ()
"Pop the shell interaction buffer."
(interactive)
- (pop-to-buffer (process-buffer (sh-shell-process t))
display-comint-buffer-action))
+ (with-suppressed-warnings ((obsolete display-comint-buffer-action))
+ (pop-to-buffer (process-buffer (sh-shell-process t))
display-comint-buffer-action)))
(defun sh-send-text (text)
"Send TEXT to `sh-shell-process'."
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 604f04a3d57..5273ba2bee1 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -3721,6 +3721,8 @@ prompts (`sql-output-newline-count' is positive). In
this case:
(save-excursion
;; Set product context
(with-current-buffer sql-buffer
+ ;; Make sure point is at EOB before sending input to SQL.
+ (goto-char (point-max))
(when sql-debug-send
(message ">>SQL> %S" s))
(insert "\n")
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 755c3db04fd..af77e860020 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1199,11 +1199,9 @@ to that style. Otherwise it is returned unchanged."
;; values themselves (e.g. by piping through some public function),
;; or adding a new accessor to locations, like GROUP-TYPE.
(cl-ecase xref-file-name-display
- (abs group)
+ (abs (if (file-name-absolute-p group) group (expand-file-name group)))
(nondirectory
- (if (file-name-absolute-p group)
- (file-name-nondirectory group)
- group))
+ (file-name-nondirectory group))
(project-relative
(if (and project-root
(string-prefix-p project-root group))
@@ -1269,7 +1267,7 @@ Return an alist of the form ((GROUP . (XREF ...)) ...)."
(erase-buffer)
(setq overlay-arrow-position nil)
(xref--insert-xrefs xref-alist)
- (add-hook 'post-command-hook 'xref--apply-truncation nil t)
+ (add-hook 'post-command-hook #'xref--apply-truncation nil t)
(goto-char (point-min))
(setq xref--original-window (assoc-default 'window alist)
xref--original-window-intent (assoc-default 'display-action alist))
@@ -1279,11 +1277,11 @@ Return an alist of the form ((GROUP . (XREF ...)) ...)."
"Refresh the search results in the current buffer."
(interactive)
(let ((inhibit-read-only t)
- (buffer-undo-list t)
- (inhibit-modification-hooks t))
+ (buffer-undo-list t))
(save-excursion
(condition-case err
- (let ((alist (xref--analyze (funcall xref--fetcher))))
+ (let ((alist (xref--analyze (funcall xref--fetcher)))
+ (inhibit-modification-hooks t))
(erase-buffer)
(xref--insert-xrefs alist))
(user-error
@@ -1922,7 +1920,9 @@ to control which program to use when looking for matches."
(hits nil)
;; Support for remote files. The assumption is that, if the
;; first file is remote, they all are, and on the same host.
- (dir (file-name-directory (car files)))
+ (dir (if (file-name-absolute-p (car files))
+ (file-name-directory (car files))
+ default-directory))
(remote-id (file-remote-p dir))
;; The 'auto' default would be fine too, but ripgrep can't handle
;; the options we pass in that case.
@@ -2082,12 +2082,17 @@ Such as the current syntax table and the applied syntax
properties."
(defvar xref--last-file-buffer nil)
(defvar xref--temp-buffer-file-name nil)
(defvar xref--hits-remote-id nil)
+(defvar xref--hits-file-prefix nil)
(defun xref--convert-hits (hits regexp)
- (let (xref--last-file-buffer
- (tmp-buffer (generate-new-buffer " *xref-temp*"))
- (xref--hits-remote-id (file-remote-p default-directory))
- (syntax-needed (xref--regexp-syntax-dependent-p regexp)))
+ (let* (xref--last-file-buffer
+ (tmp-buffer (generate-new-buffer " *xref-temp*"))
+ (xref--hits-remote-id (file-remote-p default-directory))
+ (xref--hits-file-prefix (if (and hits (file-name-absolute-p (cadar
hits)))
+ ;; TODO: Add some test for this.
+ xref--hits-remote-id
+ (expand-file-name default-directory)))
+ (syntax-needed (xref--regexp-syntax-dependent-p regexp)))
(unwind-protect
(mapcan (lambda (hit)
(xref--collect-matches hit regexp tmp-buffer syntax-needed))
@@ -2096,9 +2101,8 @@ Such as the current syntax table and the applied syntax
properties."
(defun xref--collect-matches (hit regexp tmp-buffer syntax-needed)
(pcase-let* ((`(,line ,file ,text) hit)
- (file (and file (concat xref--hits-remote-id file)))
- (buf (xref--find-file-buffer file))
- (inhibit-modification-hooks t))
+ (file (and file (concat xref--hits-file-prefix file)))
+ (buf (xref--find-file-buffer file)))
(if buf
(with-current-buffer buf
(save-excursion
@@ -2113,6 +2117,9 @@ Such as the current syntax table and the applied syntax
properties."
;; Using the temporary buffer is both a performance and a buffer
;; management optimization.
(with-current-buffer tmp-buffer
+ ;; This let is fairly dangerouns, but improves performance
+ ;; for large lists, see https://debbugs.gnu.org/53749#227
+ (let ((inhibit-modification-hooks t))
(erase-buffer)
(when (and syntax-needed
(not (equal file xref--temp-buffer-file-name)))
@@ -2127,8 +2134,10 @@ Such as the current syntax table and the applied syntax
properties."
(setq-local xref--temp-buffer-file-name file)
(setq-local inhibit-read-only t)
(erase-buffer))
- (insert text)
+ (insert text))
(goto-char (point-min))
+ (when syntax-needed
+ (syntax-ppss-flush-cache (point)))
(xref--collect-matches-1 regexp file line
(point)
(point-max)
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 0a59494c097..374a925d70c 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -553,20 +553,27 @@ This function can be used to force exit of repetition
while it's active."
(defun repeat-echo-message-string (keymap)
"Return a string with the list of repeating keys in KEYMAP."
(let (keys)
- (map-keymap (lambda (key cmd) (and cmd (push key keys))) keymap)
- (format-message "Repeat with %s%s"
- (mapconcat (lambda (key)
- (substitute-command-keys
- (format "\\`%s'"
- (key-description (vector key)))))
- keys ", ")
- (if repeat-exit-key
- (substitute-command-keys
- (format ", or exit with \\`%s'"
- (if (key-valid-p repeat-exit-key)
- repeat-exit-key
- (key-description repeat-exit-key))))
- ""))))
+ (map-keymap (lambda (key cmd) (and cmd (push (cons key cmd) keys)))
+ keymap)
+ (format-message
+ "Repeat with %s%s"
+ (mapconcat (lambda (key-cmd)
+ (let ((key (car key-cmd))
+ (cmd (cdr key-cmd)))
+ (if-let ((hint (and (symbolp cmd)
+ (get cmd 'repeat-hint))))
+ ;; Reuse `read-multiple-choice' formatting.
+ (cdr (rmc--add-key-description (list key hint)))
+ (propertize (key-description (vector key))
+ 'face 'read-multiple-choice-face))))
+ keys ", ")
+ (if repeat-exit-key
+ (substitute-command-keys
+ (format ", or exit with \\`%s'"
+ (if (key-valid-p repeat-exit-key)
+ repeat-exit-key
+ (key-description repeat-exit-key))))
+ ""))))
(defun repeat-echo-message (keymap)
"Display in the echo area the repeating keys defined by KEYMAP.
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index bce6a1805bc..c7e85b04cfd 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -350,7 +350,7 @@ nothing is dragged.")
(defun ruler-mode-text-scaled-width (width)
"Compute scaled text width according to current font scaling.
-Convert a width of char units into a text-scaled char width units,
+Convert a WIDTH of char units into a text-scaled char width units,
for example `window-hscroll'."
(/ (* width (frame-char-width)) (default-font-width)))
@@ -528,7 +528,7 @@ START-EVENT is the mouse click event."
(defvar ruler-mode-header-line-format-old nil
"Hold previous value of `header-line-format'.")
-(defvar ruler-mode-ruler-function 'ruler-mode-ruler
+(defvar ruler-mode-ruler-function #'ruler-mode-ruler
"Function to call to return ruler header line format.
This variable is expected to be made buffer-local by modes.")
@@ -563,7 +563,7 @@ format first."
(ruler--save-header-line-format))
(setq ruler-mode enable)))
(if ruler-mode
- (add-hook 'post-command-hook 'force-mode-line-update nil t)
+ (add-hook 'post-command-hook #'force-mode-line-update nil t)
;; When `ruler-mode' is off restore previous header line format if
;; the current one is the ruler header line format.
(when (eq header-line-format ruler-mode-header-line-format)
@@ -571,7 +571,7 @@ format first."
(when (local-variable-p 'ruler-mode-header-line-format-old)
(setq header-line-format ruler-mode-header-line-format-old)
(kill-local-variable 'ruler-mode-header-line-format-old)))
- (remove-hook 'post-command-hook 'force-mode-line-update t)))
+ (remove-hook 'post-command-hook #'force-mode-line-update t)))
;; Add ruler-mode to the minor mode menu in the mode line
(define-key mode-line-mode-menu [ruler-mode]
@@ -625,7 +625,7 @@ mouse-2: unset goal column"
(defsubst ruler-mode-space (width &rest props)
"Return a single space string of WIDTH times the normal character width.
Optional argument PROPS specifies other text properties to apply."
- (apply 'propertize " " 'display (list 'space :width width) props))
+ (apply #'propertize " " 'display (list 'space :width width) props))
(defun ruler-mode-ruler ()
"Compute and return a header line ruler."
@@ -665,29 +665,26 @@ Optional argument PROPS specifies other text properties
to apply."
'face 'ruler-mode-pad))
;; Remember the scrollbar vertical type.
(sbvt (car (window-current-scroll-bars)))
- ;; Create an "clean" ruler.
+ ;; Create a "clean" ruler.
(ruler
- (propertize
- ;; Make the part of header-line corresponding to the
- ;; line-number display be blank, not filled with
- ;; ruler-mode-basic-graduation-char.
- (if display-line-numbers
- (let* ((lndw (round (line-number-display-width 'columns)))
- ;; We need a multibyte string here so we could
- ;; later use aset to insert multibyte characters
- ;; into that string.
- (s (make-string lndw ?\s t)))
- (concat s (make-string (- w lndw)
- ruler-mode-basic-graduation-char t)))
- (make-string w ruler-mode-basic-graduation-char t))
- 'face 'ruler-mode-default
- 'local-map ruler-mode-map
- 'help-echo (cond
- (ruler-mode-show-tab-stops
- ruler-mode-ruler-help-echo-when-tab-stops)
- (goal-column
- ruler-mode-ruler-help-echo-when-goal-column)
- (ruler-mode-ruler-help-echo))))
+ ;; Make the part of header-line corresponding to the
+ ;; line-number display be blank, not filled with
+ ;; ruler-mode-basic-graduation-char.
+ (if (> i 0)
+ (vconcat (make-vector i ?\s)
+ (make-vector (- w i)
+ ruler-mode-basic-graduation-char))
+ (make-vector w ruler-mode-basic-graduation-char)))
+ (ruler-wide-props
+ `( face ruler-mode-default
+ ;; This is redundant with the minor mode map.
+ ;;local-map ruler-mode-map
+ help-echo ,(cond (ruler-mode-show-tab-stops
+ ruler-mode-ruler-help-echo-when-tab-stops)
+ (goal-column
+ ruler-mode-ruler-help-echo-when-goal-column)
+ (ruler-mode-ruler-help-echo))))
+ (props nil)
k c)
;; Setup the active area.
(while (< i w)
@@ -698,9 +695,7 @@ Optional argument PROPS specifies other text properties to
apply."
(setq c (number-to-string (/ j 10))
m (length c)
k i)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-column-number
- ruler)
+ (push `(,i ,(1+ i) face ruler-mode-column-number) props)
(while (and (> m 0) (>= k 0))
(aset ruler k (aref c (setq m (1- m))))
(setq k (1- k))))
@@ -712,62 +707,53 @@ Optional argument PROPS specifies other text properties
to apply."
;; Show the `current-column' marker.
((= j (current-column))
(aset ruler i ruler-mode-current-column-char)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-current-column
- ruler))
+ (push `(,i ,(1+ i) face ruler-mode-current-column) props))
;; Show the `goal-column' marker.
((and goal-column (= j goal-column))
(aset ruler i ruler-mode-goal-column-char)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-goal-column
- ruler)
- (put-text-property
- i (1+ i) 'mouse-face 'mode-line-highlight
- ruler)
- (put-text-property
- i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
- ruler))
+ (push `(,i ,(1+ i)
+ help-echo ,ruler-mode-goal-column-help-echo
+ face ruler-mode-goal-column
+ mouse-face mode-line-highlight)
+ props))
;; Show the `comment-column' marker.
((= j comment-column)
(aset ruler i ruler-mode-comment-column-char)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-comment-column
- ruler)
- (put-text-property
- i (1+ i) 'mouse-face 'mode-line-highlight
- ruler)
- (put-text-property
- i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
- ruler))
+ (push `(,i ,(1+ i)
+ help-echo ,ruler-mode-comment-column-help-echo
+ face ruler-mode-comment-column
+ mouse-face mode-line-highlight)
+ props))
;; Show the `fill-column' marker.
((= j fill-column)
(aset ruler i ruler-mode-fill-column-char)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-fill-column
- ruler)
- (put-text-property
- i (1+ i) 'mouse-face 'mode-line-highlight
- ruler)
- (put-text-property
- i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
- ruler))
+ (push `(,i ,(1+ i)
+ help-echo ,ruler-mode-fill-column-help-echo
+ face ruler-mode-fill-column
+ mouse-face mode-line-highlight)
+ props))
;; Show the `tab-stop-list' markers.
((and ruler-mode-show-tab-stops (= j (indent-next-tab-stop (1- j))))
(aset ruler i ruler-mode-tab-stop-char)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-tab-stop
- ruler)))
+ (push `(,i ,(1+ i) face ruler-mode-tab-stop) props)))
(setq i (1+ i)
j (1+ j)))
- ;; Return the ruler propertized string. Using list here,
- ;; instead of concat visually separate the different areas.
- (if (nth 2 (window-fringes))
- ;; fringes outside margins.
- (list "" (and (eq 'left sbvt) sb) lf lm
- ruler rm rf (and (eq 'right sbvt) sb))
- ;; fringes inside margins.
- (list "" (and (eq 'left sbvt) sb) lm lf
- ruler rf rm (and (eq 'right sbvt) sb)))))
+
+ (let ((ruler-str (concat ruler))
+ (len (length ruler)))
+ (add-text-properties 0 len ruler-wide-props ruler-str)
+ (dolist (p (nreverse props))
+ (add-text-properties (nth 0 p) (nth 1 p) (nthcdr 2 p) ruler-str))
+
+ ;; Return the ruler propertized string. Using list here,
+ ;; instead of concat visually separate the different areas.
+ (if (nth 2 (window-fringes))
+ ;; fringes outside margins.
+ (list "" (and (eq 'left sbvt) sb) lf lm
+ ruler-str rm rf (and (eq 'right sbvt) sb))
+ ;; fringes inside margins.
+ (list "" (and (eq 'left sbvt) sb) lm lf
+ ruler-str rf rm (and (eq 'right sbvt) sb))))))
(provide 'ruler-mode)
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index 1358bff6da8..01e47ccebbe 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -172,7 +172,7 @@ created in the future."
(defun toggle-scroll-bar (arg)
"Toggle whether or not the selected frame has vertical scroll bars.
-With ARG, turn vertical scroll bars on if and only if ARG is positive.
+With ARG, turn on vertical scroll bars if and only if ARG is positive.
The variable `scroll-bar-mode' controls which side the scroll bars are on
when they are turned on; if it is nil, they go on the left."
(interactive "P")
@@ -188,7 +188,7 @@ when they are turned on; if it is nil, they go on the left."
(defun toggle-horizontal-scroll-bar (arg)
"Toggle whether or not the selected frame has horizontal scroll bars.
-With ARG, turn vertical scroll bars on if and only if ARG is positive."
+With ARG, turn on horizontal scroll bars if and only if ARG is positive."
(interactive "P")
(if (null arg)
(setq arg
diff --git a/lisp/shell.el b/lisp/shell.el
index cd49d289403..e6b315ee5c0 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -923,7 +923,8 @@ Make the shell buffer the current buffer, and return it.
(current-buffer)))
;; The buffer's window must be correctly set when we call comint
;; (so that comint sets the COLUMNS env var properly).
- (pop-to-buffer buffer display-comint-buffer-action)
+ (with-suppressed-warnings ((obsolete display-comint-buffer-action))
+ (pop-to-buffer buffer display-comint-buffer-action))
(with-connection-local-variables
(when file-name
diff --git a/lisp/simple.el b/lisp/simple.el
index e4629ce3db7..ae8a824cb54 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1762,7 +1762,9 @@ not at the start of a line.
When IGNORE-INVISIBLE-LINES is non-nil, invisible lines are not
included in the count."
- (declare (side-effect-free t))
+ (declare (ftype (function ((or integer marker) (or integer marker) &optional
t)
+ integer))
+ (side-effect-free t))
(save-excursion
(save-restriction
(narrow-to-region start end)
@@ -2703,15 +2705,14 @@ function as needed."
(or (stringp doc)
(fixnump doc) (fixnump (cdr-safe doc))))))
(pcase function
- ((pred byte-code-function-p)
+ ((pred closurep)
(when (> (length function) 4)
(let ((doc (aref function 4)))
(when (funcall docstring-p doc) doc))))
((or (pred stringp) (pred vectorp)) "Keyboard macro.")
(`(keymap . ,_)
"Prefix command (definition is a keymap associating keystrokes with
commands).")
- ((or `(lambda ,_args . ,body) `(closure ,_env ,_args . ,body)
- `(autoload ,_file . ,body))
+ ((or `(lambda ,_args . ,body) `(autoload ,_file . ,body))
(let ((doc (car body)))
(when (funcall docstring-p doc)
doc)))
@@ -2875,11 +2876,13 @@ Normally, history elements are matched
case-insensitively if
makes the search case-sensitive.
See also `minibuffer-history-case-insensitive-variables'."
(interactive
- (let* ((enable-recursive-minibuffers t)
+ (let* ((n (prefix-numeric-value current-prefix-arg))
+ (enable-recursive-minibuffers t)
(regexp (read-from-minibuffer
- (format-prompt "Previous element matching regexp"
+ (format-prompt "%s element matching regexp"
(and minibuffer-history-search-history
- (car
minibuffer-history-search-history)))
+ (car minibuffer-history-search-history))
+ (if (>= n 0) "Previous" "Next"))
nil minibuffer-local-map nil
'minibuffer-history-search-history
(car minibuffer-history-search-history))))
@@ -2887,9 +2890,9 @@ See also `minibuffer-history-case-insensitive-variables'."
(list (if (string= regexp "")
(if minibuffer-history-search-history
(car minibuffer-history-search-history)
- (user-error "No previous history search regexp"))
+ (user-error "No history search regexp"))
regexp)
- (prefix-numeric-value current-prefix-arg))))
+ n)))
(unless (zerop n)
(if (and (zerop minibuffer-history-position)
(null minibuffer-text-before-history))
@@ -2947,20 +2950,23 @@ Normally, history elements are matched
case-insensitively if
`case-fold-search' is non-nil, but an uppercase letter in REGEXP
makes the search case-sensitive."
(interactive
- (let* ((enable-recursive-minibuffers t)
- (regexp (read-from-minibuffer "Next element matching (regexp): "
- nil
- minibuffer-local-map
- nil
- 'minibuffer-history-search-history
- (car
minibuffer-history-search-history))))
+ (let* ((n (prefix-numeric-value current-prefix-arg))
+ (enable-recursive-minibuffers t)
+ (regexp (read-from-minibuffer
+ (format-prompt "%s element matching regexp"
+ (and minibuffer-history-search-history
+ (car minibuffer-history-search-history))
+ (if (>= n 0) "Next" "Previous"))
+ nil minibuffer-local-map nil
+ 'minibuffer-history-search-history
+ (car minibuffer-history-search-history))))
;; Use the last regexp specified, by default, if input is empty.
(list (if (string= regexp "")
(if minibuffer-history-search-history
(car minibuffer-history-search-history)
- (user-error "No previous history search regexp"))
+ (user-error "No history search regexp"))
regexp)
- (prefix-numeric-value current-prefix-arg))))
+ n)))
(previous-matching-history-element regexp (- n)))
(defvar minibuffer-temporary-goal-position nil)
@@ -4857,11 +4863,14 @@ and are used only if a pop-up buffer is displayed."
;; We have a sentinel to prevent insertion of a termination message
;; in the buffer itself, and to set the point in the buffer when
;; `shell-command-dont-erase-buffer' is non-nil.
+;; For remote shells, `process-command' does not serve the proper shell
+;; command. We use process property `remote-command' instead. (Bug#71049)
(defun shell-command-sentinel (process signal)
(when (memq (process-status process) '(exit signal))
(shell-command-set-point-after-cmd (process-buffer process))
(message "%s: %s."
- (car (cdr (cdr (process-command process))))
+ (car (cdr (cdr (or (process-get process 'remote-command)
+ (process-command process)))))
(substring signal 0 -1))))
(defun shell-command-on-region (start end command
@@ -4922,7 +4931,14 @@ interactively, this is t.
Non-nil REGION-NONCONTIGUOUS-P means that the region is composed of
noncontiguous pieces. The most common example of this is a
rectangular region, where the pieces are separated by newline
-characters."
+characters.
+
+If COMMAND names a shell (e.g., via `shell-file-name'), keep in mind
+that behavior of various shells when commands are piped to their
+standard input is shell- and system-dependent, and thus non-portable.
+The differences are especially prominent when the region includes
+more than one line, i.e. when piping to a shell commands with embedded
+newlines."
(interactive (let (string)
(unless (mark)
(user-error "The mark is not set now, so there is no
region"))
@@ -5104,7 +5120,13 @@ other cases, consider alternatives such as
`call-process' or
`process-lines', which do not invoke the shell. Consider using
built-in functions like `rename-file' instead of the external
command \"mv\". For more information, see Info node
-`(elisp)Security Considerations'."
+`(elisp)Security Considerations'.
+
+If COMMAND includes several separate commands to run one after
+the other, the separator between the individual commands needs
+to be shell- and system-dependent. In particular, the MS-Windows
+shell cmd.exe doesn't support commands with embedded newlines;
+use the \"&&\" separator instead."
(with-output-to-string
(with-current-buffer standard-output
(shell-command command t))))
@@ -6883,7 +6905,8 @@ is active, and returns an integer or nil in the usual way.
If you are using this in an editing command, you are most likely making
a mistake; see the documentation of `set-mark'."
- (declare (side-effect-free t))
+ (declare (ftype (function (&optional t) (or integer null)))
+ (side-effect-free t))
(if (or force (not transient-mark-mode) mark-active mark-even-if-inactive)
(marker-position (mark-marker))
(signal 'mark-inactive nil)))
@@ -9856,16 +9879,6 @@ Its value is a list of the form (START END) where START
is the place
where the completion should be inserted and END (if non-nil) is the end
of the text to replace. If END is nil, point is used instead.")
-(defvar completion-base-affixes nil
- "Base context of the text corresponding to the shown completions.
-This variable is used in the *Completions* buffer.
-Its value is a list of the form (PREFIX SUFFIX) where PREFIX is the text
-before the place where completion should be inserted, and SUFFIX is the text
-after the completion.")
-
-(defvar completion-use-base-affixes nil
- "Non-nil means to restore original prefix and suffix in the minibuffer.")
-
(defvar completion-list-insert-choice-function #'completion--replace
"Function to use to insert the text chosen in *Completions*.
Called with three arguments (BEG END TEXT), it should replace the text
@@ -10126,7 +10139,6 @@ minibuffer, but don't quit the completions window."
(with-current-buffer (window-buffer (posn-window (event-start event)))
(let ((buffer completion-reference-buffer)
(base-position completion-base-position)
- (base-affixes completion-base-affixes)
(insert-function completion-list-insert-choice-function)
(completion-no-auto-exit (if no-exit t completion-no-auto-exit))
(choice
@@ -10159,13 +10171,7 @@ minibuffer, but don't quit the completions window."
(with-current-buffer buffer
(choose-completion-string
choice buffer
- ;; Don't allow affixes to replace the whole buffer when not
- ;; in the minibuffer. Thus check for `completion-in-region-mode'
- ;; to ignore non-nil value of `completion-use-base-affixes' set by
- ;; `minibuffer-choose-completion'.
- (or (and (not completion-in-region-mode)
- completion-use-base-affixes base-affixes)
- base-position
+ (or base-position
;; If all else fails, just guess.
(list (choose-completion-guess-base-position choice)))
insert-function)))))
@@ -10321,11 +10327,9 @@ Called from `temp-buffer-show-hook'."
(buffer-substring (minibuffer-prompt-end) (point)))))))
(with-current-buffer standard-output
(let ((base-position completion-base-position)
- (base-affixes completion-base-affixes)
(insert-fun completion-list-insert-choice-function))
(completion-list-mode)
(setq-local completion-base-position base-position)
- (setq-local completion-base-affixes base-affixes)
(setq-local completion-list-insert-choice-function insert-fun))
(setq-local completion-reference-buffer mainbuf)
(if base-dir (setq default-directory base-dir))
@@ -11164,7 +11168,8 @@ killed."
(defun lax-plist-get (plist prop)
"Extract a value from a property list, comparing with `equal'."
- (declare (pure t) (side-effect-free t) (obsolete plist-get "29.1"))
+ (declare (ftype (function (list t) t))
+ (pure t) (side-effect-free t) (obsolete plist-get "29.1"))
(plist-get plist prop #'equal))
(defun lax-plist-put (plist prop val)
diff --git a/lisp/subr.el b/lisp/subr.el
index fba70342154..eda5b7ae31b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -451,7 +451,8 @@ This function accepts any number of arguments in ARGUMENTS.
Also see `always'."
;; Not declared `side-effect-free' because we don't want calls to it
;; elided; see `byte-compile-ignore'.
- (declare (pure t) (completion ignore))
+ (declare (ftype (function (&rest t) null))
+ (pure t) (completion ignore))
(interactive)
nil)
@@ -480,7 +481,8 @@ for the sake of consistency.
To alter the look of the displayed error messages, you can use
the `command-error-function' variable."
- (declare (advertised-calling-convention (string &rest args) "23.1"))
+ (declare (ftype (function (string &rest t) nil))
+ (advertised-calling-convention (string &rest args) "23.1"))
(signal 'error (list (apply #'format-message args))))
(defun user-error (format &rest args)
@@ -545,19 +547,22 @@ was called."
"Return t if NUMBER is zero."
;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because
;; = has a byte-code.
- (declare (pure t) (side-effect-free t)
+ (declare (ftype (function (number) boolean))
+ (pure t) (side-effect-free t)
(compiler-macro (lambda (_) `(= 0 ,number))))
(= 0 number))
(defun fixnump (object)
"Return t if OBJECT is a fixnum."
- (declare (side-effect-free error-free))
+ (declare (ftype (function (t) boolean))
+ (side-effect-free error-free))
(and (integerp object)
(<= most-negative-fixnum object most-positive-fixnum)))
(defun bignump (object)
"Return t if OBJECT is a bignum."
- (declare (side-effect-free error-free))
+ (declare (ftype (function (t) boolean))
+ (side-effect-free error-free))
(and (integerp object) (not (fixnump object))))
(defun lsh (value count)
@@ -570,7 +575,8 @@ Most uses of this function turn out to be mistakes. We
recommend
to use `ash' instead, unless COUNT could ever be negative, and
if, when COUNT is negative, your program really needs the special
treatment of negative COUNT provided by this function."
- (declare (compiler-macro
+ (declare (ftype (function (integer integer) integer))
+ (compiler-macro
(lambda (form)
(macroexp-warn-and-return
(format-message "avoid `lsh'; use `ash' instead")
@@ -748,7 +754,8 @@ treatment of negative COUNT provided by this function."
If LIST is nil, return nil.
If N is non-nil, return the Nth-to-last link of LIST.
If N is bigger than the length of LIST, return LIST."
- (declare (pure t) (side-effect-free t)) ; pure up to mutation
+ (declare (ftype (function (list &optional integer) list))
+ (pure t) (side-effect-free t)) ; pure up to mutation
(if n
(and (>= n 0)
(let ((m (safe-length list)))
@@ -1585,7 +1592,8 @@ See also `current-global-map'.")
(defun eventp (object)
"Return non-nil if OBJECT is an input event or event object."
- (declare (pure t) (side-effect-free error-free))
+ (declare (ftype (function (t) boolean))
+ (pure t) (side-effect-free error-free))
(or (integerp object)
(and (if (consp object)
(setq object (car object))
@@ -1652,7 +1660,8 @@ in the current Emacs session, then this function may
return nil."
(defsubst mouse-movement-p (object)
"Return non-nil if OBJECT is a mouse movement event."
- (declare (side-effect-free error-free))
+ (declare (ftype (function (t) boolean))
+ (side-effect-free error-free))
(eq (car-safe object) 'mouse-movement))
(defun mouse-event-p (object)
@@ -1961,7 +1970,8 @@ be a list of the form returned by `event-start' and
`event-end'."
(defun log10 (x)
"Return (log X 10), the log base 10 of X."
- (declare (side-effect-free t) (obsolete log "24.4"))
+ (declare (ftype (function (number) float))
+ (side-effect-free t) (obsolete log "24.4"))
(log x 10))
(set-advertised-calling-convention
@@ -2036,6 +2046,7 @@ instead; it will indirectly limit the specpdl stack size
as well.")
;;;; Alternate names for functions - these are not being phased out.
+(defalias 'drop #'nthcdr)
(defalias 'send-string #'process-send-string)
(defalias 'send-region #'process-send-region)
(defalias 'string= #'string-equal)
@@ -2270,7 +2281,9 @@ all symbols are bound before any of the VALUEFORMs are
evalled."
(let ((nbody (if (null binders)
(macroexp-progn body)
`(let ,(mapcar #'car binders)
- ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
+ ,@(mapcan (lambda (binder)
+ (and (cdr binder) (list `(setq ,@binder))))
+ binders)
,@body))))
(cond
;; All bindings are recursive.
@@ -3244,7 +3257,8 @@ It can be retrieved with `(process-get PROCESS
PROPNAME)'."
(defun memory-limit ()
"Return an estimate of Emacs virtual memory usage, divided by 1024."
- (declare (side-effect-free error-free))
+ (declare (ftype (function () integer))
+ (side-effect-free error-free))
(let ((default-directory temporary-file-directory))
(or (cdr (assq 'vsize (process-attributes (emacs-pid)))) 0)))
@@ -4768,7 +4782,14 @@ t (mix it with ordinary output), or a file name string.
If BUFFER is 0, `call-shell-region' returns immediately with value nil.
Otherwise it waits for COMMAND to terminate
and returns a numeric exit status or a signal description string.
-If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
+If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
+
+If COMMAND names a shell (e.g., via `shell-file-name'), keep in mind
+that behavior of various shells when commands are piped to their
+standard input is shell- and system-dependent, and thus non-portable.
+The differences are especially prominent when the region includes
+more than one line, i.e. when piping to a shell commands with embedded
+newlines."
(call-process-region start end
shell-file-name delete buffer nil
shell-command-switch command))
@@ -5676,13 +5697,25 @@ The SEPARATOR regexp defaults to \"\\s-+\"."
(defun subst-char-in-string (fromchar tochar string &optional inplace)
"Replace FROMCHAR with TOCHAR in STRING each time it occurs.
Unless optional argument INPLACE is non-nil, return a new string."
- (let ((i (length string))
- (newstr (if inplace string (copy-sequence string))))
- (while (> i 0)
- (setq i (1- i))
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr))
+ (if (and (not inplace)
+ (if (multibyte-string-p string)
+ (> (max fromchar tochar) 127)
+ (> tochar 255)))
+ ;; Avoid quadratic behaviour from resizing replacement.
+ (let ((res (string-replace (string fromchar) (string tochar) string)))
+ (unless (eq res string)
+ ;; Mend properties broken by the replacement.
+ ;; Not fast, but this case never was.
+ (dolist (p (object-intervals string))
+ (set-text-properties (nth 0 p) (nth 1 p) (nth 2 p) res)))
+ res)
+ (let ((i (length string))
+ (newstr (if inplace string (copy-sequence string))))
+ (while (> i 0)
+ (setq i (1- i))
+ (if (eq (aref newstr i) fromchar)
+ (aset newstr i tochar)))
+ newstr)))
(defun string-replace (from-string to-string in-string)
"Replace FROM-STRING with TO-STRING in IN-STRING each time it occurs."
@@ -6466,7 +6499,8 @@ To test whether a function can be called interactively,
use
`commandp'."
;; Kept around for now. See discussion at:
;; https://lists.gnu.org/r/emacs-devel/2020-08/msg00564.html
- (declare (obsolete called-interactively-p "23.2")
+ (declare (ftype (function () boolean))
+ (obsolete called-interactively-p "23.2")
(side-effect-free error-free))
(called-interactively-p 'interactive))
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index cd076664faf..dac57ce2070 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -298,9 +298,13 @@ It returns a list of the form (KEY KEY-BINDING CLOSE-P),
where:
nil otherwise."
(setq tab-bar--dragging-in-progress nil)
(if (posn-window posn)
- (let ((caption (car (posn-string posn))))
- (when caption
- (get-text-property 0 'menu-item caption)))
+ (let* ((caption (car (posn-string posn)))
+ (menu-item (when caption
+ (get-text-property 0 'menu-item caption))))
+ (when (equal menu-item '(global ignore nil))
+ (setf (nth 1 menu-item)
+ (key-binding (vector 'tab-bar last-nonmenu-event) t)))
+ menu-item)
;; Text-mode emulation of switching tabs on the tab bar.
;; This code is used when you click the mouse in the tab bar
;; on a console which has no window system but does have a mouse.
@@ -332,7 +336,7 @@ existing tab."
(setq tab-bar--dragging-in-progress t)
;; Don't close the tab when clicked on the close button. Also
;; don't add new tab on down-mouse. Let `tab-bar-mouse-1' do this.
- (unless (or (memq (car item) '(add-tab history-back history-forward))
+ (unless (or (memq (car item) '(add-tab history-back history-forward
global))
(nth 2 item))
(if (functionp (nth 1 item))
(call-interactively (nth 1 item))
@@ -347,7 +351,8 @@ regardless of where you click on it. Also add a new tab."
(let* ((item (tab-bar--event-to-item (event-start event)))
(tab-number (tab-bar--key-to-number (nth 0 item))))
(cond
- ((and (memq (car item) '(add-tab history-back history-forward))
+ ((and (memq (car item) '(add-tab history-back history-forward global))
+ (not (eq (nth 1 item) 'tab-bar-mouse-1))
(functionp (nth 1 item)))
(call-interactively (nth 1 item)))
((and (nth 2 item) (not (eq tab-number t)))
@@ -468,8 +473,8 @@ appropriate."
(tab-bar-select-tab number))))
;; Cancel the timer.
(cancel-timer timer)))
- ((and (memq (car item) '(add-tab history-back
- history-forward))
+ ((and (memq (car item) '( add-tab history-back
+ history-forward global))
(functionp (cadr item)))
;; This is some kind of button. Wait for the
;; tap to complete and press it.
@@ -1115,7 +1120,9 @@ When `tab-bar-format-global' is added to `tab-bar-format'
then modes that display information on the mode line
using `global-mode-string' will display the same text
on the tab bar instead."
- `((global menu-item ,(format-mode-line global-mode-string) ignore)))
+ (mapcar (lambda (string)
+ `(global menu-item ,(format-mode-line string) ignore))
+ global-mode-string))
(defun tab-bar-format-list (format-list)
(let ((i 0))
@@ -1440,13 +1447,11 @@ if it was visiting a file."
(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))))
+ (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))
@@ -1459,7 +1464,7 @@ if it was visiting a file."
(set-window-point window (nth 3 quad))))
(insert "\n"))
(goto-char (point-min))
- (setq buffer-read-only t)
+ (special-mode)
(set-window-buffer window new-buffer))))))
(defcustom tab-bar-select-restore-context t
@@ -1511,7 +1516,7 @@ Negative TAB-NUMBER counts tabs from the end of the tab
bar."
(when (and read-minibuffer-restore-windows minibuffer-was-active
(not tab-bar-minibuffer-restore-tab))
(setq-local tab-bar-minibuffer-restore-tab (1+ from-index))
- (add-hook 'minibuffer-exit-hook 'tab-bar-minibuffer-restore-tab nil t))
+ (add-hook 'minibuffer-exit-hook #'tab-bar-minibuffer-restore-tab nil t))
(unless (eq from-index to-index)
(let* ((from-tab (tab-bar--tab))
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 09081501705..fa52ccd81aa 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -387,7 +387,7 @@ Used only for `tab-line-tabs-mode-buffers' and
`tab-line-tabs-buffer-groups'.")
(defcustom tab-line-tabs-buffer-group-function
#'tab-line-tabs-buffer-group-by-mode
"Function to add a buffer to the appropriate group of tabs.
-Takes a buffer as arg and should return a group name as a string.
+Takes a buffer as argument and should return a group name as a string.
If the return value is nil, the buffer has no group, so \"No group\"
is displayed instead of a group name and the buffer is not grouped
together with other buffers.
@@ -408,15 +408,34 @@ as a group name."
:group 'tab-line
:version "30.1")
-(defvar tab-line-tabs-buffer-group-sort-function
+(defcustom tab-line-tabs-buffer-group-sort-function
#'tab-line-tabs-buffer-group-sort-by-name
- "Function to sort buffers in a group.")
+ "Function to sort buffers in a group."
+ :type '(choice (const :tag "Don't sort" nil)
+ (const :tag "Sort by name alphabetically"
+ tab-line-tabs-buffer-group-sort-by-name)
+ (function :tag "Custom function"))
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (set-default sym val)
+ (force-mode-line-update))
+ :group 'tab-line
+ :version "30.1")
(defun tab-line-tabs-buffer-group-sort-by-name (a b)
(string< (buffer-name a) (buffer-name b)))
-(defvar tab-line-tabs-buffer-groups-sort-function #'string<
- "Function to sort group names.")
+(defcustom tab-line-tabs-buffer-groups-sort-function #'string<
+ "Function to sort group names."
+ :type '(choice (const :tag "Don't sort" nil)
+ (const :tag "Sort alphabetically" string<)
+ (function :tag "Custom function"))
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (set-default sym val)
+ (force-mode-line-update))
+ :group 'tab-line
+ :version "30.1")
(defvar tab-line-tabs-buffer-groups mouse-buffer-menu-mode-groups
"How to group various major modes together in the tab line.
@@ -445,7 +464,8 @@ named the same as the mode.")
(defun tab-line-tabs-buffer-group-name (&optional buffer)
(if (functionp tab-line-tabs-buffer-group-function)
- (funcall tab-line-tabs-buffer-group-function buffer)))
+ (funcall tab-line-tabs-buffer-group-function buffer)
+ (tab-line-tabs-buffer-group-by-mode buffer)))
(defun tab-line-tabs-buffer-groups ()
"Return a list of tabs that should be displayed in the tab line.
@@ -455,13 +475,14 @@ If non-nil, `tab-line-tabs-buffer-group-function' is used
to
generate the group name."
(if (window-parameter nil 'tab-line-groups)
(let* ((buffers (funcall tab-line-tabs-buffer-list-function))
- (groups
- (seq-sort tab-line-tabs-buffer-groups-sort-function
- (delq nil (mapcar #'car (seq-group-by
- (lambda (buffer)
-
(tab-line-tabs-buffer-group-name
- buffer))
- buffers)))))
+ (groups (delq nil
+ (mapcar #'car
+ (seq-group-by
#'tab-line-tabs-buffer-group-name
+ buffers))))
+ (sorted-groups (if (functionp
tab-line-tabs-buffer-groups-sort-function)
+ (seq-sort
tab-line-tabs-buffer-groups-sort-function
+ groups)
+ groups))
(selected-group (window-parameter nil 'tab-line-group))
(tabs
(mapcar (lambda (group)
@@ -472,9 +493,8 @@ generate the group name."
(set-window-parameter nil
'tab-line-groups nil)
(set-window-parameter nil
'tab-line-group group)
(set-window-parameter nil
'tab-line-hscroll nil)))))
- groups)))
+ sorted-groups)))
tabs)
-
(let* ((window-parameter (window-parameter nil 'tab-line-group))
(group-name (tab-line-tabs-buffer-group-name (current-buffer)))
(group (prog1 (or window-parameter group-name "No group")
@@ -487,10 +507,9 @@ generate the group name."
(set-window-parameter nil
'tab-line-groups t)
(set-window-parameter nil 'tab-line-group
group)
(set-window-parameter nil
'tab-line-hscroll nil)))))
- (buffers
- (seq-filter (lambda (b)
- (equal (tab-line-tabs-buffer-group-name b) group))
- (funcall tab-line-tabs-buffer-list-function)))
+ (buffers (seq-filter (lambda (b)
+ (equal (tab-line-tabs-buffer-group-name b)
group))
+ (funcall tab-line-tabs-buffer-list-function)))
(sorted-buffers (if (functionp
tab-line-tabs-buffer-group-sort-function)
(seq-sort
tab-line-tabs-buffer-group-sort-function
buffers)
@@ -532,16 +551,16 @@ variable `tab-line-tabs-function'."
This means that switching to a buffer previously shown in the same
window will keep the same order of tabs that was before switching.
And newly displayed buffers are added to the end of the tab line."
- (let* ((old-buffers (window-parameter nil 'tab-line-fixed-window-buffers))
+ (let* ((old-buffers (window-parameter nil 'tab-line-buffers))
(new-buffers (sort (tab-line-tabs-window-buffers)
- (lambda (a b)
- (< (or (seq-position old-buffers a)
- most-positive-fixnum)
- (or (seq-position old-buffers b)
- most-positive-fixnum))))))
- (set-window-parameter nil 'tab-line-fixed-window-buffers new-buffers)
+ :key (lambda (buffer)
+ (or (seq-position old-buffers buffer)
+ most-positive-fixnum)))))
+ (set-window-parameter nil 'tab-line-buffers new-buffers)
new-buffers))
+(add-to-list 'window-persistent-parameters '(tab-line-buffers . t))
+
(defcustom tab-line-tab-name-format-function #'tab-line-tab-name-format-default
"Function to format a tab name.
@@ -959,6 +978,31 @@ is possible when `tab-line-switch-cycling' is non-nil."
(let ((switch-to-buffer-obey-display-actions nil))
(switch-to-buffer buffer))))))))
+(defun tab-line-mouse-move-tab (event)
+ "Move a tab to a different position on the tab line.
+This command should be bound to a drag event. It moves the tab
+at the mouse-down event to the position at mouse-up event.
+It can be used only when `tab-line-tabs-function' is
+customized to `tab-line-tabs-fixed-window-buffers'."
+ (interactive "e")
+ (when (eq tab-line-tabs-function #'tab-line-tabs-fixed-window-buffers)
+ (let* ((posnp1 (tab-line-event-start event))
+ (posnp2 (event-end event))
+ (string1 (car (posn-string posnp1)))
+ (string2 (car (posn-string posnp2)))
+ (buffer1 (when string1 (tab-line--get-tab-property 'tab string1)))
+ (buffer2 (when string2 (tab-line--get-tab-property 'tab string2)))
+ (window1 (posn-window posnp1))
+ (window2 (posn-window posnp2))
+ (buffers (window-parameter window1 'tab-line-buffers))
+ (pos2 (when buffer2 (seq-position buffers buffer2))))
+ (when (and (eq window1 window2) buffer1 pos2)
+ (setq buffers (delq buffer1 buffers))
+ (cl-pushnew buffer1 (nthcdr pos2 buffers))
+ (set-window-parameter window1 'tab-line-buffers buffers)
+ (set-window-parameter window1 'tab-line-cache nil)
+ (with-selected-window window1 (force-mode-line-update))))))
+
(defcustom tab-line-close-tab-function 'bury-buffer
"What to do upon closing a tab on the tab line.
@@ -1078,13 +1122,14 @@ However, return the correct mouse position list if
EVENT is a
"Toggle display of tab line in the windows displaying the current buffer."
:lighter nil
(let ((default-value '(:eval (tab-line-format))))
- (if tab-line-mode
- ;; Preserve the existing tab-line set outside of this mode
- (unless tab-line-format
- (setq tab-line-format default-value))
- ;; Reset only values set by this mode
- (when (equal tab-line-format default-value)
- (setq tab-line-format nil)))))
+ ;; Preserve the existing tab-line set outside of this mode
+ (if (or (null tab-line-format)
+ (equal tab-line-format default-value))
+ (if tab-line-mode
+ (setq tab-line-format default-value)
+ (setq tab-line-format nil))
+ (message "tab-line-format set outside of tab-line-mode, currently `%S'"
+ tab-line-format))))
(defcustom tab-line-exclude-modes
'(completion-list-mode)
@@ -1120,6 +1165,7 @@ of `tab-line-exclude', are exempt from `tab-line-mode'."
(global-set-key [tab-line down-mouse-3] 'tab-line-context-menu)
+(global-set-key [tab-line drag-mouse-1] 'tab-line-mouse-move-tab)
(global-set-key [tab-line mouse-4] 'tab-line-hscroll-left)
(global-set-key [tab-line mouse-5] 'tab-line-hscroll-right)
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 375191a8167..7278bee48d4 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -135,6 +135,10 @@ This information is useful, but it takes screen space away
from file names."
(put 'tar-superior-buffer 'permanent-local t)
(put 'tar-superior-descriptor 'permanent-local t)
+(defvar tar-archive-from-tar nil
+ "Non-nil if an arc-mode archive file is a member of a tar archive.")
+(put tar-archive-from-tar 'permanent-local t)
+
;; The Tar data is made up of bytes and better manipulated as bytes
;; and can be very large, so insert/delete can be costly. The summary we
;; want to display may contain non-ascii chars, of course, so we'd like it
@@ -1124,6 +1128,8 @@ return nil. Otherwise point is returned."
default-directory))
(set-buffer-modified-p nil)
(normal-mode) ; pick a mode.
+ (when (derived-mode-p 'archive-mode)
+ (setq-local tar-archive-from-tar t))
(setq-local tar-superior-buffer tar-buffer)
(setq-local tar-superior-descriptor descriptor)
(setq buffer-read-only read-only-p)
diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el
index 6512ef81ff7..3538f41aa84 100644
--- a/lisp/term/android-win.el
+++ b/lisp/term/android-win.el
@@ -532,7 +532,7 @@ accessible to other programs."
;; Coding systems used by androidvfs.c.
(define-ccl-program android-encode-jni
- `(2 ((loop
+ '(2 ((loop
(read r0)
(if (r0 < #x1) ; 0x0 is encoded specially in JNI environments.
((write #xc0)
@@ -564,7 +564,7 @@ accessible to other programs."
"Encode characters from the input buffer for Java virtual machines.")
(define-ccl-program android-decode-jni
- `(1 ((loop
+ '(1 ((loop
((read-if (r0 >= #x80) ; More than a one-byte sequence?
((if (r0 < #xe0)
;; Two-byte sequence; potentially a NULL
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 17af1f1d926..f523df9881e 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -4059,6 +4059,10 @@ You can bind this to the key C-c i in GNUS or mail by
adding to
(if (re-search-forward "^Subject: *" end-of-headers t)
(progn
(goto-char (match-end 0))
+ ;; Don't spell-check Subject if it comes from a
+ ;; received message: "Re:" indicates this is a reply
+ ;; to someone else's message, "[...]" indicates this
+ ;; is a subject of a forwarded message.
(if (and (not (looking-at ".*\\<Re\\>"))
(not (looking-at "\\[")))
(progn
diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el
index 0b5c6756ab9..e2de6959dc6 100644
--- a/lisp/textmodes/mhtml-mode.el
+++ b/lisp/textmodes/mhtml-mode.el
@@ -359,7 +359,7 @@ the rules from `css-mode'."
(add-hook 'before-change-functions #'c-foreign-truncate-lit-pos-cache nil t)
;; This is sort of a prog-mode as well as a text mode.
- (run-hooks 'prog-mode-hook))
+ (run-mode-hooks 'prog-mode-hook))
(put 'mhtml-mode 'flyspell-mode-predicate #'mhtml--flyspell-check-word)
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index 34f40ba689f..397b449a9c8 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -1048,7 +1048,14 @@ in order to only add another reference in the same cite
command."
((= l ?E) (car (reftex-get-bib-names "editor" entry)))
((= l ?h) (reftex-get-bib-field "howpublished" entry))
((= l ?i) (reftex-get-bib-field "institution" entry))
- ((= l ?j) (reftex-get-bib-field "journal" entry))
+ ((= l ?j) (let ((jr (reftex-get-bib-field "journal" entry)))
+ (if (string-empty-p jr)
+ ;; Biblatex prefers the alternative
+ ;; journaltitle field, so check if that
+ ;; exists in case journal is empty
+ (reftex-get-bib-field "journaltitle" entry)
+ ;; Standard BibTeX
+ jr)))
((= l ?k) (reftex-get-bib-field "key" entry))
((= l ?m) (reftex-get-bib-field "month" entry))
((= l ?n) (reftex-get-bib-field "number" entry))
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 0e15f7e6062..1f440ebf7d0 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1820,6 +1820,7 @@ This takes effect when first loading the library.")
(define-key map "\C-c\C-c#" #'html-id-anchor)
(define-key map "\C-c\C-ci" #'html-image)
(when html-quick-keys
+ (define-key map "\C-cp" #'html-paragraph)
(define-key map "\C-c-" #'html-horizontal-rule)
(define-key map "\C-cd" #'html-div)
(define-key map "\C-co" #'html-ordered-list)
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 02ee1242c72..97c950267c6 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -2035,7 +2035,8 @@ In the tex shell buffer this command behaves like
`comint-send-input'."
(defun tex-display-shell ()
"Make the TeX shell buffer visible in a window."
- (display-buffer (tex-shell-buf) display-tex-shell-buffer-action)
+ (with-suppressed-warnings ((obsolete display-tex-shell-buffer-action))
+ (display-buffer (tex-shell-buf) display-tex-shell-buffer-action))
(tex-recenter-output-buffer nil))
(defun tex-shell-sentinel (proc _msg)
@@ -2692,7 +2693,8 @@ line LINE of the window, or centered if LINE is nil."
(if (null tex-shell)
(message "No TeX output buffer")
(when-let ((window
- (display-buffer tex-shell display-tex-shell-buffer-action)))
+ (with-suppressed-warnings ((obsolete
display-tex-shell-buffer-action))
+ (display-buffer tex-shell
display-tex-shell-buffer-action))))
(with-selected-window window
(bury-buffer tex-shell)
(goto-char (point-max))
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 7896ad984df..fe9f5003f0b 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -75,6 +75,28 @@ question.
`existing-filename', `url', `email', `uuid', `word', `sentence',
`whitespace', `line', `face' and `page'.")
+(defvar forward-thing-provider-alist nil
+ "Alist of providers for moving forward to the end of the next \"thing\".
+This variable can be set globally, or appended to buffer-locally by
+modes, to provide functions that will move forward to the end of a
+\"thing\" at point. Each function should take a single argument
+BACKWARD, which is non-nil if the function should instead move to the
+beginning of the previous thing. The provider for \"thing\" that moves
+point by the smallest non-zero distance wins.
+
+You can use this variable in much the same way as
+`thing-at-point-provider-alist' (which see).")
+
+(defvar bounds-of-thing-at-point-provider-alist nil
+ "Alist of providers to return the bounds of a \"thing\" at point.
+This variable can be set globally, or appended to buffer-locally by
+modes, to provide functions that will return the bounds of a \"thing\"
+at point. The first provider for the \"thing\" that returns a non-nil
+value wins.
+
+You can use this variable in much the same way as
+`thing-at-point-provider-alist' (which see).")
+
;; Basic movement
;;;###autoload
@@ -84,11 +106,36 @@ THING should be a symbol specifying a type of syntactic
entity.
Possibilities include `symbol', `list', `sexp', `defun', `number',
`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
`line', and `page'."
- (let ((forward-op (or (get thing 'forward-op)
- (intern-soft (format "forward-%s" thing)))))
- (if (functionp forward-op)
- (funcall forward-op (or n 1))
- (error "Can't determine how to move over a %s" thing))))
+ (setq n (or n 1))
+ (if (assq thing forward-thing-provider-alist)
+ (let* ((backward (< n 0))
+ (reducer (if backward #'max #'min))
+ (limit (if backward (point-min) (point-max))))
+ (catch 'done
+ (dotimes (_ (abs n))
+ ;; Find the provider that moves point the smallest non-zero
+ ;; amount, and use that to update point.
+ (let ((new-point (seq-reduce
+ (lambda (value elt)
+ (if (eq (car elt) thing)
+ (save-excursion
+ (funcall (cdr elt) backward)
+ (if value
+ (funcall reducer value (point))
+ (point)))
+ value))
+ forward-thing-provider-alist nil)))
+ (if (and new-point (/= new-point (point)))
+ (goto-char new-point)
+ ;; If we didn't move point, move to our limit (min or max
+ ;; point), and terminate.
+ (goto-char limit)
+ (throw 'done t))))))
+ (let ((forward-op (or (get thing 'forward-op)
+ (intern-soft (format "forward-%s" thing)))))
+ (if (functionp forward-op)
+ (funcall forward-op n)
+ (error "Can't determine how to move over a %s" thing)))))
;; General routines
@@ -106,6 +153,10 @@ valid THING.
Return a cons cell (START . END) giving the start and end
positions of the thing found."
(cond
+ ((seq-some (lambda (elt)
+ (and (eq (car elt) thing)
+ (funcall (cdr elt))))
+ bounds-of-thing-at-point-provider-alist))
((get thing 'bounds-of-thing-at-point)
(funcall (get thing 'bounds-of-thing-at-point)))
;; If the buffer is totally empty, give up.
@@ -775,4 +826,50 @@ treated as white space."
(goto-char (or (nth 8 ppss) (point)))
(form-at-point 'list 'listp))))
+;; Provider helper functions
+
+(defun thing-at-point-for-char-property (property)
+ "Return the \"thing\" at point.
+Each \"thing\" is a region of text with the specified text PROPERTY (or
+overlay) set."
+ (or (get-char-property (point) property)
+ (and (> (point) (point-min))
+ (get-char-property (1- (point)) property))))
+
+(autoload 'text-property-search-forward "text-property-search")
+(autoload 'text-property-search-backward "text-property-search")
+(autoload 'prop-match-beginning "text-property-search")
+(autoload 'prop-match-end "text-property-search")
+
+(defun forward-thing-for-char-property (property &optional backward)
+ "Move forward to the end of the next \"thing\".
+If BACKWARD is non-nil, move backward to the beginning of the previous
+\"thing\" instead. Each \"thing\" is a region of text with the
+specified text PROPERTY (or overlay) set."
+ (let ((bounds (bounds-of-thing-at-point-for-char-property property)))
+ (if backward
+ (if (and bounds (> (point) (car bounds)))
+ (goto-char (car bounds))
+ (goto-char (previous-single-char-property-change (point) property))
+ (unless (get-char-property (point) property)
+ (goto-char (previous-single-char-property-change
+ (point) property))))
+ (if (and bounds (< (point) (cdr bounds)))
+ (goto-char (cdr bounds))
+ (unless (get-char-property (point) property)
+ (goto-char (next-single-char-property-change (point) property)))
+ (goto-char (next-single-char-property-change (point) property))))))
+
+(defun bounds-of-thing-at-point-for-char-property (property)
+ "Determine the start and end buffer locations for the \"thing\" at point.
+The \"thing\" is a region of text with the specified text PROPERTY (or
+overlay) set."
+ (let ((pos (point)))
+ (when (or (get-char-property pos property)
+ (and (> pos (point-min))
+ (get-char-property (setq pos (1- pos)) property)))
+ (cons (previous-single-char-property-change
+ (min (1+ pos) (point-max)) property)
+ (next-single-char-property-change pos property)))))
+
;;; thingatpt.el ends here
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 96b61c7b229..01c65c42324 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -100,7 +100,9 @@ parameter is set to `top', and above the tool bar it is set
to
(defconst tool-bar-keymap-cache (make-hash-table :test #'equal))
(defsubst tool-bar--cache-key ()
- (cons (frame-terminal) (sxhash-eq tool-bar-map)))
+ (cons (frame-terminal)
+ (sxhash-eq (if tool-bar-always-show-default (default-value
'tool-bar-map)
+ tool-bar-map))))
(defsubst tool-bar--secondary-cache-key ()
(cons (frame-terminal) (sxhash-eq secondary-tool-bar-map)))
@@ -191,7 +193,9 @@ in which case the value of `tool-bar-map' is used instead."
bind))
(plist-put plist :image image)))
bind))
- (or map tool-bar-map)))
+ (or map
+ (if tool-bar-always-show-default (default-value 'tool-bar-map)
+ tool-bar-map))))
;;;###autoload
(defun tool-bar-add-item (icon def key &rest props)
@@ -360,11 +364,12 @@ holds a keymap."
(if (featurep 'move-toolbar)
(defcustom tool-bar-position 'top
"Specify on which side the tool bar shall be.
-Possible values are `top' (tool bar on top), `bottom' (tool bar at bottom),
-`left' (tool bar on left) and `right' (tool bar on right).
-This option has effect only on graphical frames and only
-if Emacs was built with GTK.
-Customize `tool-bar-mode' if you want to show or hide the tool bar."
+Possible values are `top' (tool bar on top), `bottom' (tool bar at
+bottom), `left' (tool bar on left) and `right' (tool bar on right).
+This option takes effect only on graphical frames, the values `left' and
+`right' only if Emacs was built with GTK, and `bottom' only on systems
+besides Nextstep. Customize `tool-bar-mode' if you want to show or hide
+the tool bar."
:version "24.1"
:type '(choice (const top)
(const bottom)
@@ -377,6 +382,15 @@ Customize `tool-bar-mode' if you want to show or hide the
tool bar."
(modify-all-frames-parameters
(list (cons 'tool-bar-position val))))))
+(defcustom tool-bar-always-show-default nil
+ "If non-nil, `tool-bar-mode' only shows the default tool bar.
+This works well when also using `global-window-tool-bar-mode' to
+display buffer-specific tool bars."
+ :type 'boolean
+ :group 'frames
+ :group 'mouse
+ :version "30.1")
+
;; Modifier bar mode.
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 4537fdf8087..6c2fe36ed9d 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -178,7 +178,7 @@ rest are not called.")
"Return the buffer over which event EVENT occurred.
This might return nil if the event did not occur over a buffer."
(let ((window (posn-window (event-end event))))
- (and window (window-buffer window))))
+ (and (windowp window) (window-buffer window))))
;;; Timeout for tooltip display
diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el
index 037386112d3..ca02ca3caf6 100644
--- a/lisp/touch-screen.el
+++ b/lisp/touch-screen.el
@@ -154,6 +154,17 @@ selected.")
Used in an attempt to keep this word selected during later
dragging.")
+;; Should this variable be documented?
+(defvar-local touch-screen-keyboard-function nil
+ "Function that decides whether to display the on screen keyboard.
+If set, this function is called with point set to the position of the
+tap involved when a command listed in `touch-screen-set-point-commands'
+is about to be invoked in response to a tap, the current buffer, or the
+text beneath point (in the case of an `inhibit-read-only' text
+property), is not read only, and `touch-screen-display-keyboard' is nil,
+and should return non-nil if it is appropriate to display the on-screen
+keyboard afterwards.")
+
;;; Scroll gesture.
@@ -351,7 +362,8 @@ word around EVENT; otherwise, set point to the location of
EVENT."
touch-screen-word-select-bounds nil)
(push-mark point)
(goto-char point)
- (activate-mark))
+ (activate-mark)
+ (setq deactivate-mark nil))
;; Start word selection by trying to obtain the position
;; around point.
(let ((word-start nil)
@@ -381,7 +393,8 @@ word around EVENT; otherwise, set point to the location of
EVENT."
touch-screen-word-select-initial-word nil)
(push-mark point)
(goto-char point)
- (activate-mark))
+ (activate-mark)
+ (setq deactivate-mark nil))
;; Otherwise, select the word. Move point to either the
;; end or the start of the word, depending on which is
;; closer to EVENT.
@@ -420,10 +433,12 @@ word around EVENT; otherwise, set point to the location
of EVENT."
(progn
(push-mark word-start)
(activate-mark)
+ (setq deactivate-mark nil)
(goto-char word-end))
(progn
(push-mark word-end)
(activate-mark)
+ (setq deactivate-mark nil)
(goto-char word-start)))
;; Record the bounds of the selected word.
(setq touch-screen-word-select-bounds
@@ -837,7 +852,8 @@ area."
;; Display a preview of the line now around
;; point if requested by the user.
(when touch-screen-preview-select
- (touch-screen-preview-select))))))))))))))
+ (touch-screen-preview-select)))))))))))
+ (setq deactivate-mark nil))))
(defun touch-screen-restart-drag (event)
"Restart dragging to select text.
@@ -1334,7 +1350,9 @@ is not read-only."
;; Now simulate a mouse click there. If there is a
;; link or a button, use mouse-2 to push it.
(let* ((event (list (if (or (mouse-on-link-p posn)
- (and point (button-at point)))
+ (and point
+ (get-char-property
+ point 'button)))
'mouse-2
'mouse-1)
posn))
@@ -1351,21 +1369,38 @@ is not read-only."
;; Figure out if the on screen keyboard needs to be
;; displayed.
(when command
- (if (memq command touch-screen-set-point-commands)
+ (if (or (memq command touch-screen-set-point-commands)
+ ;; Users of packages that redefine
+ ;; `mouse-set-point', or other commands
+ ;; recognized as defining the point, should
+ ;; not find the on screen keyboard
+ ;; inaccessible even with
+ ;; `touch-screen-display-keyboard' enabled.
+ touch-screen-display-keyboard)
(if touch-screen-translate-prompt
;; Forgo displaying the virtual keyboard
- ;; should touch-screen-translate-prompt be
+ ;; should `touch-screen-translate-prompt' be
;; set, for then the key won't be delivered
;; to the command loop, but rather to a
- ;; caller of read-key-sequence such as
- ;; describe-key.
+ ;; caller of `read-key-sequence' such as
+ ;; `describe-key'.
(throw 'input-event event)
- (if (and (or (not buffer-read-only)
- touch-screen-display-keyboard)
- ;; Detect the splash screen and
- ;; avoid displaying the on screen
- ;; keyboard there.
- (not (equal (buffer-name) "*GNU Emacs*")))
+ (if (or touch-screen-display-keyboard
+ (and (or (not buffer-read-only)
+ inhibit-read-only
+ ;; Display the on screen
+ ;; keyboard even if just the
+ ;; text under point is not
+ ;; read-only.
+ (get-text-property
+ point 'inhibit-read-only))
+ ;; If the major mode has defined
+ ;; bespoke criteria for
+ ;; displaying the on screen
+ ;; keyboard, consult it here.
+ (or (not
touch-screen-keyboard-function)
+ (funcall
+ touch-screen-keyboard-function))))
;; Once the on-screen keyboard has been
;; opened, add
;; `touch-screen-window-selection-changed'
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 2b899a84183..0475227c726 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -61,6 +61,7 @@
(declare-function treesit-parser-set-included-ranges "treesit.c")
(declare-function treesit-parser-included-ranges "treesit.c")
+(declare-function treesit-parser-changed-ranges "treesit.c")
(declare-function treesit-parser-add-notifier "treesit.c")
(declare-function treesit-node-type "treesit.c")
@@ -816,6 +817,17 @@ OVERRIDE is the override flag for this query. Its value
can be
t, nil, append, prepend, keep. See more in
`treesit-font-lock-rules'.")
+(defsubst treesit--font-lock-setting-feature (setting)
+ "Reutrn the feature of SETTING.
+SETTING should be a setting in `treesit-font-lock-settings'."
+ (nth 2 setting))
+
+(defsubst treesit--font-lock-setting-enable (setting)
+ "Return enabled SETTING."
+ (let ((new-setting (copy-tree setting)))
+ (setf (nth 1 new-setting) t)
+ new-setting))
+
(defun treesit--font-lock-level-setter (sym val)
"Custom setter for `treesit-font-lock-level'.
Set the default value of SYM to VAL, recompute fontification
@@ -1094,6 +1106,43 @@ and leave settings for other languages unchanged."
((memq feature remove-list) nil)
(t current-value))))))
+(defun treesit-add-font-lock-rules (rules &optional how feature)
+ "Add font-lock RULES to the current buffer
+
+RULES should be the return value of `treesit-font-lock-rules'. RULES
+will be enabled and added to `treesit-font-lock-settings'.
+
+HOW can be either :before or :after. If HOW is :before, prepend RULES
+before all other existing font-lock rules in
+`treesit-font-lock-settings'; if :after or omitted, append RULES after
+all existing rules.
+
+If FEATURE is non-nil, add RULES before/after rules for FEATURE. See
+docstring of `treesit-font-lock-rules' for what is a feature."
+ (let ((rules (seq-map #'treesit--font-lock-setting-enable rules))
+ (feature-idx
+ (when feature
+ (cl-position-if
+ (lambda (setting)
+ (eq (treesit--font-lock-setting-feature setting) feature))
+ treesit-font-lock-settings))))
+ (pcase (cons how feature)
+ ((or '(:after . nil) '(nil . nil))
+ (setq treesit-font-lock-settings
+ (append treesit-font-lock-settings rules)))
+ ('(:before . nil)
+ (setq treesit-font-lock-settings
+ (append rules treesit-font-lock-settings)))
+ (`(:after . ,_feature)
+ (setf (nthcdr (1+ feature-idx) treesit-font-lock-settings)
+ (append rules
+ (nthcdr (1+ feature-idx)
+ treesit-font-lock-settings))))
+ (`(:before . ,_feature)
+ (setf (nthcdr feature-idx treesit-font-lock-settings)
+ (append rules
+ (nthcdr feature-idx treesit-font-lock-settings)))))))
+
(defun treesit-fontify-with-override
(start end face override &optional bound-start bound-end)
"Apply FACE to the region between START and END.
@@ -1328,18 +1377,6 @@ non-nil, print debugging information."
(max node-start start) (min node-end end)
face (treesit-node-type node)))))))))
-(defun treesit--font-lock-notifier (ranges parser)
- "Ensures updated parts of the parse-tree are refontified.
-RANGES is a list of (BEG . END) ranges, PARSER is the tree-sitter
-parser notifying of the change."
- (with-current-buffer (treesit-parser-buffer parser)
- (dolist (range ranges)
- (when treesit--font-lock-verbose
- (message "Notifier received range: %s-%s"
- (car range) (cdr range)))
- (with-silent-modifications
- (put-text-property (car range) (cdr range) 'fontified nil)))))
-
(defvar-local treesit--syntax-propertize-start nil
"If non-nil, next `syntax-propertize' should start at this position.
@@ -1348,20 +1385,6 @@ When tree-sitter parser reparses, it calls
and that function sets this variable to the start of the affected
region.")
-(defun treesit--syntax-propertize-notifier (ranges parser)
- "Sets `treesit--syntax-propertize-start' to the smallest start.
-Specifically, the smallest start position among all the ranges in
-RANGES for PARSER."
- (with-current-buffer (treesit-parser-buffer parser)
- (when-let* ((range-starts (mapcar #'car ranges))
- (min-range-start
- (seq-reduce
- #'min (cdr range-starts) (car range-starts))))
- (if (null treesit--syntax-propertize-start)
- (setq treesit--syntax-propertize-start min-range-start)
- (setq treesit--syntax-propertize-start
- (min treesit--syntax-propertize-start min-range-start))))))
-
(defvar-local treesit--pre-redisplay-tick nil
"The last `buffer-chars-modified-tick' that we've processed.
Because `pre-redisplay-functions' could be called multiple times
@@ -1369,32 +1392,47 @@ during a single command loop, we use this variable to
debounce
calls to `treesit--pre-redisplay'.")
(defun treesit--pre-redisplay (&rest _)
- "Force reparse and consequently run all notifiers.
-
-One of the notifiers is `treesit--font-lock-notifier', which will
-mark the region whose syntax has changed to \"need to refontify\".
-
-For example, when the user types the final slash of a C block
-comment /* xxx */, not only do we need to fontify the slash, but
-also the whole block comment, which previously wasn't fontified
-as comment due to incomplete parse tree."
+ "Force a reparse on the primary parser and do some work.
+
+After the parser reparses, we get the changed ranges, and
+1) update non-primary parsers' ranges in the changed ranges
+2) mark these ranges as to-be-fontified,
+3) tell syntax-ppss to start reparsing from the min point of the ranges
+
+We need to mark to-be-fontified ranges before redisplay starts working,
+because sometimes the range edited by the user is not the only range
+that needs to be refontified. For example, when the user types the
+final slash of a C block comment /* xxx */, not only do we need to
+fontify the slash, but also the whole block comment, which previously
+wasn't fontified as comment due to incomplete parse tree."
(unless (eq treesit--pre-redisplay-tick (buffer-chars-modified-tick))
- ;; `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.
- (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))
- (treesit-parser-root-node parser))
+ (let ((primary-parser
+ ;; TODO: We need something less ugly than this for getting
+ ;; the primary parser/language.
+ (if treesit-range-settings
+ (let ((query (car (car treesit-range-settings))))
+ (if (treesit-query-p query)
+ (treesit-parser-create
+ (treesit-query-language query))
+ (car (treesit-parser-list))))
+ (car (treesit-parser-list)))))
+ ;; Force a reparse on the primary parser.
+ (treesit-parser-root-node primary-parser)
+ (dolist (range (treesit-parser-changed-ranges primary-parser))
+ ;; 1. Update ranges.
+ (treesit-update-ranges (car range) (cdr range))
+ ;; 2. Mark the changed ranges to be fontified.
+ (when treesit--font-lock-verbose
+ (message "Notifier received range: %s-%s"
+ (car range) (cdr range)))
+ (with-silent-modifications
+ (put-text-property (car range) (cdr range) 'fontified nil))
+ ;; 3. Set `treesit--syntax-propertize-start'.
+ (if (null treesit--syntax-propertize-start)
+ (setq treesit--syntax-propertize-start (car range))
+ (setq treesit--syntax-propertize-start
+ (min treesit--syntax-propertize-start (car range))))))
+
(setq treesit--pre-redisplay-tick (buffer-chars-modified-tick))))
(defun treesit--pre-syntax-ppss (start end)
@@ -2846,15 +2884,21 @@ See the descriptions of arguments in
`outline-search-function'."
(start (treesit-node-start node)))
(eq (pos-bol) (save-excursion (goto-char start) (pos-bol))))
- (let* ((pos
+ (let* ((bob-pos
+ ;; `treesit-navigate-thing' can't find a thing at bobp,
+ ;; so use `looking-at' to match at bobp.
+ (and (bobp) (treesit-outline-search bound move backward t)
(point)))
+ (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)))
+ (unless bob-pos
+ (if (eq (point) (pos-bol))
+ (if (bobp) (point) (1- (point)))
+ (pos-eol))))
+ (found (or bob-pos
+ (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
@@ -2956,21 +3000,20 @@ before calling this function."
(font-lock-fontify-syntactically-function
. treesit-font-lock-fontify-region)))
(treesit-font-lock-recompute-features)
- (dolist (parser (treesit-parser-list))
- (treesit-parser-add-notifier
- parser #'treesit--font-lock-notifier))
(add-hook 'pre-redisplay-functions #'treesit--pre-redisplay 0 t))
;; Syntax
- (dolist (parser (treesit-parser-list))
- (treesit-parser-add-notifier
- parser #'treesit--syntax-propertize-notifier))
(add-hook 'syntax-propertize-extend-region-functions
#'treesit--pre-syntax-ppss 0 t)
;; Indent.
(when treesit-simple-indent-rules
(setq-local treesit-simple-indent-rules
(treesit--indent-rules-optimize
- treesit-simple-indent-rules))
+ treesit-simple-indent-rules)))
+ ;; Enable indent if simple indent rules are set, or the major mode
+ ;; sets a custom indent function.
+ (when (or treesit-simple-indent-rules
+ (and (not (eq treesit-indent-function #'treesit-simple-indent))
+ treesit-indent-function))
(setq-local indent-line-function #'treesit-indent)
(setq-local indent-region-function #'treesit-indent-region))
;; Navigation.
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 5f45b98c7a5..4d2609cbb95 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -242,45 +242,6 @@ Will not do anything if `url-show-status' is nil."
(setq retval (cons (list key val) retval)))))
retval))
-;;;###autoload
-(defun url-build-query-string (query &optional semicolons keep-empty)
- "Build a query-string.
-
-Given a QUERY in the form:
- ((key1 val1)
- (key2 val2)
- (key3 val1 val2)
- (key4)
- (key5 \"\"))
-
-\(This is the same format as produced by `url-parse-query-string')
-
-This will return a string
-\"key1=val1&key2=val2&key3=val1&key3=val2&key4&key5\". Keys may
-be strings or symbols; if they are symbols, the symbol name will
-be used.
-
-When SEMICOLONS is given, the separator will be \";\".
-
-When KEEP-EMPTY is given, empty values will show as \"key=\"
-instead of just \"key\" as in the example above."
- (mapconcat
- (lambda (key-vals)
- (let ((escaped
- (mapcar (lambda (sym)
- (url-hexify-string (format "%s" sym))) key-vals)))
- (mapconcat (lambda (val)
- (let ((vprint (format "%s" val))
- (eprint (format "%s" (car escaped))))
- (concat eprint
- (if (or keep-empty
- (and val (not (zerop (length vprint)))))
- "="
- "")
- vprint)))
- (or (cdr escaped) '("")) (if semicolons ";" "&"))))
- query (if semicolons ";" "&")))
-
(defun url-unhex (x)
(if (> x ?9)
(if (>= x ?a)
@@ -410,6 +371,15 @@ These characters are specified in RFC 3986, Appendix A.")
"Allowed-character byte mask for the query segment of a URI.
These characters are specified in RFC 3986, Appendix A.")
+(defconst url-query-key-value-allowed-chars
+ (let ((vec (copy-sequence url-query-allowed-chars)))
+ (aset vec ?= nil)
+ (aset vec ?& nil)
+ (aset vec ?\; nil)
+ vec)
+ "Allowed-charcter byte mask for keys and values in the query segment of a
URI.
+url-query-allowed-chars minus '=', '&', and ';'.")
+
;;;###autoload
(defun url-encode-url (url)
"Return a properly URI-encoded version of URL.
@@ -439,6 +409,47 @@ should return it unchanged."
(url-hexify-string frag url-query-allowed-chars)))
(url-recreate-url obj)))
+;;;###autoload
+(defun url-build-query-string (query &optional semicolons keep-empty)
+ "Build a query-string.
+
+Given a QUERY in the form:
+ ((key1 val1)
+ (key2 val2)
+ (key3 val1 val2)
+ (key4)
+ (key5 \"\"))
+
+\(This is the same format as produced by `url-parse-query-string')
+
+This will return a string
+\"key1=val1&key2=val2&key3=val1&key3=val2&key4&key5\". Keys may
+be strings or symbols; if they are symbols, the symbol name will
+be used.
+
+When SEMICOLONS is given, the separator will be \";\".
+
+When KEEP-EMPTY is given, empty values will show as \"key=\"
+instead of just \"key\" as in the example above."
+ (mapconcat
+ (lambda (key-vals)
+ (let ((escaped
+ (mapcar (lambda (sym)
+ (url-hexify-string (format "%s" sym)
+ url-query-key-value-allowed-chars))
+ key-vals)))
+ (mapconcat (lambda (val)
+ (let ((vprint (format "%s" val))
+ (eprint (format "%s" (car escaped))))
+ (concat eprint
+ (if (or keep-empty
+ (and val (not (zerop (length vprint)))))
+ "="
+ "")
+ vprint)))
+ (or (cdr escaped) '("")) (if semicolons ";" "&"))))
+ query (if semicolons ";" "&")))
+
;;;###autoload
(defun url-file-extension (fname &optional x)
"Return the filename extension of FNAME.
diff --git a/lisp/use-package/use-package-core.el
b/lisp/use-package/use-package-core.el
index ba2e93c97e9..bb12c3c4f2b 100644
--- a/lisp/use-package/use-package-core.el
+++ b/lisp/use-package/use-package-core.el
@@ -535,6 +535,24 @@ This is in contrast to merely setting it to 0."
(let ((xs (use-package-split-list (apply-partially #'eq key) lst)))
(cons (car xs) (use-package-split-list-at-keys key (cddr xs))))))
+(defun use-package-split-when (pred xs)
+ "Repeatedly split a list according to PRED.
+Split XS every time PRED returns t. Keep the delimiters, and
+arrange the result in an alist. For example:
+
+ (use-package-split-when #\\='keywordp \\='(:a 1 :b 2 3 4 :c 5))
+ ;; => \\='((:a 1) (:b 2 3 4) (:c 5))
+
+ (use-package-split-when (lambda (x) (> x 2)) \\='(10 1 3 2 4 -1 8 9))
+ ;; => \\='((10 1) (3 2) (4 -1) (8) (9))"
+ (unless (seq-empty-p xs)
+ (pcase-let* ((`(,first . ,rest) (if (funcall pred (car xs))
+ (cons (car xs) (cdr xs))
+ (use-package-split-list pred xs)))
+ (`(,val . ,recur) (use-package-split-list pred rest)))
+ (cons (cons first val)
+ (use-package-split-when pred recur)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Keywords
@@ -1648,6 +1666,12 @@ Also see the Info node `(use-package) Creating an
extension'."
(push `(use-package-vc-install ',arg ,local-path) body)) ; runtime
body))
+(defconst use-package-vc-valid-keywords
+ '( :url :branch :lisp-dir :main-file :vc-backend :rev
+ :shell-command :make :ignored-files)
+ "Valid keywords for the `:vc' keyword, see the Info
+node `(emacs)Fetching Package Sources'.")
+
(defun use-package-normalize--vc-arg (arg)
"Normalize possible arguments to the `:vc' keyword.
ARG is a cons-cell of approximately the form that
@@ -1669,23 +1693,27 @@ indicating the latest commit) revision."
(:newest nil)
(_ (ensure-string v))))
(:vc-backend (ensure-symbol v))
+ (:ignored-files (if (listp v) v (list v)))
(_ (ensure-string v)))))
- (pcase-let ((valid-kws '(:url :branch :lisp-dir :main-file :vc-backend
:rev))
- (`(,name . ,opts) arg))
+ (pcase-let* ((`(,name . ,opts) arg))
(if (stringp opts) ; (NAME . VERSION-STRING) ?
(list name opts)
- ;; Error handling
- (cl-loop for (k _) on opts by #'cddr
- if (not (member k valid-kws))
- do (use-package-error
- (format "Keyword :vc received unknown argument: %s.
Supported keywords are: %s"
- k valid-kws)))
- ;; Actual normalization
- (list name
- (cl-loop for (k v) on opts by #'cddr
- if (not (eq k :rev))
- nconc (list k (normalize k v)))
- (normalize :rev (plist-get opts :rev)))))))
+ (let ((opts (use-package-split-when
+ (lambda (el)
+ (seq-contains-p use-package-vc-valid-keywords el))
+ opts)))
+ ;; Error handling
+ (cl-loop for (k . _) in opts
+ if (not (member k use-package-vc-valid-keywords))
+ do (use-package-error
+ (format "Keyword :vc received unknown argument: %s.
Supported keywords are: %s"
+ k use-package-vc-valid-keywords)))
+ ;; Actual normalization
+ (list name
+ (cl-loop for (k . v) in opts
+ if (not (eq k :rev))
+ nconc (list k (normalize k (if (length= v 1) (car v)
v))))
+ (normalize :rev (car (alist-get :rev opts)))))))))
(defun use-package-normalize/:vc (name _keyword args)
"Normalize possible arguments to the `:vc' keyword.
@@ -1701,9 +1729,9 @@ node `(use-package) Creating an extension'."
((or 'nil 't) (list name)) ; guess name
((pred symbolp) (list arg)) ; use this name
((pred stringp) (list name arg)) ; version string + guess name
- ((pred plistp) ; plist + guess name
+ (`(,(pred keywordp) . ,(pred listp)) ; list + guess name
(use-package-normalize--vc-arg (cons name arg)))
- (`(,(pred symbolp) . ,(or (pred plistp) ; plist/version string + name
+ (`(,(pred symbolp) . ,(or (pred listp) ; list/version string + name
(pred stringp)))
(use-package-normalize--vc-arg arg))
(_ (use-package-error "Unrecognized argument to :vc.\
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 1f766eea455..d61a108b195 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -698,7 +698,15 @@ according to `fill-column'."
(save-excursion
(goto-char beg)
(when (re-search-forward
- "^[[:blank:]]*(.*\\([[:space:]]\\).*):"
+ ;; Also replace spaces within defun lists
+ ;; prefixed by a file name so that
+ ;; fill-region never attempts to break
+ ;; them, even if multiple items combine
+ ;; with symbols to exceed the fill column
+ ;; by the expressly permitted margin of 1
+ ;; character.
+ (concat "^\\([[:blank:]]*\\|\\* .*[[:blank:]]"
+ "\\)(.*\\([[:space:]]\\).*):")
end t)
(replace-regexp-in-region "[[:space:]]" " "
(setq space-beg
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index b23a5ca95a1..0541b16d625 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -187,7 +187,7 @@ the staging area."
;; The first shy group matches the characters drawn by --graph.
;; We use numbered groups because `log-view-message-re' wants the
;; revision number to be group 1.
- "^\\(?:[*/\\| ]+ \\)?\\(?2: ([^)]+)\\)?\\(?1:[0-9a-z]+\\)..: \
+ "^\\(?:[*/\\| ]+ \\)?\\(?2: ([^)]+)\\)?\\(?1:[0-9a-z]+\\)\\.\\.: \
\\(?3:.*?\\)[ \t]+\\(?4:[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)"
((1 'log-view-message)
(2 'change-log-list nil lax)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index f26e5cc751d..22d7d2f1e33 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -3547,6 +3547,8 @@ prepared sequentially."
:safe #'booleanp
:version "29.1")
+;; This is used in .dir-locals.el in the Emacs source tree.
+;;;###autoload (put 'vc-default-patch-addressee 'safe-local-variable 'stringp)
(defcustom vc-default-patch-addressee nil
"Default addressee for `vc-prepare-patch'.
If nil, no default will be used. This option may be set locally."
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 15c1b83fcc1..bc23a8794eb 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -2474,7 +2474,7 @@ purposes)."
(let ((i (length vec)))
(when (> i 0)
(while (and (>= (setq i (1- i)) 0)
- (whitespace-char-valid-p (aref vec i))))
+ (whitespace-char-valid-p (glyph-char (aref vec i)))))
(< i 0))))
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index cb6d8ebc2c4..3b467434d29 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -141,12 +141,21 @@ This exists as a variable so it can be set locally in
certain buffers.")
:background "dim gray"
:box (:line-width (1 . -1) :color "gray46")
:extend t)
+ ;; Monochrome displays.
+ (((background light))
+ :background "white"
+ :box (:line-width (1 . -1) :color "black")
+ :extend t)
+ (((background dark))
+ :background "black"
+ :box (:line-width (1 . -1) :color "white")
+ :extend t)
(t
:slant italic
:extend t))
"Face used for editable fields."
:group 'widget-faces
- :version "28.1")
+ :version "30.1")
(defface widget-single-line-field '((((type tty))
:background "green3"
@@ -157,6 +166,10 @@ This exists as a variable so it can be set locally in
certain buffers.")
(((class grayscale color)
(background dark))
:background "dim gray")
+ ;; Monochrome displays.
+ (((background light))
+ :stipple "gray3"
+ :extend t)
(t
:slant italic))
"Face used for editable fields spanning only a single line."
@@ -1140,7 +1153,7 @@ If nothing was called, return non-nil."
(when (and mouse-1 (mouse-movement-p event))
(push event unread-command-events)
(setq event oevent)
- (throw 'button-press-cancelled t))
+ (throw 'button-press-cancelled nil))
(unless (or (integerp event)
(memq (car event)
'(switch-frame
select-window))
@@ -1300,9 +1313,9 @@ nothing is shown in the echo area."
(unless (eq new old)
(setq arg (1+ arg))))))
(let ((new (widget-tabable-at)))
- (while (eq (widget-tabable-at) new)
+ (while (and (eq (widget-tabable-at) new) (not (bobp)))
(backward-char)))
- (forward-char))
+ (unless (bobp) (forward-char)))
(unless suppress-echo
(widget-echo-help (point)))
(run-hooks 'widget-move-hook))
diff --git a/lisp/window-tool-bar.el b/lisp/window-tool-bar.el
new file mode 100644
index 00000000000..395aa3aa9cc
--- /dev/null
+++ b/lisp/window-tool-bar.el
@@ -0,0 +1,510 @@
+;;; window-tool-bar.el --- Add tool bars inside windows -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2023-2024 Free Software Foundation, Inc.
+
+;; Author: Jared Finder <jared@finder.org>
+;; Created: Nov 21, 2023
+;; Version: 0.2
+;; Keywords: mouse
+;; Package-Requires: ((emacs "29.1"))
+
+;; This is a GNU ELPA :core package. Avoid adding functionality that
+;; is not available in the version of Emacs recorded above or any of
+;; the package dependencies.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This package puts a tool bar in each window. This allows you to see
+;; multiple tool bars simultaneously directly next to the buffer it
+;; acts on which feels much more intuitive. Emacs "browsing" modes
+;; generally have sensible tool bars, for example: *info*, *help*, and
+;; *eww* have them.
+;;
+;; It does this while being mindful of screen real estate. Most modes
+;; do not provide a custom tool bar, and this package does not show the
+;; default tool bar. This means that for most buffers there will be no
+;; space taken up. Furthermore, you can put this tool bar in the mode
+;; line or tab line if you want to share it with existing content.
+;;
+;; To get the default behavior, run (global-window-tool-bar-mode 1) or
+;; enable via M-x customize-group RET window-tool-bar RET. This uses
+;; the per-window tab line to show the tool bar.
+;;
+;; If you want to share space with an existing tab line, mode line, or
+;; header line, add (:eval (window-tool-bar-string)) to
+;; `tab-line-format', `mode-line-format', or `header-line-format'.
+
+;;; Known issues:
+;;
+;; On GNU Emacs 29.1, terminals dragging to resize windows will error
+;; with message "<tab-line> <mouse-movement> is undefined". This is a
+;; bug in GNU Emacs,
+;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=67457>.
+;;
+;; On GNU Emacs 29, performance in terminals is lower than on
+;; graphical frames. This is due to a workaround, see "Workaround for
+;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334";, below.
+
+;;; Todo:
+;;
+;; Not all features planned are implemented yet. Eventually I would
+;; like to also generally make tool bars better.
+;;
+;; Targeting 0.3:
+;; * Properly support reamining less frequently used tool bar item specs. From
+;; `parse_tool_bar_item':
+;; * :visible
+;; * :filter
+;; * :button
+;; * :wrap
+;; * Add display customization similar to `tool-bar-style'.
+;;
+;; Targeting 1.0:
+;;
+;; * Clean up Emacs tool bars
+;; * Default: Remove default tool-bar entirely
+;; * grep, vc: Remove default tool-bar inherited
+;; * info: Remove Next / Prev / Up, which is already in the header
+;; * smerge: Add tool bar for next/prev
+;;
+;; Post 1.0 work:
+;;
+;; * Show keyboard shortcut on help text.
+;;
+;; * Add a bit more documentation.
+;; * Add customization option: ignore-default-tool-bar-map
+;; * Make tab-line dragging resize the window
+
+;;; Code:
+
+(require 'mwheel)
+(require 'tab-line)
+(require 'tool-bar)
+
+;;; Benchmarking code
+;;
+;; Refreshing the tool bar is computationally simple, but generates a
+;; lot of garbage. So this benchmarking focuses on garbage
+;; generation. Since it has to run after most commands, generating
+;; significantly more garbage will cause noticeable performance
+;; degration.
+;;
+;; The refresh has two steps:
+;;
+;; Step 1: Look up the <tool-bar> map.
+;; Step 2: Generate a Lisp string using text properties for the tool
+;; bar string.
+;;
+;; Additionally, we keep track of the percentage of commands that
+;; acutally created a refresh.
+(defvar window-tool-bar--memory-use-delta-step1 (make-list 7 0)
+ "Absolute delta of memory use counters during step 1.
+This is a list in the same structure as `memory-use-counts'.")
+(defvar window-tool-bar--memory-use-delta-step2 (make-list 7 0)
+ "Absolute delta of memory use counters during step 2.
+This is a list in the same structure as `memory-use-counts'.")
+(defvar window-tool-bar--refresh-done-count 0
+ "Number of tool bar string refreshes run.
+The total number of requests is the sum of this and
+`window-tool-bar--refresh-skipped-count'.")
+(defvar window-tool-bar--refresh-skipped-count 0
+ "Number of tool bar string refreshes that were skipped.
+The total number of requests is the sum of this and
+`window-tool-bar--refresh-done-count'.")
+
+(defun window-tool-bar--memory-use-avg-step1 ()
+ "Return average memory use delta during step 1."
+ (mapcar (lambda (elt) (/ (float elt) window-tool-bar--refresh-done-count))
+ window-tool-bar--memory-use-delta-step1))
+
+(defun window-tool-bar--memory-use-avg-step2 ()
+ "Return average memory use delta during step 2."
+ (mapcar (lambda (elt) (/ (float elt) window-tool-bar--refresh-done-count))
+ window-tool-bar--memory-use-delta-step2))
+
+(declare-function time-stamp-string "time-stamp")
+
+(defun window-tool-bar-debug-show-memory-use ()
+ "Development-only command to show memory used by `window-tool-bar-string'."
+ (interactive)
+ (require 'time-stamp)
+ (save-selected-window
+ (pop-to-buffer "*WTB Memory Report*")
+ (unless (derived-mode-p 'special-mode)
+ (special-mode))
+
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert (propertize (concat "Function: window-tool-bar-string "
+ (time-stamp-string))
+ 'face 'underline 'font-lock-face 'underline)
+ "\n\n")
+ (window-tool-bar--insert-memory-use
+ "Step 1" (window-tool-bar--memory-use-avg-step1))
+ (window-tool-bar--insert-memory-use
+ "Step 2" (window-tool-bar--memory-use-avg-step2))
+ (insert (format "Refresh count %d\n"
window-tool-bar--refresh-done-count)
+ (format "Refresh executed percent %.2f\n"
+ (/ (float window-tool-bar--refresh-done-count)
+ (+ window-tool-bar--refresh-done-count
+ window-tool-bar--refresh-skipped-count)))
+ "\n"))))
+
+(defun window-tool-bar--insert-memory-use (label avg-memory-use)
+ "Insert memory use into current buffer.
+
+LABEL is a prefix string to be in front of the data.
+AVG-MEMORY-USE is a list of averages, with the same meaning as
+`memory-use-counts'."
+ (let* ((label-len (length label))
+ (padding (make-string label-len ?\s)))
+ (cl-loop for usage in avg-memory-use
+ for usage-label in '("Conses" "Floats" "Vector cells" "Symbols"
+ "String chars" "Intervals" "Strings")
+ for idx from 0
+ do (insert (format "%s %8.2f %s\n"
+ (if (= idx 0) label padding)
+ usage
+ usage-label)))))
+
+(defgroup window-tool-bar nil
+ "Tool bars per-window."
+ :group 'convenience
+ :prefix "window-tool-bar-")
+
+(defvar-keymap window-tool-bar--button-keymap
+ :doc "Keymap used by `window-tool-bar--keymap-entry-to-string'."
+ "<follow-link>" 'mouse-face
+ ;; Follow link on all clicks of mouse-1 and mouse-2 since the tool
+ ;; bar is not a place the point can travel to.
+ "<tab-line> <mouse-1>" #'window-tool-bar--call-button
+ "<tab-line> <double-mouse-1>" #'window-tool-bar--call-button
+ "<tab-line> <triple-mouse-1>" #'window-tool-bar--call-button
+ "<tab-line> <mouse-2>" #'window-tool-bar--call-button
+ "<tab-line> <double-mouse-2>" #'window-tool-bar--call-button
+ "<tab-line> <triple-mouse-2>" #'window-tool-bar--call-button
+
+ ;; Mouse down events do nothing. A binding is needed so isearch
+ ;; does not exit when the tab bar is clicked.
+ "<tab-line> <down-mouse-1>" #'window-tool-bar--ignore
+ "<tab-line> <double-down-mouse-1>" #'window-tool-bar--ignore
+ "<tab-line> <triple-down-mouse-1>" #'window-tool-bar--ignore
+ "<tab-line> <down-mouse-2>" #'window-tool-bar--ignore
+ "<tab-line> <double-down-mouse-2>" #'window-tool-bar--ignore
+ "<tab-line> <triple-down-mouse-2>" #'window-tool-bar--ignore)
+(fset 'window-tool-bar--button-keymap window-tool-bar--button-keymap) ; So it
can be a keymap property
+
+;; Register bindings that stay in isearch. Technically, these
+;; commands don't pop up a menu but they act very similar in that they
+;; are caused by mouse input and may call commands via
+;; `call-interactively'.
+(push 'window-tool-bar--call-button isearch-menu-bar-commands)
+(push 'window-tool-bar--ignore isearch-menu-bar-commands)
+
+(defvar-local window-tool-bar-string--cache nil
+ "Cache for previous result of `window-tool-bar-string'.")
+
+;;;###autoload
+(defun window-tool-bar-string ()
+ "Return a (propertized) string for the tool bar.
+
+This is for when you want more customizations than
+`window-tool-bar-mode' provides. Commonly added to the variable
+`tab-line-format', `header-line-format', or `mode-line-format'"
+ (if (or (null window-tool-bar-string--cache)
+ (window-tool-bar--last-command-triggers-refresh-p))
+ (let* ((mem0 (memory-use-counts))
+ (toolbar-menu (window-tool-bar--get-keymap))
+ (mem1 (memory-use-counts))
+ (result (mapconcat #'window-tool-bar--keymap-entry-to-string
+ (cdr toolbar-menu) ;Skip 'keymap
+ ;; Without spaces between the text, hovering
+ ;; highlights all adjacent buttons.
+ (if (window-tool-bar--use-images)
+ (propertize " " 'invisible t)
+ " ")))
+ (mem2 (memory-use-counts)))
+ (cl-mapl (lambda (l-init l0 l1)
+ (cl-incf (car l-init) (- (car l1) (car l0))))
+ window-tool-bar--memory-use-delta-step1 mem0 mem1)
+ (cl-mapl (lambda (l-init l1 l2)
+ (cl-incf (car l-init) (- (car l2) (car l1))))
+ window-tool-bar--memory-use-delta-step2 mem1 mem2)
+
+ (setf window-tool-bar-string--cache
+ (concat
+ ;; The tool bar face by default puts boxes around the
+ ;; buttons. However, this box is not displayed if the
+ ;; box starts at the leftmost pixel of the tab-line.
+ ;; Add a single space in this case so the box displays
+ ;; correctly.
+ (and (display-supports-face-attributes-p
+ '(:box (line-width 1)))
+ (propertize " " 'display '(space :width (1))))
+ result))
+ (cl-incf window-tool-bar--refresh-done-count))
+ (cl-incf window-tool-bar--refresh-skipped-count))
+
+ window-tool-bar-string--cache)
+
+(defconst window-tool-bar--graphical-separator
+ (concat
+ (propertize " " 'display '(space :width (4)))
+ (propertize " " 'display '(space :width (1) face (:inverse-video t)))
+ (propertize " " 'display '(space :width (4)))))
+
+(defun window-tool-bar--keymap-entry-to-string (menu-item)
+ "Convert MENU-ITEM into a (propertized) string representation.
+
+MENU-ITEM is a menu item to convert. See info node (elisp)Tool Bar."
+ (pcase-exhaustive menu-item
+ ;; Separators
+ ((or `(,_ "--")
+ `(,_ menu-item ,(and (pred stringp)
+ (pred (string-prefix-p "--")))))
+ (if (window-tool-bar--use-images)
+ window-tool-bar--graphical-separator
+ "|"))
+
+ ;; Menu item, turn into propertized string button
+ (`(,key menu-item ,name-expr ,binding . ,plist)
+ (when binding ; If no binding exists, then button is hidden.
+ (let* ((name (eval name-expr))
+ (str (upcase-initials (or (plist-get plist :label)
+ (string-trim-right name "\\.+"))))
+ (len (length str))
+ (enable-form (plist-get plist :enable))
+ (enabled (or (not enable-form)
+ (eval enable-form))))
+ (if enabled
+ (add-text-properties 0 len
+ '(mouse-face window-tool-bar-button-hover
+ keymap window-tool-bar--button-keymap
+ face window-tool-bar-button)
+ str)
+ (put-text-property 0 len
+ 'face
+ 'window-tool-bar-button-disabled
+ str))
+ (when-let ((spec (and (window-tool-bar--use-images)
+ (plist-get menu-item :image))))
+ (put-text-property 0 len
+ 'display
+ (append spec
+ (if enabled '(:margin 2 :ascent center)
+ '(:margin 2 :ascent center
+ :conversion disabled)))
+ str))
+ (put-text-property 0 len
+ 'help-echo
+ (or (plist-get plist :help) name)
+ str)
+ (put-text-property 0 len 'tool-bar-key key str)
+ str)))))
+
+(defun window-tool-bar--call-button ()
+ "Call the button that was clicked on in the tab line."
+ (interactive)
+ (when (mouse-event-p last-command-event)
+ (let ((posn (event-start last-command-event)))
+ ;; Commands need to execute with the right buffer and window
+ ;; selected. The selection needs to be permanent for isearch.
+ (select-window (posn-window posn))
+ (let* ((str (posn-string posn))
+ (key (get-text-property (cdr str) 'tool-bar-key (car str)))
+ (cmd (lookup-key (window-tool-bar--get-keymap) (vector key))))
+ (call-interactively cmd)))))
+
+(defun window-tool-bar--ignore ()
+ "Internal command so isearch does not exit on button-down events."
+ (interactive)
+ nil)
+
+;; static-if was added in Emacs 30, but this packages supports earlier
+;; versions.
+(defmacro window-tool-bar--static-if (condition then-form &rest else-forms)
+ "A conditional compilation macro.
+Evaluate CONDITION at macro-expansion time. If it is non-nil,
+expand the macro to THEN-FORM. Otherwise expand it to ELSE-FORMS
+enclosed in a `progn' form. ELSE-FORMS may be empty."
+ (declare (indent 2)
+ (debug (sexp sexp &rest sexp)))
+ (if (eval condition lexical-binding)
+ then-form
+ (cons 'progn else-forms)))
+
+(defvar window-tool-bar--ignored-event-types
+ (let ((list (append
+ '(mouse-movement pinch
+ wheel-down wheel-up wheel-left wheel-right)
+ ;; Prior to emacs 30, wheel events could also surface as
+ ;; mouse-<NUM> buttons.
+ (window-tool-bar--static-if (version< emacs-version "30")
+ (list
+ mouse-wheel-down-event mouse-wheel-up-event
+ mouse-wheel-left-event mouse-wheel-right-event
+ (bound-and-true-p mouse-wheel-down-alternate-event)
+ (bound-and-true-p mouse-wheel-up-alternate-event)
+ (bound-and-true-p mouse-wheel-left-alternate-event)
+ (bound-and-true-p mouse-wheel-right-alternate-event))
+ nil))))
+ (delete-dups (delete nil list)))
+ "Cache for `window-tool-bar--last-command-triggers-refresh-p'.")
+
+(defun window-tool-bar--last-command-triggers-refresh-p ()
+ "Test if the recent command or event should trigger a tool bar refresh."
+ (let ((type (event-basic-type last-command-event)))
+ (and
+ ;; Assume that key presses and button presses are the only user
+ ;; interactions that can alter the tool bar. Specifically, this
+ ;; excludes mouse movement, mouse wheel scroll, and pinch.
+ (not (member type window-tool-bar--ignored-event-types))
+ ;; Assume that any command that triggers shift select can't alter
+ ;; the tool bar. This excludes pure navigation commands.
+ (not (window-tool-bar--command-triggers-shift-select-p last-command))
+ ;; Assume that self-insert-command won't alter the tool bar.
+ ;; This is the most commonly executed command.
+ (not (eq last-command 'self-insert-command)))))
+
+(defun window-tool-bar--command-triggers-shift-select-p (command)
+ "Test if COMMAND would trigger shift select."
+ (let* ((form (interactive-form command))
+ (spec (car-safe (cdr-safe form))))
+ (and (eq (car-safe form) 'interactive)
+ (stringp spec)
+ (seq-position spec ?^))))
+
+;;;###autoload
+(define-minor-mode window-tool-bar-mode
+ "Toggle display of the tool bar in the tab line of the current buffer."
+ :global nil
+ (let ((should-display (and window-tool-bar-mode
+ (not (eq tool-bar-map
+ (default-value 'tool-bar-map)))))
+ (default-value '(:eval (window-tool-bar-string))))
+
+ ;; Preserve existing tab-line set outside of this mode
+ (if (or (null tab-line-format)
+ (equal tab-line-format default-value))
+ (if should-display
+ (setq tab-line-format default-value)
+ (setq tab-line-format nil))
+ (message
+ "tab-line-format set outside of window-tool-bar-mode, currently `%S'"
+ tab-line-format))))
+
+;;;###autoload
+(define-globalized-minor-mode global-window-tool-bar-mode
+ window-tool-bar-mode window-tool-bar--turn-on
+ :group 'window-tool-bar
+ (add-hook 'isearch-mode-hook #'window-tool-bar--turn-on)
+ (add-hook 'isearch-mode-end-hook #'window-tool-bar--turn-on))
+
+(defvar window-tool-bar--allow-images t
+ "Internal debug flag to force text mode.")
+
+(defun window-tool-bar--use-images ()
+ "Internal function.
+Respects `window-tool-bar--allow-images' as well as frame
+capabilities."
+ (and window-tool-bar--allow-images
+ (display-images-p)))
+
+;;; Display styling:
+(defface window-tool-bar-button
+ '((default
+ :inherit tab-line)
+ (((class color) (min-colors 88) (supports :box t))
+ :box (:line-width -1 :style released-button)
+ :background "grey85")
+ ;; If the box is not supported, dim the button background a bit.
+ (((class color) (min-colors 88))
+ :background "grey70")
+ (t
+ :inverse-video t))
+ "Face used for buttons when the mouse is not hovering over the button."
+ :group 'window-tool-bar)
+
+(defface window-tool-bar-button-hover
+ '((default
+ :inherit tab-line)
+ (((class color) (min-colors 88))
+ :box (:line-width -1 :style released-button)
+ :background "grey95")
+ (t
+ :inverse-video t))
+ "Face used for buttons when the mouse is hovering over the button."
+ :group 'window-tool-bar)
+
+(defface window-tool-bar-button-disabled
+ '((default
+ :inherit tab-line)
+ (((class color) (min-colors 88))
+ :box (:line-width -1 :style released-button)
+ :background "grey50"
+ :foreground "grey70")
+ (t
+ :inverse-video t
+ :background "brightblack"))
+ "Face used for buttons when the button is disabled."
+ :group 'window-tool-bar)
+
+;;; Workaround for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334.
+(defun window-tool-bar--get-keymap ()
+ "Return the tool bar keymap."
+ (let ((tool-bar-always-show-default nil))
+ (if (and (version< emacs-version "30")
+ (not (window-tool-bar--use-images)))
+ ;; This code path is a less efficient workaround.
+ (window-tool-bar--make-keymap-1)
+ (keymap-global-lookup "<tool-bar>"))))
+
+(declare-function image-mask-p "image.c" (spec &optional frame))
+
+(defun window-tool-bar--make-keymap-1 ()
+ "Patched copy of `tool-bar-make-keymap-1'."
+ (mapcar (lambda (bind)
+ (let (image-exp plist)
+ (when (and (eq (car-safe (cdr-safe bind)) 'menu-item)
+ ;; For the format of menu-items, see node
+ ;; `Extended Menu Items' in the Elisp manual.
+ (setq plist (nthcdr (if (consp (nth 4 bind)) 5 4)
+ bind))
+ (setq image-exp (plist-get plist :image))
+ (consp image-exp)
+ (not (eq (car image-exp) 'image))
+ (fboundp (car image-exp)))
+ (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))
+ tool-bar-map))
+
+(defun window-tool-bar--turn-on ()
+ "Internal function called by `global-window-tool-bar-mode'."
+ (when global-window-tool-bar-mode
+ (window-tool-bar-mode 1)))
+
+(provide 'window-tool-bar)
+
+;;; window-tool-bar.el ends here
diff --git a/lisp/window.el b/lisp/window.el
index cdc6f690bab..e709e978cc9 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -2515,7 +2515,8 @@ have special meanings:
Any other value of ALL-FRAMES means consider all windows on the
selected frame and no others."
- (declare (side-effect-free error-free))
+ (declare (ftype (function (&optional t t t) (or window null)))
+ (side-effect-free error-free))
(let ((windows (window-list-1 nil 'nomini all-frames))
best-window best-time second-best-window second-best-time time)
(dolist (window windows)
@@ -2594,7 +2595,8 @@ have special meanings:
Any other value of ALL-FRAMES means consider all windows on the
selected frame and no others."
- (declare (side-effect-free error-free))
+ (declare (ftype (function (&optional t t t) (or window null)))
+ (side-effect-free error-free))
(let ((best-size 0)
best-window size)
(dolist (window (window-list-1 nil 'nomini all-frames))
@@ -4089,7 +4091,8 @@ with a special meaning are:
Anything else means consider all windows on the selected frame
and no others."
- (declare (side-effect-free error-free))
+ (declare (ftype (function (&optional t t) boolean))
+ (side-effect-free error-free))
(let ((base-window (selected-window)))
(if (and nomini (eq base-window (minibuffer-window)))
(setq base-window (next-window base-window)))
@@ -9903,8 +9906,8 @@ accessible position."
;; the bottom is wider than the window.
(* (window-body-height window pixelwise)
(if pixelwise 1 char-height))))
- (- total-width
- (window-body-width window pixelwise)))))
+ (- (* total-width (if pixelwise 1 char-width))
+ (window-body-width window t)))))
(unless pixelwise
(setq width (/ (+ width char-width -1) char-width)))
(setq width (max min-width (min max-width width)))
diff --git a/m4/00gnulib.m4 b/m4/00gnulib.m4
index 99c99d1b0fb..cd16771848c 100644
--- a/m4/00gnulib.m4
+++ b/m4/00gnulib.m4
@@ -1,4 +1,5 @@
-# 00gnulib.m4 serial 9
+# 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,
diff --git a/m4/__inline.m4 b/m4/__inline.m4
index 992e16f4ea7..20baf16437f 100644
--- a/m4/__inline.m4
+++ b/m4/__inline.m4
@@ -1,9 +1,12 @@
-# Test for __inline keyword
+# __inline.m4
+# serial 1
dnl Copyright 2017-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.
+# Test for __inline keyword
+
AC_DEFUN([gl___INLINE],
[
AC_CACHE_CHECK([whether the compiler supports the __inline keyword],
diff --git a/m4/absolute-header.m4 b/m4/absolute-header.m4
index 0e9f9ba763a..0abd6d9002c 100644
--- a/m4/absolute-header.m4
+++ b/m4/absolute-header.m4
@@ -1,4 +1,5 @@
-# absolute-header.m4 serial 18
+# 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,
diff --git a/m4/acl.m4 b/m4/acl.m4
index 2050d108b0c..c7b6ec2b14e 100644
--- a/m4/acl.m4
+++ b/m4/acl.m4
@@ -1,10 +1,11 @@
-# acl.m4 - check for access control list (ACL) primitives
+# acl.m4
# serial 30
+dnl Copyright (C) 2002, 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,
+dnl with or without modifications, as long as this notice is preserved.
-# Copyright (C) 2002, 2004-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.
+# Check for access control list (ACL) primitives
# Written by Paul Eggert and Jim Meyering.
diff --git a/m4/alloca.m4 b/m4/alloca.m4
index 90960215382..dc78dc19a87 100644
--- a/m4/alloca.m4
+++ b/m4/alloca.m4
@@ -1,4 +1,5 @@
-# alloca.m4 serial 21
+# alloca.m4
+# serial 21
dnl Copyright (C) 2002-2004, 2006-2007, 2009-2024 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
diff --git a/m4/assert_h.m4 b/m4/assert_h.m4
index d3d4c42519f..b90d0f19390 100644
--- a/m4/assert_h.m4
+++ b/m4/assert_h.m4
@@ -1,4 +1,5 @@
-# assert-h.m4
+# assert_h.m4
+# serial 1
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,
diff --git a/m4/builtin-expect.m4 b/m4/builtin-expect.m4
index 8faffc50354..c7af926b34c 100644
--- a/m4/builtin-expect.m4
+++ b/m4/builtin-expect.m4
@@ -1,10 +1,12 @@
-dnl Check for __builtin_expect.
-
+# builtin-expect.m4
+# serial 1
dnl Copyright 2016-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.
+dnl Check for __builtin_expect.
+
dnl Written by Paul Eggert.
AC_DEFUN([gl___BUILTIN_EXPECT],
diff --git a/m4/byteswap.m4 b/m4/byteswap.m4
index 5493d901916..e91da97b958 100644
--- a/m4/byteswap.m4
+++ b/m4/byteswap.m4
@@ -1,4 +1,5 @@
-# byteswap.m4 serial 5
+# byteswap.m4
+# serial 7
dnl Copyright (C) 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,
@@ -9,9 +10,32 @@ dnl Written by Oskar Liljeblad.
AC_DEFUN([gl_BYTESWAP],
[
dnl Prerequisites of lib/byteswap.in.h.
- AC_CHECK_HEADERS([byteswap.h], [
+ AC_CHECK_HEADERS_ONCE([byteswap.h])
+ if test $ac_cv_header_byteswap_h = yes; then
+ AC_CACHE_CHECK([for working bswap_16, bswap_32, bswap_64],
+ [gl_cv_header_working_byteswap_h],
+ [gl_cv_header_working_byteswap_h=no
+ dnl Check that floating point arguments work.
+ dnl This also checks C libraries with implementations like
+ dnl '#define bswap_16(x) (((x) >> 8 & 0xff) | (((x) & 0xff) << 8))'
+ dnl that mistakenly evaluate their arguments multiple times.
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <byteswap.h>
+ ]],
+ [[int value_16 = bswap_16 (0.0);
+ int value_32 = bswap_32 (0.0);
+ int value_64 = bswap_64 (0.0);
+ return !(value_16 + value_32 + value_64);
+ ]])
+ ],
+ [gl_cv_header_working_byteswap_h=yes],
+ [gl_cv_header_working_byteswap_h=no])
+ ])
+ fi
+ if test "$gl_cv_header_working_byteswap_h" = yes; then
GL_GENERATE_BYTESWAP_H=false
- ], [
+ else
GL_GENERATE_BYTESWAP_H=true
- ])
+ fi
])
diff --git a/m4/c-bool.m4 b/m4/c-bool.m4
index 44fba3c012f..0fb0de3b59e 100644
--- a/m4/c-bool.m4
+++ b/m4/c-bool.m4
@@ -1,10 +1,12 @@
-# Check for bool that conforms to C2023.
-
+# c-bool.m4
+# serial 1
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,
dnl with or without modifications, as long as this notice is preserved.
+# Check for bool that conforms to C2023.
+
AC_DEFUN([gl_C_BOOL],
[
AC_CACHE_CHECK([for bool, true, false], [gl_cv_c_bool],
diff --git a/m4/canonicalize.m4 b/m4/canonicalize.m4
index 05dc6dd264d..b63391a6ad7 100644
--- a/m4/canonicalize.m4
+++ b/m4/canonicalize.m4
@@ -1,4 +1,5 @@
-# canonicalize.m4 serial 39
+# canonicalize.m4
+# serial 39
dnl Copyright (C) 2003-2007, 2009-2024 Free Software Foundation, Inc.
diff --git a/m4/clock_time.m4 b/m4/clock_time.m4
index c016575c8ea..27f6fd153a3 100644
--- a/m4/clock_time.m4
+++ b/m4/clock_time.m4
@@ -1,4 +1,5 @@
-# clock_time.m4 serial 14
+# 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,
diff --git a/m4/codeset.m4 b/m4/codeset.m4
index 94dccce7775..e69b7402fc2 100644
--- a/m4/codeset.m4
+++ b/m4/codeset.m4
@@ -1,4 +1,5 @@
-# codeset.m4 serial 5 (gettext-0.18.2)
+# codeset.m4
+# serial 5 (gettext-0.18.2)
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
diff --git a/m4/copy-file-range.m4 b/m4/copy-file-range.m4
index 443e598ba55..4ef75f62d40 100644
--- a/m4/copy-file-range.m4
+++ b/m4/copy-file-range.m4
@@ -1,4 +1,5 @@
-# copy-file-range.m4 serial 5
+# 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,
diff --git a/m4/d-type.m4 b/m4/d-type.m4
index b06bca5a7dc..0ef89b86b15 100644
--- a/m4/d-type.m4
+++ b/m4/d-type.m4
@@ -1,15 +1,13 @@
+# d-type.m4
# serial 12
+dnl Copyright (C) 1997, 1999-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.
dnl From Jim Meyering.
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.
-#
-# 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.
AC_DEFUN([gl_CHECK_TYPE_STRUCT_DIRENT_D_TYPE],
[AC_CACHE_CHECK([for d_type member in directory struct],
diff --git a/m4/dirent_h.m4 b/m4/dirent_h.m4
index 3e3d967f499..037ae369a2d 100644
--- a/m4/dirent_h.m4
+++ b/m4/dirent_h.m4
@@ -1,4 +1,5 @@
-# dirent_h.m4 serial 22
+# 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,
diff --git a/m4/dirfd.m4 b/m4/dirfd.m4
index e58582e6145..605cb706c0a 100644
--- a/m4/dirfd.m4
+++ b/m4/dirfd.m4
@@ -1,12 +1,12 @@
+# dirfd.m4
# serial 30 -*- Autoconf -*-
+dnl Copyright (C) 2001-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.
dnl Find out how to get the file descriptor associated with an open DIR*.
-# Copyright (C) 2001-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.
-
dnl From Jim Meyering
AC_DEFUN([gl_FUNC_DIRFD],
diff --git a/m4/double-slash-root.m4 b/m4/double-slash-root.m4
index 00f23a70b0c..3437c699ada 100644
--- a/m4/double-slash-root.m4
+++ b/m4/double-slash-root.m4
@@ -1,4 +1,5 @@
-# double-slash-root.m4 serial 4 -*- Autoconf -*-
+# double-slash-root.m4
+# serial 4 -*- Autoconf -*-
dnl Copyright (C) 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,
diff --git a/m4/dup2.m4 b/m4/dup2.m4
index f6759b647a6..786121fd8f3 100644
--- a/m4/dup2.m4
+++ b/m4/dup2.m4
@@ -1,4 +1,5 @@
-#serial 28
+# dup2.m4
+# 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,
diff --git a/m4/eealloc.m4 b/m4/eealloc.m4
index d8862a1e0f3..8a15e705541 100644
--- a/m4/eealloc.m4
+++ b/m4/eealloc.m4
@@ -1,4 +1,5 @@
-# eealloc.m4 serial 3
+# eealloc.m4
+# serial 3
dnl Copyright (C) 2003, 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,
diff --git a/m4/environ.m4 b/m4/environ.m4
index 5b9e06b0088..107960b2e77 100644
--- a/m4/environ.m4
+++ b/m4/environ.m4
@@ -1,4 +1,5 @@
-# environ.m4 serial 8
+# environ.m4
+# serial 8
dnl Copyright (C) 2001-2004, 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,
diff --git a/m4/errno_h.m4 b/m4/errno_h.m4
index 8900d6c7257..b6050e5d8e0 100644
--- a/m4/errno_h.m4
+++ b/m4/errno_h.m4
@@ -1,4 +1,5 @@
-# errno_h.m4 serial 14
+# errno_h.m4
+# serial 14
dnl Copyright (C) 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,
diff --git a/m4/euidaccess.m4 b/m4/euidaccess.m4
index e3d828f6ca5..3ade282f4ec 100644
--- a/m4/euidaccess.m4
+++ b/m4/euidaccess.m4
@@ -1,4 +1,5 @@
-# euidaccess.m4 serial 17
+# euidaccess.m4
+# serial 17
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,
diff --git a/m4/execinfo.m4 b/m4/execinfo.m4
index a76c33525e6..9dc8d6d489d 100644
--- a/m4/execinfo.m4
+++ b/m4/execinfo.m4
@@ -1,10 +1,12 @@
-# Check for GNU-style execinfo.h.
-
+# execinfo.m4
+# serial 1
dnl Copyright 2012-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.
+# Check for GNU-style execinfo.h.
+
AC_DEFUN([gl_EXECINFO_H],
[
AC_CHECK_HEADERS_ONCE([execinfo.h])
diff --git a/m4/extensions.m4 b/m4/extensions.m4
index 6fc2e300e0a..1fb68956b33 100644
--- a/m4/extensions.m4
+++ b/m4/extensions.m4
@@ -1,10 +1,11 @@
-# serial 23 -*- Autoconf -*-
-# Enable extensions on systems that normally disable them.
+# extensions.m4
+# serial 25 -*- Autoconf -*-
+dnl Copyright (C) 2003, 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,
+dnl with or without modifications, as long as this notice is preserved.
-# Copyright (C) 2003, 2006-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.
+# Enable extensions on systems that normally disable them.
dnl Define to empty for the benefit of Autoconf 2.69 and earlier, so that
dnl AC_USE_SYSTEM_EXTENSIONS (below) can be used unchanged from Autoconf 2.70+.
@@ -229,4 +230,15 @@ AC_DEFUN_ONCE([gl_USE_SYSTEM_EXTENSIONS],
[Define to enable the declarations of ISO C 11 types and functions.])
;;
esac
+
+ dnl On OpenSolaris derivatives, the include files contains a couple of
+ dnl declarations that are only activated with an explicit
+ dnl -D__STDC_WANT_LIB_EXT1__.
+ AH_VERBATIM([USE_ISO_C_23_ANNEX_K_EXTENSIONS],
+[/* Define to enable the declarations of ISO C 23 Annex K types and functions.
*/
+#if !(defined __STDC_WANT_LIB_EXT1__ && __STDC_WANT_LIB_EXT1__)
+#undef/**/__STDC_WANT_LIB_EXT1__
+#define __STDC_WANT_LIB_EXT1__ 1
+#endif
+])
])
diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4
index 680250ec774..547da82afa5 100644
--- a/m4/extern-inline.m4
+++ b/m4/extern-inline.m4
@@ -1,10 +1,12 @@
-dnl 'extern inline' a la ISO C99.
-
+# extern-inline.m4
+# serial 1
dnl Copyright 2012-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.
+dnl 'extern inline' a la ISO C99.
+
AC_DEFUN([gl_EXTERN_INLINE],
[
AC_CACHE_CHECK([whether ctype.h defines __header_inline],
diff --git a/m4/faccessat.m4 b/m4/faccessat.m4
index b8c058cef28..c5f40e52900 100644
--- a/m4/faccessat.m4
+++ b/m4/faccessat.m4
@@ -1,11 +1,12 @@
+# faccessat.m4
# serial 12
-# See if we need to provide faccessat replacement.
-
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,
dnl with or without modifications, as long as this notice is preserved.
+# See if we need to provide faccessat replacement.
+
# Written by Eric Blake.
AC_DEFUN([gl_FUNC_FACCESSAT],
diff --git a/m4/fchmodat.m4 b/m4/fchmodat.m4
index 9750572a5a3..e71ee8e8ef6 100644
--- a/m4/fchmodat.m4
+++ b/m4/fchmodat.m4
@@ -1,4 +1,5 @@
-# fchmodat.m4 serial 8
+# fchmodat.m4
+# serial 8
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,
diff --git a/m4/fcntl.m4 b/m4/fcntl.m4
index 02b93f8357c..f6d0f377319 100644
--- a/m4/fcntl.m4
+++ b/m4/fcntl.m4
@@ -1,4 +1,5 @@
-# fcntl.m4 serial 11
+# fcntl.m4
+# serial 12
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,
@@ -82,7 +83,7 @@ AC_DEFUN([gl_FUNC_FCNTL],
esac
dnl Many systems lack F_DUPFD_CLOEXEC.
- dnl NetBSD 9.0 declares F_DUPFD_CLOEXEC but it works only like F_DUPFD.
+ dnl NetBSD 10.0 declares F_DUPFD_CLOEXEC but it works only like F_DUPFD.
AC_CACHE_CHECK([whether fcntl understands F_DUPFD_CLOEXEC],
[gl_cv_func_fcntl_f_dupfd_cloexec],
[AC_RUN_IFELSE(
diff --git a/m4/fcntl_h.m4 b/m4/fcntl_h.m4
index ba4eb4494db..b69f7a0ca81 100644
--- a/m4/fcntl_h.m4
+++ b/m4/fcntl_h.m4
@@ -1,10 +1,12 @@
+# fcntl_h.m4
# serial 20
-# Configure fcntl.h.
dnl Copyright (C) 2006-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.
+# Configure fcntl.h.
+
dnl Written by Paul Eggert.
AC_DEFUN_ONCE([gl_FCNTL_H],
diff --git a/m4/fdopendir.m4 b/m4/fdopendir.m4
index bf361ff154c..e9268378d6e 100644
--- a/m4/fdopendir.m4
+++ b/m4/fdopendir.m4
@@ -1,11 +1,12 @@
+# fdopendir.m4
# serial 15
-# See if we need to provide fdopendir.
-
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,
dnl with or without modifications, as long as this notice is preserved.
+# See if we need to provide fdopendir.
+
# Written by Eric Blake.
AC_DEFUN([gl_FUNC_FDOPENDIR],
diff --git a/m4/filemode.m4 b/m4/filemode.m4
index b72317281b3..cb87a564cfd 100644
--- a/m4/filemode.m4
+++ b/m4/filemode.m4
@@ -1,4 +1,5 @@
-# filemode.m4 serial 9
+# filemode.m4
+# serial 9
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,
diff --git a/m4/flexmember.m4 b/m4/flexmember.m4
index 9df6c03cd3b..73fb6142faf 100644
--- a/m4/flexmember.m4
+++ b/m4/flexmember.m4
@@ -1,10 +1,11 @@
+# flexmember.m4
# serial 5
-# Check for flexible array member support.
+dnl Copyright (C) 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.
-# Copyright (C) 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,
-# with or without modifications, as long as this notice is preserved.
+# Check for flexible array member support.
# Written by Paul Eggert.
diff --git a/m4/fpending.m4 b/m4/fpending.m4
index 05064b851ec..9f2d83fb117 100644
--- a/m4/fpending.m4
+++ b/m4/fpending.m4
@@ -1,9 +1,9 @@
+# fpending.m4
# serial 23
-
-# Copyright (C) 2000-2001, 2004-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.
+dnl Copyright (C) 2000-2001, 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,
+dnl with or without modifications, as long as this notice is preserved.
dnl From Jim Meyering
dnl Using code from emacs, based on suggestions from Paul Eggert
diff --git a/m4/fpieee.m4 b/m4/fpieee.m4
index 239cf4a7e2d..665543d0ed8 100644
--- a/m4/fpieee.m4
+++ b/m4/fpieee.m4
@@ -1,4 +1,5 @@
-# fpieee.m4 serial 2 -*- coding: utf-8 -*-
+# fpieee.m4
+# serial 2 -*- coding: utf-8 -*-
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,
diff --git a/m4/free.m4 b/m4/free.m4
index 4f6dc2e256d..a2b596d67f7 100644
--- a/m4/free.m4
+++ b/m4/free.m4
@@ -1,8 +1,9 @@
-# free.m4 serial 6
-# Copyright (C) 2003-2005, 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.
+# free.m4
+# serial 6
+dnl Copyright (C) 2003-2005, 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.
# Written by Paul Eggert and Bruno Haible.
diff --git a/m4/fstatat.m4 b/m4/fstatat.m4
index c22569b7961..c5ef7dfb197 100644
--- a/m4/fstatat.m4
+++ b/m4/fstatat.m4
@@ -1,4 +1,5 @@
-# fstatat.m4 serial 5
+# 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,
diff --git a/m4/fsusage.m4 b/m4/fsusage.m4
index 31d424c857d..1ce90660858 100644
--- a/m4/fsusage.m4
+++ b/m4/fsusage.m4
@@ -1,11 +1,11 @@
+# fsusage.m4
# serial 35
-# Obtaining file system usage information.
+dnl Copyright (C) 1997-1998, 2000-2001, 2003-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.
-# 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,
-# with or without modifications, as long as this notice is preserved.
+# Obtaining file system usage information.
# Written by Jim Meyering.
diff --git a/m4/fsync.m4 b/m4/fsync.m4
index 08e3db8931e..6f49321c2db 100644
--- a/m4/fsync.m4
+++ b/m4/fsync.m4
@@ -1,4 +1,5 @@
-# fsync.m4 serial 2
+# fsync.m4
+# serial 2
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,
diff --git a/m4/futimens.m4 b/m4/futimens.m4
index ac961e7bde5..b5f22605f49 100644
--- a/m4/futimens.m4
+++ b/m4/futimens.m4
@@ -1,11 +1,12 @@
+# futimens.m4
# serial 11
-# See if we need to provide futimens replacement.
-
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,
dnl with or without modifications, as long as this notice is preserved.
+# See if we need to provide futimens replacement.
+
# Written by Eric Blake.
AC_DEFUN([gl_FUNC_FUTIMENS],
diff --git a/m4/getdelim.m4 b/m4/getdelim.m4
index 0dbd8bc6f8b..61139039554 100644
--- a/m4/getdelim.m4
+++ b/m4/getdelim.m4
@@ -1,4 +1,5 @@
-# getdelim.m4 serial 19
+# getdelim.m4
+# serial 19
dnl Copyright (C) 2005-2007, 2009-2024 Free Software Foundation, Inc.
dnl
diff --git a/m4/getdtablesize.m4 b/m4/getdtablesize.m4
index 3b89456baf9..aaefe9b2983 100644
--- a/m4/getdtablesize.m4
+++ b/m4/getdtablesize.m4
@@ -1,4 +1,5 @@
-# getdtablesize.m4 serial 8
+# getdtablesize.m4
+# serial 8
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,
diff --git a/m4/getgroups.m4 b/m4/getgroups.m4
index f6e0cbd3fce..5457275e9e1 100644
--- a/m4/getgroups.m4
+++ b/m4/getgroups.m4
@@ -1,14 +1,13 @@
+# getgroups.m4
# serial 25
+dnl Copyright (C) 1996-1997, 1999-2004, 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.
dnl From Jim Meyering.
dnl A wrapper around AC_FUNC_GETGROUPS.
-# 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,
-# with or without modifications, as long as this notice is preserved.
-
# This is taken from the following Autoconf patch:
#
https://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=7fbb553727ed7e0e689a17594b58559ecf3ea6e9
AC_DEFUN([AC_FUNC_GETGROUPS],
diff --git a/m4/getline.m4 b/m4/getline.m4
index 1a7e89034bc..36513cd4171 100644
--- a/m4/getline.m4
+++ b/m4/getline.m4
@@ -1,4 +1,5 @@
-# getline.m4 serial 33
+# getline.m4
+# serial 33
dnl Copyright (C) 1998-2003, 2005-2007, 2009-2024 Free Software Foundation,
dnl Inc.
diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4
index 9d0236f77fe..0918bcd21ec 100644
--- a/m4/getloadavg.m4
+++ b/m4/getloadavg.m4
@@ -1,13 +1,12 @@
-# Check for getloadavg.
-
-# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2024 Free Software
-# Foundation, Inc.
+# getloadavg.m4
+# serial 13
+dnl Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-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.
-# 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 13
+# Check for getloadavg.
# Autoconf defines AC_FUNC_GETLOADAVG, but that is obsolescent.
# New applications should use gl_GETLOADAVG instead.
diff --git a/m4/getopt.m4 b/m4/getopt.m4
index be812d8459b..297722eae44 100644
--- a/m4/getopt.m4
+++ b/m4/getopt.m4
@@ -1,4 +1,5 @@
-# getopt.m4 serial 49
+# 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,
diff --git a/m4/getrandom.m4 b/m4/getrandom.m4
index 55be445c31a..0051c9c4218 100644
--- a/m4/getrandom.m4
+++ b/m4/getrandom.m4
@@ -1,4 +1,5 @@
-# getrandom.m4 serial 13
+# 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,
diff --git a/m4/gettime.m4 b/m4/gettime.m4
index 1ec018d5154..299f3d1b788 100644
--- a/m4/gettime.m4
+++ b/m4/gettime.m4
@@ -1,4 +1,5 @@
-# gettime.m4 serial 15
+# 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,
diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4
index 35269914ced..8135f89e584 100644
--- a/m4/gettimeofday.m4
+++ b/m4/gettimeofday.m4
@@ -1,9 +1,9 @@
+# gettimeofday.m4
# serial 30
-
-# 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.
+dnl Copyright (C) 2001-2003, 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.
dnl From Jim Meyering.
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index d8d0904f787..cb730449507 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,4 +1,5 @@
-# gnulib-common.m4 serial 92
+# gnulib-common.m4
+# serial 93
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,
@@ -504,8 +505,10 @@ AC_DEFUN([gl_COMMON_BODY], [
minimizing the memory required. */
/* Applies to: struct members, struct, union,
in C++ also: class. */
+/* Oracle Studio 12.6 miscompiles code with __attribute__ ((__packed__))
despite
+ __has_attribute OK. */
#ifndef _GL_ATTRIBUTE_PACKED
-# if _GL_HAS_ATTRIBUTE (packed)
+# if _GL_HAS_ATTRIBUTE (packed) && !defined __SUNPRO_C
# define _GL_ATTRIBUTE_PACKED __attribute__ ((__packed__))
# else
# define _GL_ATTRIBUTE_PACKED
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index d8b92e7b122..4dd1e68d15c 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -63,9 +63,6 @@ AC_DEFUN([gl_EARLY],
# Code from module cloexec:
# Code from module close-stream:
# Code from module copy-file-range:
- # Code from module count-leading-zeros:
- # Code from module count-one-bits:
- # Code from module count-trailing-zeros:
# Code from module crypto/md5:
# Code from module crypto/md5-buffer:
# Code from module crypto/sha1-buffer:
@@ -174,7 +171,12 @@ AC_DEFUN([gl_EARLY],
# Code from module ssize_t:
# Code from module stat-time:
# Code from module std-gnu11:
+ # Code from module stdbit-h:
# Code from module stdbool:
+ # Code from module stdc_bit_width:
+ # Code from module stdc_count_ones:
+ # Code from module stdc_leading_zeros:
+ # Code from module stdc_trailing_zeros:
# Code from module stdckdint:
# Code from module stddef:
# Code from module stdint:
@@ -192,6 +194,7 @@ AC_DEFUN([gl_EARLY],
# Code from module sys_stat:
# Code from module sys_time:
# Code from module sys_types:
+ AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
# Code from module tempname:
# Code from module time-h:
# Code from module time_r:
@@ -513,7 +516,18 @@ AC_DEFUN([gl_INIT],
gt_TYPE_SSIZE_T
gl_STAT_TIME
gl_STAT_BIRTHTIME
+ gl_STDBIT_H
+ gl_CONDITIONAL_HEADER([stdbit.h])
+ AC_PROG_MKDIR_P
gl_C_BOOL
+ AC_REQUIRE([gl_STDBIT_H])
+ GL_STDC_BIT_WIDTH=1
+ AC_REQUIRE([gl_STDBIT_H])
+ GL_STDC_COUNT_ONES=1
+ AC_REQUIRE([gl_STDBIT_H])
+ GL_STDC_LEADING_ZEROS=1
+ AC_REQUIRE([gl_STDBIT_H])
+ GL_STDC_TRAILING_ZEROS=1
AC_CHECK_HEADERS_ONCE([stdckdint.h])
if test $ac_cv_header_stdckdint_h = yes; then
GL_GENERATE_STDCKDINT_H=false
@@ -672,6 +686,7 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false
gl_gnulib_enabled_strtoll=false
gl_gnulib_enabled_utimens=false
+ gl_gnulib_enabled_verify=false
gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false
func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b ()
{
@@ -952,6 +967,12 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_utimens=true
fi
}
+ func_gl_gnulib_m4code_verify ()
+ {
+ if $gl_gnulib_enabled_verify; then :; else
+ gl_gnulib_enabled_verify=true
+ fi
+ }
func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec ()
{
if $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then :; else
@@ -1015,6 +1036,9 @@ AC_DEFUN([gl_INIT],
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 $REPLACE_MKTIME = 1; then
+ func_gl_gnulib_m4code_verify
+ fi
if test $HAVE_READLINKAT = 0 || test $REPLACE_READLINKAT = 1; then
func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b
fi
@@ -1024,6 +1048,9 @@ AC_DEFUN([gl_INIT],
if test $ac_use_included_regex = yes; then
func_gl_gnulib_m4code_fd38c7e463b54744b77b98aeafb4fa7c
fi
+ if test $ac_use_included_regex = yes; then
+ func_gl_gnulib_m4code_verify
+ fi
if test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
func_gl_gnulib_m4code_strtoll
fi
@@ -1064,6 +1091,7 @@ AC_DEFUN([gl_INIT],
AM_CONDITIONAL([gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c],
[$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c])
AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll])
AM_CONDITIONAL([gl_GNULIB_ENABLED_utimens], [$gl_gnulib_enabled_utimens])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_verify], [$gl_gnulib_enabled_verify])
AM_CONDITIONAL([gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec],
[$gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec])
# End of code from modules
m4_ifval(gl_LIBSOURCES_LIST, [
@@ -1258,6 +1286,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/boot-time-aux.h
lib/boot-time.c
lib/boot-time.h
+ lib/byteswap.c
lib/byteswap.in.h
lib/c++defs.h
lib/c-ctype.c
@@ -1274,12 +1303,6 @@ AC_DEFUN([gl_FILE_LIST], [
lib/close-stream.c
lib/close-stream.h
lib/copy-file-range.c
- lib/count-leading-zeros.c
- lib/count-leading-zeros.h
- lib/count-one-bits.c
- lib/count-one-bits.h
- lib/count-trailing-zeros.c
- lib/count-trailing-zeros.h
lib/diffseq.h
lib/dirent-private.h
lib/dirent.in.h
@@ -1412,6 +1435,12 @@ AC_DEFUN([gl_FILE_LIST], [
lib/signal.in.h
lib/stat-time.c
lib/stat-time.h
+ lib/stdbit.c
+ lib/stdbit.in.h
+ lib/stdc_bit_width.c
+ lib/stdc_count_ones.c
+ lib/stdc_leading_zeros.c
+ lib/stdc_trailing_zeros.c
lib/stdckdint.in.h
lib/stddef.in.h
lib/stdint.in.h
@@ -1538,6 +1567,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/nocrash.m4
m4/nproc.m4
m4/nstrftime.m4
+ m4/off64_t.m4
m4/off_t.m4
m4/open-cloexec.m4
m4/open-slash.m4
@@ -1564,6 +1594,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/stat-time.m4
m4/std-gnu11.m4
m4/stdalign.m4
+ m4/stdbit_h.m4
m4/stddef_h.m4
m4/stdint.m4
m4/stdio_h.m4
diff --git a/m4/group-member.m4 b/m4/group-member.m4
index 60b3d526db2..f8ceb1d8186 100644
--- a/m4/group-member.m4
+++ b/m4/group-member.m4
@@ -1,10 +1,9 @@
+# group-member.m4
# serial 14
-
-# 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,
-# with or without modifications, as long as this notice is preserved.
+dnl Copyright (C) 1999-2001, 2003-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.
dnl Written by Jim Meyering
diff --git a/m4/ieee754-h.m4 b/m4/ieee754-h.m4
index cc8ef32bd32..fa41db5c945 100644
--- a/m4/ieee754-h.m4
+++ b/m4/ieee754-h.m4
@@ -1,10 +1,12 @@
-# Configure ieee754-h module
-
+# ieee754-h.m4
+# serial 1
dnl Copyright 2018-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.
+# Configure ieee754-h module
+
AC_DEFUN([gl_IEEE754_H],
[
AC_REQUIRE([AC_C_BIGENDIAN])
diff --git a/m4/include_next.m4 b/m4/include_next.m4
index 70cb746f435..03e852518e4 100644
--- a/m4/include_next.m4
+++ b/m4/include_next.m4
@@ -1,4 +1,5 @@
-# include_next.m4 serial 27
+# 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,
diff --git a/m4/inttypes.m4 b/m4/inttypes.m4
index 6abf9dbe280..c43cd16207b 100644
--- a/m4/inttypes.m4
+++ b/m4/inttypes.m4
@@ -1,4 +1,5 @@
-# inttypes.m4 serial 37
+# inttypes.m4
+# serial 37
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,
diff --git a/m4/largefile.m4 b/m4/largefile.m4
index cbe9bc1f63d..2f824089b0a 100644
--- a/m4/largefile.m4
+++ b/m4/largefile.m4
@@ -1,11 +1,13 @@
+# largefile.m4
+# serial 1
+dnl Copyright 1992-1996, 1998-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.
+
# Enable large files on systems where this is not the default.
# Enable support for files on Linux file systems with 64-bit inode numbers.
-# Copyright 1992-1996, 1998-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.
-
# The following macro works around a problem in Autoconf's AC_FUNC_FSEEKO:
# It does not set _LARGEFILE_SOURCE=1 on HP-UX/ia64 32-bit, although this
# setting of _LARGEFILE_SOURCE is needed so that <stdio.h> declares fseeko
@@ -24,9 +26,20 @@ AC_DEFUN([gl_SET_LARGEFILE_SOURCE],
]])
)
+dnl Remove AC_SYS_YEAR2038_RECOMMENDED if unpatched Autoconf 2.72 or earlier.
+dnl Autoconf 2.72 still uses -n32, which is not a C preprocessor option,
+dnl and which was useful only on IRIX which is no longer supported.
+dnl This should be fixed in Autoconf 2.73.
+m4_ifdef([AC_SYS_YEAR2038_RECOMMENDED],
+ [m4_bmatch(m4_ifdef([_AC_SYS_LARGEFILE_OPTIONS],
+ [m4_defn([_AC_SYS_LARGEFILE_OPTIONS])],
+ ["-n32"]),
+ ["-n32"],
+ [m4_undefine([AC_SYS_YEAR2038_RECOMMENDED])])])
+
m4_ifndef([AC_SYS_YEAR2038_RECOMMENDED], [
-# Support AC_SYS_YEAR2038_RECOMMENDED and related macros, even if
-# Autoconf 2.71 or earlier. This code is taken from Autoconf master.
+# Fix up AC_SYS_YEAR2038_RECOMMENDED and related macros, even if
+# unpatched Autoconf 2.72 or earlier. This code is taken from Autoconf master.
# _AC_SYS_YEAR2038_TEST_CODE
# --------------------------
@@ -75,7 +88,7 @@ m4_define([_AC_SYS_YEAR2038_OPTIONS], m4_normalize(
# If you change this macro you may also need to change
# _AC_SYS_YEAR2038_OPTIONS.
AC_DEFUN([_AC_SYS_YEAR2038_PROBE],
-[AC_CACHE_CHECK([for $CC option for timestamps after 2038],
+[AC_CACHE_CHECK([for $CPPFLAGS option for timestamps after 2038],
[ac_cv_sys_year2038_opts],
[ac_save_CPPFLAGS="$CPPFLAGS"
ac_opt_found=no
@@ -205,7 +218,6 @@ m4_define([_AC_SYS_LARGEFILE_OPTIONS], m4_normalize(
["none needed"] dnl Most current systems
["-D_FILE_OFFSET_BITS=64"] dnl X/Open LFS spec
["-D_LARGE_FILES=1"] dnl 32-bit AIX 4.2.1+, 32-bit z/OS
- ["-n32"] dnl 32-bit IRIX 6, SGI cc (obsolete)
))
# _AC_SYS_LARGEFILE_PROBE
@@ -222,25 +234,25 @@ m4_define([_AC_SYS_LARGEFILE_OPTIONS], m4_normalize(
# If you change this macro you may also need to change
# _AC_SYS_LARGEFILE_OPTIONS.
AC_DEFUN([_AC_SYS_LARGEFILE_PROBE],
-[AC_CACHE_CHECK([for $CC option to enable large file support],
+[AC_CACHE_CHECK([for $CPPFLAGS option for large files],
[ac_cv_sys_largefile_opts],
- [ac_save_CC="$CC"
+ [ac_save_CPPFLAGS=$CPPFLAGS
ac_opt_found=no
for ac_opt in _AC_SYS_LARGEFILE_OPTIONS; do
AS_IF([test x"$ac_opt" != x"none needed"],
- [CC="$ac_save_CC $ac_opt"])
+ [CPPFLAGS="$ac_save_CPPFLAGS $ac_opt"])
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([_AC_SYS_LARGEFILE_TEST_CODE])],
[AS_IF([test x"$ac_opt" = x"none needed"],
[# GNU/Linux s390x and alpha need _FILE_OFFSET_BITS=64 for wide ino_t.
- CC="$CC -DFTYPE=ino_t"
+ CPPFLAGS="$CPPFLAGS -DFTYPE=ino_t"
AC_COMPILE_IFELSE([], [],
- [CC="$CC -D_FILE_OFFSET_BITS=64"
+ [CPPFLAGS="$CPPFLAGS -D_FILE_OFFSET_BITS=64"
AC_COMPILE_IFELSE([], [ac_opt='-D_FILE_OFFSET_BITS=64'])])])
ac_cv_sys_largefile_opts=$ac_opt
ac_opt_found=yes])
test $ac_opt_found = no || break
done
- CC="$ac_save_CC"
+ CPPFLAGS=$ac_save_CPPFLAGS
dnl Gnulib implements large file support for native Windows, based on the
dnl variables WINDOWS_64_BIT_OFF_T, WINDOWS_64_BIT_ST_SIZE.
m4_ifdef([gl_LARGEFILE], [
@@ -270,9 +282,6 @@ AS_CASE([$ac_cv_sys_largefile_opts],
[AC_DEFINE([_LARGE_FILES], [1],
[Define to 1 on platforms where this makes off_t a 64-bit type.])],
- ["-n32"],
- [CC="$CC -n32"],
-
[AC_MSG_ERROR(
[internal error: bad value for \$ac_cv_sys_largefile_opts])])
diff --git a/m4/lchmod.m4 b/m4/lchmod.m4
index 7b263a241eb..797cb446938 100644
--- a/m4/lchmod.m4
+++ b/m4/lchmod.m4
@@ -1,5 +1,5 @@
-#serial 10
-
+# lchmod.m4
+# serial 10
dnl Copyright (C) 2005-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,
diff --git a/m4/libgmp.m4 b/m4/libgmp.m4
index 782dfbae2e1..a82a6fa1b71 100644
--- a/m4/libgmp.m4
+++ b/m4/libgmp.m4
@@ -1,4 +1,5 @@
-# libgmp.m4 serial 8
+# libgmp.m4
+# serial 8
# Configure the GMP library or a replacement.
dnl Copyright 2020-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
diff --git a/m4/limits-h.m4 b/m4/limits-h.m4
index 1825328380b..1b619e1eb2e 100644
--- a/m4/limits-h.m4
+++ b/m4/limits-h.m4
@@ -1,10 +1,12 @@
-dnl Check whether limits.h has needed features.
-
+# limits-h.m4
+# serial 1
dnl Copyright 2016-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.
+dnl Check whether limits.h has needed features.
+
dnl From Paul Eggert.
AC_DEFUN_ONCE([gl_LIMITS_H],
diff --git a/m4/lstat.m4 b/m4/lstat.m4
index 48cc8653fe6..f838e2cc1e8 100644
--- a/m4/lstat.m4
+++ b/m4/lstat.m4
@@ -1,10 +1,9 @@
+# lstat.m4
# serial 36
-
-# Copyright (C) 1997-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,
-# with or without modifications, as long as this notice is preserved.
+dnl Copyright (C) 1997-2001, 2003-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.
dnl From Jim Meyering.
diff --git a/m4/malloc.m4 b/m4/malloc.m4
index 635d6726b11..41a46937ead 100644
--- a/m4/malloc.m4
+++ b/m4/malloc.m4
@@ -1,4 +1,5 @@
-# malloc.m4 serial 31
+# 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,
diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4
index 3c6795ceb28..14bc5041eaa 100644
--- a/m4/manywarnings.m4
+++ b/m4/manywarnings.m4
@@ -1,4 +1,5 @@
-# manywarnings.m4 serial 25
+# manywarnings.m4
+# serial 26
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,
@@ -110,6 +111,7 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)],
-Wduplicated-cond \
-Wextra \
-Wformat-signedness \
+ -Wflex-array-member-not-at-end \
-Winit-self \
-Winline \
-Winvalid-pch \
@@ -117,6 +119,7 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)],
-Wmissing-declarations \
-Wmissing-include-dirs \
-Wmissing-prototypes \
+ -Wmissing-variable-declarations \
-Wnested-externs \
-Wnull-dereference \
-Wold-style-definition \
diff --git a/m4/mbstate_t.m4 b/m4/mbstate_t.m4
index b2bcba45e96..66d65cd7c11 100644
--- a/m4/mbstate_t.m4
+++ b/m4/mbstate_t.m4
@@ -1,4 +1,5 @@
-# mbstate_t.m4 serial 14
+# mbstate_t.m4
+# serial 14
dnl Copyright (C) 2000-2002, 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,
diff --git a/m4/md5.m4 b/m4/md5.m4
index 7af56a8a3d1..a7b33d771ff 100644
--- a/m4/md5.m4
+++ b/m4/md5.m4
@@ -1,4 +1,5 @@
-# md5.m4 serial 14
+# md5.m4
+# serial 14
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,
diff --git a/m4/memmem.m4 b/m4/memmem.m4
index 7985266f8b7..a9bc277813b 100644
--- a/m4/memmem.m4
+++ b/m4/memmem.m4
@@ -1,4 +1,5 @@
-# memmem.m4 serial 29
+# memmem.m4
+# serial 29
dnl Copyright (C) 2002-2004, 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,
diff --git a/m4/mempcpy.m4 b/m4/mempcpy.m4
index 94ce05d1a6a..377fda3caca 100644
--- a/m4/mempcpy.m4
+++ b/m4/mempcpy.m4
@@ -1,4 +1,5 @@
-# mempcpy.m4 serial 14
+# mempcpy.m4
+# serial 14
dnl Copyright (C) 2003-2004, 2006-2007, 2009-2024 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
diff --git a/m4/memrchr.m4 b/m4/memrchr.m4
index b4ccdfa3c8d..d8c931e90cc 100644
--- a/m4/memrchr.m4
+++ b/m4/memrchr.m4
@@ -1,4 +1,5 @@
-# memrchr.m4 serial 11
+# memrchr.m4
+# serial 11
dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
diff --git a/m4/memset_explicit.m4 b/m4/memset_explicit.m4
index 19514ff917e..499a95968ab 100644
--- a/m4/memset_explicit.m4
+++ b/m4/memset_explicit.m4
@@ -1,4 +1,5 @@
-# memset_explicit.m4 serial 2
+# memset_explicit.m4
+# serial 3
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,6 +8,8 @@ dnl with or without modifications, as long as this notice is
preserved.
AC_DEFUN([gl_FUNC_MEMSET_EXPLICIT],
[
AC_REQUIRE([gl_STRING_H_DEFAULTS])
+ dnl Persuade OpenSolaris derivatives' <string.h> to declare memset_s().
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
gl_CHECK_FUNCS_ANDROID([memset_explicit], [[#include <string.h>]])
if test $ac_cv_func_memset_explicit = no; then
diff --git a/m4/minmax.m4 b/m4/minmax.m4
index 5c0a927da66..bc7d0c345fa 100644
--- a/m4/minmax.m4
+++ b/m4/minmax.m4
@@ -1,4 +1,5 @@
-# minmax.m4 serial 4
+# minmax.m4
+# serial 4
dnl Copyright (C) 2005, 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,
diff --git a/m4/mkostemp.m4 b/m4/mkostemp.m4
index 1c22b8d51b4..57a033b859e 100644
--- a/m4/mkostemp.m4
+++ b/m4/mkostemp.m4
@@ -1,4 +1,5 @@
-# mkostemp.m4 serial 4
+# mkostemp.m4
+# serial 4
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,
diff --git a/m4/mktime.m4 b/m4/mktime.m4
index 0565e5e61fe..85c52454aa5 100644
--- a/m4/mktime.m4
+++ b/m4/mktime.m4
@@ -1,6 +1,6 @@
+# mktime.m4
# serial 39
-dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software Foundation,
-dnl Inc.
+dnl Copyright (C) 2002-2003, 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.
diff --git a/m4/mode_t.m4 b/m4/mode_t.m4
index af88da51285..0d5c2808289 100644
--- a/m4/mode_t.m4
+++ b/m4/mode_t.m4
@@ -1,4 +1,5 @@
-# mode_t.m4 serial 2
+# mode_t.m4
+# serial 2
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,
diff --git a/m4/multiarch.m4 b/m4/multiarch.m4
index 5f8339f5c7d..3af29d39a0b 100644
--- a/m4/multiarch.m4
+++ b/m4/multiarch.m4
@@ -1,4 +1,5 @@
-# multiarch.m4 serial 9
+# multiarch.m4
+# serial 9
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,
diff --git a/m4/musl.m4 b/m4/musl.m4
index 34d2c1ff22a..0d4de8926a2 100644
--- a/m4/musl.m4
+++ b/m4/musl.m4
@@ -1,4 +1,5 @@
-# musl.m4 serial 4
+# musl.m4
+# serial 4
dnl Copyright (C) 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,
diff --git a/m4/nanosleep.m4 b/m4/nanosleep.m4
index ff730b676cd..a7281b8ac5f 100644
--- a/m4/nanosleep.m4
+++ b/m4/nanosleep.m4
@@ -1,15 +1,13 @@
+# nanosleep.m4
# serial 47
+dnl Copyright (C) 1999-2001, 2003-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.
dnl From Jim Meyering.
dnl Check for the nanosleep function.
dnl If not found, use the supplied replacement.
-dnl
-
-# Copyright (C) 1999-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,
-# with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_FUNC_NANOSLEEP],
[
diff --git a/m4/ndk-build.m4 b/m4/ndk-build.m4
index abe06063ab0..2689ee34287 100644
--- a/m4/ndk-build.m4
+++ b/m4/ndk-build.m4
@@ -339,6 +339,16 @@ NDK_BUILD_NASM=
AS_IF([test "$ndk_ARCH" = "x86" || test "$ndk_ARCH" = "x86_64"],
[AC_CHECK_PROGS([NDK_BUILD_NASM], [nasm])])
+# Search for a suitable readelf binary, which is required to generate
+# the shared library list loaded on old Android systems.
+AC_PATH_PROGS([READELF], [readelf llvm-readelf $host_alias-readelf],
+ [], [$ndk_ranlib_search_path:$PATH])
+AS_IF([test -z "$READELF"],
+ [AC_MSG_ERROR([A suitable `readelf' utility cannot be located.
+Please verify that the Android NDK has been installed correctly,
+or install a functioning `readelf' yourself.])])
+NDK_BUILD_READELF="$READELF"
+
# Search for a C++ compiler. Upon failure, pretend the C compiler is a
# C++ compiler and use that instead.
@@ -644,6 +654,7 @@ AC_DEFUN_ONCE([ndk_CONFIG_FILES],
AC_SUBST([NDK_BUILD_CXX_LDFLAGS])
AC_SUBST([NDK_BUILD_ANY_CXX_MODULE])
AC_SUBST([NDK_BUILD_CFLAGS])
+ AC_SUBST([NDK_BUILD_READELF])
AC_CONFIG_FILES([$ndk_DIR/Makefile])
AC_CONFIG_FILES([$ndk_DIR/ndk-build.mk])
diff --git a/m4/nocrash.m4 b/m4/nocrash.m4
index 9730fc09034..cbe8fe82d5d 100644
--- a/m4/nocrash.m4
+++ b/m4/nocrash.m4
@@ -1,4 +1,5 @@
-# nocrash.m4 serial 5
+# nocrash.m4
+# serial 5
dnl Copyright (C) 2005, 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,
diff --git a/m4/nproc.m4 b/m4/nproc.m4
index e4065776a86..317741d9b8d 100644
--- a/m4/nproc.m4
+++ b/m4/nproc.m4
@@ -1,4 +1,5 @@
-# nproc.m4 serial 6
+# nproc.m4
+# serial 6
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,
diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4
index aa5d63a54b5..f73bca40ec1 100644
--- a/m4/nstrftime.m4
+++ b/m4/nstrftime.m4
@@ -1,10 +1,9 @@
+# nstrftime.m4
# serial 38
-
-# 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,
-# with or without modifications, as long as this notice is preserved.
+dnl Copyright (C) 1996-1997, 1999-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.
# Written by Jim Meyering and Paul Eggert.
diff --git a/m4/off_t.m4 b/m4/off_t.m4
index f3259f9c245..db6035dbeb3 100644
--- a/m4/off_t.m4
+++ b/m4/off_t.m4
@@ -1,4 +1,5 @@
-# off_t.m4 serial 1
+# off_t.m4
+# serial 1
dnl Copyright (C) 2012-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,
diff --git a/m4/open-cloexec.m4 b/m4/open-cloexec.m4
index a2d50329b97..6defdfb4005 100644
--- a/m4/open-cloexec.m4
+++ b/m4/open-cloexec.m4
@@ -1,10 +1,12 @@
-# Test whether O_CLOEXEC is defined.
-
+# open-cloexec.m4
+# serial 1
dnl Copyright 2017-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.
+# Test whether O_CLOEXEC is defined.
+
AC_DEFUN([gl_PREPROC_O_CLOEXEC],
[
AC_CACHE_CHECK([for O_CLOEXEC],
diff --git a/m4/open-slash.m4 b/m4/open-slash.m4
index 45310c0c581..03460e422d9 100644
--- a/m4/open-slash.m4
+++ b/m4/open-slash.m4
@@ -1,4 +1,5 @@
-# open-slash.m4 serial 2
+# open-slash.m4
+# serial 2
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,
diff --git a/m4/open.m4 b/m4/open.m4
index 91e5c31b59a..62a11a110c5 100644
--- a/m4/open.m4
+++ b/m4/open.m4
@@ -1,4 +1,5 @@
-# open.m4 serial 16
+# 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,
diff --git a/m4/pathmax.m4 b/m4/pathmax.m4
index a0fc296c9b2..4280837f1e1 100644
--- a/m4/pathmax.m4
+++ b/m4/pathmax.m4
@@ -1,4 +1,5 @@
-# pathmax.m4 serial 11
+# pathmax.m4
+# serial 11
dnl Copyright (C) 2002-2003, 2005-2006, 2009-2024 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
diff --git a/m4/pid_t.m4 b/m4/pid_t.m4
index 8f8d39d81db..8bedcc6bcd3 100644
--- a/m4/pid_t.m4
+++ b/m4/pid_t.m4
@@ -1,4 +1,5 @@
-# pid_t.m4 serial 4
+# pid_t.m4
+# serial 4
dnl Copyright (C) 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,
diff --git a/m4/pipe2.m4 b/m4/pipe2.m4
index 74b7b284b3e..e8ace7f077e 100644
--- a/m4/pipe2.m4
+++ b/m4/pipe2.m4
@@ -1,4 +1,5 @@
-# pipe2.m4 serial 4
+# pipe2.m4
+# serial 4
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,
diff --git a/m4/pselect.m4 b/m4/pselect.m4
index 005b722b965..23d1fadd637 100644
--- a/m4/pselect.m4
+++ b/m4/pselect.m4
@@ -1,4 +1,5 @@
-# pselect.m4 serial 11
+# pselect.m4
+# serial 11
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,
diff --git a/m4/pthread_sigmask.m4 b/m4/pthread_sigmask.m4
index cb2ee900313..437869f6dbe 100644
--- a/m4/pthread_sigmask.m4
+++ b/m4/pthread_sigmask.m4
@@ -1,4 +1,5 @@
-# pthread_sigmask.m4 serial 23
+# 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,
diff --git a/m4/rawmemchr.m4 b/m4/rawmemchr.m4
index 57d1c2915e3..6e0fa0a55e8 100644
--- a/m4/rawmemchr.m4
+++ b/m4/rawmemchr.m4
@@ -1,4 +1,5 @@
-# rawmemchr.m4 serial 3
+# rawmemchr.m4
+# serial 3
dnl Copyright (C) 2003, 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,
diff --git a/m4/readlink.m4 b/m4/readlink.m4
index 6d78ec84a03..bc9a5deb06e 100644
--- a/m4/readlink.m4
+++ b/m4/readlink.m4
@@ -1,4 +1,5 @@
-# readlink.m4 serial 17
+# readlink.m4
+# serial 17
dnl Copyright (C) 2003, 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,
diff --git a/m4/readlinkat.m4 b/m4/readlinkat.m4
index 99822102294..8a33c169136 100644
--- a/m4/readlinkat.m4
+++ b/m4/readlinkat.m4
@@ -1,11 +1,12 @@
+# readlinkat.m4
# serial 8
-# See if we need to provide readlinkat replacement.
-
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,
dnl with or without modifications, as long as this notice is preserved.
+# See if we need to provide readlinkat replacement.
+
# Written by Eric Blake.
AC_DEFUN([gl_FUNC_READLINKAT],
diff --git a/m4/readutmp.m4 b/m4/readutmp.m4
index ec40019735f..1d9071fe65a 100644
--- a/m4/readutmp.m4
+++ b/m4/readutmp.m4
@@ -1,4 +1,5 @@
-# readutmp.m4 serial 31
+# 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,
diff --git a/m4/realloc.m4 b/m4/realloc.m4
index a59af2807c9..eb90d5885c7 100644
--- a/m4/realloc.m4
+++ b/m4/realloc.m4
@@ -1,4 +1,5 @@
-# realloc.m4 serial 29
+# 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,
diff --git a/m4/regex.m4 b/m4/regex.m4
index 3dfeabea057..f0101fe67c6 100644
--- a/m4/regex.m4
+++ b/m4/regex.m4
@@ -1,10 +1,9 @@
+# regex.m4
# serial 75
-
-# Copyright (C) 1996-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,
-# with or without modifications, as long as this notice is preserved.
+dnl Copyright (C) 1996-2001, 2003-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.
dnl Initially derived from code in GNU grep.
dnl Mostly written by Jim Meyering.
diff --git a/m4/sha1.m4 b/m4/sha1.m4
index c0a87536a5c..51f2afe8d0d 100644
--- a/m4/sha1.m4
+++ b/m4/sha1.m4
@@ -1,4 +1,5 @@
-# sha1.m4 serial 12
+# sha1.m4
+# serial 12
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,
diff --git a/m4/sha256.m4 b/m4/sha256.m4
index 2dd754c1778..ad5596a488f 100644
--- a/m4/sha256.m4
+++ b/m4/sha256.m4
@@ -1,4 +1,5 @@
-# sha256.m4 serial 8
+# sha256.m4
+# serial 8
dnl Copyright (C) 2005, 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,
diff --git a/m4/sha512.m4 b/m4/sha512.m4
index 19d03b50271..86e5518beec 100644
--- a/m4/sha512.m4
+++ b/m4/sha512.m4
@@ -1,4 +1,5 @@
-# sha512.m4 serial 9
+# sha512.m4
+# serial 9
dnl Copyright (C) 2005-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,
diff --git a/m4/sig2str.m4 b/m4/sig2str.m4
index ab3786b8954..096d0253fcb 100644
--- a/m4/sig2str.m4
+++ b/m4/sig2str.m4
@@ -1,3 +1,4 @@
+# sig2str.m4
# serial 7
dnl Copyright (C) 2002, 2005-2006, 2009-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
diff --git a/m4/sigdescr_np.m4 b/m4/sigdescr_np.m4
index d844e2f9db7..72da5e957ca 100644
--- a/m4/sigdescr_np.m4
+++ b/m4/sigdescr_np.m4
@@ -1,4 +1,5 @@
-# sigdescr_np.m4 serial 2
+# sigdescr_np.m4
+# serial 2
dnl Copyright (C) 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,
diff --git a/m4/signal_h.m4 b/m4/signal_h.m4
index 6f7dcc733b4..65afa2a1dee 100644
--- a/m4/signal_h.m4
+++ b/m4/signal_h.m4
@@ -1,4 +1,5 @@
-# signal_h.m4 serial 22
+# signal_h.m4
+# serial 22
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,
diff --git a/m4/socklen.m4 b/m4/socklen.m4
index 9c46db18937..9ece0abb6d0 100644
--- a/m4/socklen.m4
+++ b/m4/socklen.m4
@@ -1,4 +1,5 @@
-# socklen.m4 serial 11
+# socklen.m4
+# serial 11
dnl Copyright (C) 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,
diff --git a/m4/ssize_t.m4 b/m4/ssize_t.m4
index 25b28d77e4e..c15f948adb7 100644
--- a/m4/ssize_t.m4
+++ b/m4/ssize_t.m4
@@ -1,4 +1,5 @@
-# ssize_t.m4 serial 6
+# ssize_t.m4
+# serial 6
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,
diff --git a/m4/stat-time.m4 b/m4/stat-time.m4
index 8bec2f5f815..e8ee7d5125e 100644
--- a/m4/stat-time.m4
+++ b/m4/stat-time.m4
@@ -1,11 +1,11 @@
-# Checks for stat-related time functions.
-
-# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2024 Free Software
-# Foundation, Inc.
+# stat-time.m4
+# serial 1
+dnl Copyright (C) 1998-1999, 2001, 2003, 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.
-# 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.
+# Checks for stat-related time functions.
dnl From Paul Eggert.
diff --git a/m4/std-gnu11.m4 b/m4/std-gnu11.m4
index 59998c17cf7..37324c158e7 100644
--- a/m4/std-gnu11.m4
+++ b/m4/std-gnu11.m4
@@ -1,3 +1,6 @@
+# std-gnu11.m4
+# serial 1
+
# Prefer GNU C11 and C++11 to earlier versions. -*- coding: utf-8 -*-
# This implementation is taken from GNU Autoconf lib/autoconf/c.m4
diff --git a/m4/stdalign.m4 b/m4/stdalign.m4
index e3c1e609236..1c29d1e4fb9 100644
--- a/m4/stdalign.m4
+++ b/m4/stdalign.m4
@@ -1,10 +1,12 @@
-# Check for alignas and alignof that conform to C23.
-
+# stdalign.m4
+# serial 1
dnl Copyright 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,
dnl with or without modifications, as long as this notice is preserved.
+# Check for alignas and alignof that conform to C23.
+
dnl Written by Paul Eggert and Bruno Haible.
# Prepare for substituting <stdalign.h> if it is not supported.
@@ -79,7 +81,7 @@ AC_DEFUN([gl_ALIGNASOF],
References:
ISO C23 (latest free draft
- <http://www.open-std.org/jtc1/sc22/wg14/www/docs/n3047.pdf>)
+ <http://www.open-std.org/jtc1/sc22/wg14/www/docs/n3096.pdf>)
sections 6.5.3.4, 6.7.5, 7.15.
C++11 (latest free draft
<http://www.open-std.org/jtc1/sc22/wg21/docs/papers/2011/n3242.pdf>)
diff --git a/m4/stdbit_h.m4 b/m4/stdbit_h.m4
new file mode 100644
index 00000000000..6af813f39dc
--- /dev/null
+++ b/m4/stdbit_h.m4
@@ -0,0 +1,37 @@
+# stdbit_h.m4
+# serial 2
+dnl Copyright 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.
+
+dnl A placeholder for <stdbit.h>, for platforms that have issues.
+
+AC_DEFUN_ONCE([gl_STDBIT_H],
+[
+ AC_REQUIRE([gl_BIGENDIAN])
+
+ AC_CHECK_HEADERS_ONCE([stdbit.h])
+ if test $ac_cv_header_stdbit_h = yes; then
+ GL_GENERATE_STDBIT_H=false
+ else
+ GL_GENERATE_STDBIT_H=true
+ fi
+
+ dnl We don't use gl_MODULE_INDICATOR_INIT_VARIABLE here, because stdbit.in.h
+ dnl does not use #include_next.
+ GL_STDC_LEADING_ZEROS=0; AC_SUBST([GL_STDC_LEADING_ZEROS])
+ GL_STDC_LEADING_ONES=0; AC_SUBST([GL_STDC_LEADING_ONES])
+ GL_STDC_TRAILING_ZEROS=0; AC_SUBST([GL_STDC_TRAILING_ZEROS])
+ GL_STDC_TRAILING_ONES=0; AC_SUBST([GL_STDC_TRAILING_ONES])
+ GL_STDC_FIRST_LEADING_ZERO=0; AC_SUBST([GL_STDC_FIRST_LEADING_ZERO])
+ GL_STDC_FIRST_LEADING_ONE=0; AC_SUBST([GL_STDC_FIRST_LEADING_ONE])
+ GL_STDC_FIRST_TRAILING_ZERO=0; AC_SUBST([GL_STDC_FIRST_TRAILING_ZERO])
+ GL_STDC_FIRST_TRAILING_ONE=0; AC_SUBST([GL_STDC_FIRST_TRAILING_ONE])
+ GL_STDC_COUNT_ZEROS=0; AC_SUBST([GL_STDC_COUNT_ZEROS])
+ GL_STDC_COUNT_ONES=0; AC_SUBST([GL_STDC_COUNT_ONES])
+ GL_STDC_HAS_SINGLE_BIT=0; AC_SUBST([GL_STDC_HAS_SINGLE_BIT])
+ GL_STDC_BIT_WIDTH=0; AC_SUBST([GL_STDC_BIT_WIDTH])
+ GL_STDC_BIT_FLOOR=0; AC_SUBST([GL_STDC_BIT_FLOOR])
+ GL_STDC_BIT_CEIL=0; AC_SUBST([GL_STDC_BIT_CEIL])
+])
diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4
index 1bf9eb39b66..998fe12fa83 100644
--- a/m4/stddef_h.m4
+++ b/m4/stddef_h.m4
@@ -1,4 +1,5 @@
-# stddef_h.m4 serial 14
+# stddef_h.m4
+# serial 16
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,
@@ -83,6 +84,36 @@ AC_DEFUN_ONCE([gl_STDDEF_H],
GL_GENERATE_STDDEF_H=true
fi
+ dnl https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114869
+ AC_CACHE_CHECK([whether nullptr_t needs <stddef.h>],
+ [gl_cv_nullptr_t_needs_stddef],
+ [AC_COMPILE_IFELSE([AC_LANG_DEFINES_PROVIDED[nullptr_t x;]],
+ [gl_cv_nullptr_t_needs_stddef=no],
+ [gl_cv_nullptr_t_needs_stddef=yes])])
+ if test "$gl_cv_nullptr_t_needs_stddef" = no; then
+ NULLPTR_T_NEEDS_STDDEF=0
+ GL_GENERATE_STDDEF_H=true
+ fi
+
+ AC_CACHE_CHECK([for clean definition of __STDC_VERSION_STDDEF_H__],
+ [gl_cv_clean_version_stddef],
+ [AC_PREPROC_IFELSE(
+ [AC_LANG_SOURCE(
+ [[/* https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114870 */
+ #include <stddef.h>
+ #undef __STDC_VERSION_STDDEF_H__
+ #include <time.h>
+ #ifdef __STDC_VERSION_STDDEF_H__
+ # error "<time.h> defines __STDC_VERSION_STDDEF_H__"
+ #endif
+ ]])],
+ [gl_cv_clean_version_stddef=yes],
+ [gl_cv_clean_version_stddef=no])])
+ if test "$gl_cv_clean_version_stddef" = no; then
+ STDDEF_NOT_IDEMPOTENT=1
+ GL_GENERATE_STDDEF_H=true
+ fi
+
if $GL_GENERATE_STDDEF_H; then
gl_NEXT_HEADERS([stddef.h])
fi
@@ -113,6 +144,8 @@ AC_DEFUN([gl_STDDEF_H_REQUIRE_DEFAULTS],
AC_DEFUN([gl_STDDEF_H_DEFAULTS],
[
dnl Assume proper GNU behavior unless another module says otherwise.
+ NULLPTR_T_NEEDS_STDDEF=1; AC_SUBST([NULLPTR_T_NEEDS_STDDEF])
+ STDDEF_NOT_IDEMPOTENT=0; AC_SUBST([STDDEF_NOT_IDEMPOTENT])
REPLACE_NULL=0; AC_SUBST([REPLACE_NULL])
HAVE_MAX_ALIGN_T=1; AC_SUBST([HAVE_MAX_ALIGN_T])
HAVE_WCHAR_T=1; AC_SUBST([HAVE_WCHAR_T])
diff --git a/m4/stdint.m4 b/m4/stdint.m4
index 4aa250827cc..2dea846914b 100644
--- a/m4/stdint.m4
+++ b/m4/stdint.m4
@@ -1,4 +1,5 @@
-# stdint.m4 serial 63
+# 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,
diff --git a/m4/stdio_h.m4 b/m4/stdio_h.m4
index c19feefe717..8eb5816ad7e 100644
--- a/m4/stdio_h.m4
+++ b/m4/stdio_h.m4
@@ -1,4 +1,5 @@
-# stdio_h.m4 serial 63
+# stdio_h.m4
+# serial 63
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,
diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4
index 92e67a74bb5..bb5a6460414 100644
--- a/m4/stdlib_h.m4
+++ b/m4/stdlib_h.m4
@@ -1,4 +1,5 @@
-# stdlib_h.m4 serial 76
+# stdlib_h.m4
+# serial 78
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,
@@ -109,6 +110,7 @@ AC_DEFUN([gl_STDLIB_H_REQUIRE_DEFAULTS],
[
m4_defun(GL_MODULE_INDICATOR_PREFIX[_STDLIB_H_MODULE_INDICATOR_DEFAULTS], [
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB__EXIT])
+ gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_ABORT_DEBUG])
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_ALIGNED_ALLOC])
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_ATOLL])
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_CALLOC_GNU])
@@ -145,6 +147,7 @@ AC_DEFUN([gl_STDLIB_H_REQUIRE_DEFAULTS],
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_SECURE_GETENV])
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_SETENV])
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRTOD])
+ gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRTOF])
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRTOL])
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRTOLD])
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRTOLL])
@@ -205,6 +208,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
HAVE_SETSTATE=1; AC_SUBST([HAVE_SETSTATE])
HAVE_DECL_SETSTATE=1; AC_SUBST([HAVE_DECL_SETSTATE])
HAVE_STRTOD=1; AC_SUBST([HAVE_STRTOD])
+ HAVE_STRTOF=1; AC_SUBST([HAVE_STRTOF])
HAVE_STRTOL=1; AC_SUBST([HAVE_STRTOL])
HAVE_STRTOLD=1; AC_SUBST([HAVE_STRTOLD])
HAVE_STRTOLL=1; AC_SUBST([HAVE_STRTOLL])
@@ -215,6 +219,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
HAVE_UNLOCKPT=1; AC_SUBST([HAVE_UNLOCKPT])
HAVE_DECL_UNSETENV=1; AC_SUBST([HAVE_DECL_UNSETENV])
REPLACE__EXIT=0; AC_SUBST([REPLACE__EXIT])
+ REPLACE_ABORT=0; AC_SUBST([REPLACE_ABORT])
REPLACE_ALIGNED_ALLOC=0; AC_SUBST([REPLACE_ALIGNED_ALLOC])
REPLACE_CALLOC_FOR_CALLOC_GNU=0; AC_SUBST([REPLACE_CALLOC_FOR_CALLOC_GNU])
REPLACE_CALLOC_FOR_CALLOC_POSIX=0;
AC_SUBST([REPLACE_CALLOC_FOR_CALLOC_POSIX])
@@ -248,6 +253,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
REPLACE_SETENV=0; AC_SUBST([REPLACE_SETENV])
REPLACE_SETSTATE=0; AC_SUBST([REPLACE_SETSTATE])
REPLACE_STRTOD=0; AC_SUBST([REPLACE_STRTOD])
+ REPLACE_STRTOF=0; AC_SUBST([REPLACE_STRTOF])
REPLACE_STRTOL=0; AC_SUBST([REPLACE_STRTOL])
REPLACE_STRTOLD=0; AC_SUBST([REPLACE_STRTOLD])
REPLACE_STRTOLL=0; AC_SUBST([REPLACE_STRTOLL])
diff --git a/m4/stpcpy.m4 b/m4/stpcpy.m4
index 04c8bbe4c94..c4d71dd9fa5 100644
--- a/m4/stpcpy.m4
+++ b/m4/stpcpy.m4
@@ -1,4 +1,5 @@
-# stpcpy.m4 serial 11
+# stpcpy.m4
+# serial 11
dnl Copyright (C) 2002, 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,
diff --git a/m4/string_h.m4 b/m4/string_h.m4
index 9ea748cc774..f31264ae85b 100644
--- a/m4/string_h.m4
+++ b/m4/string_h.m4
@@ -1,11 +1,11 @@
-# Configure a GNU-like replacement for <string.h>.
-
-# Copyright (C) 2007-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.
-
+# string_h.m4
# serial 39
+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,
+dnl with or without modifications, as long as this notice is preserved.
+
+# Configure a GNU-like replacement for <string.h>.
# Written by Paul Eggert.
diff --git a/m4/strnlen.m4 b/m4/strnlen.m4
index 3eac8e629d7..b4d2778524e 100644
--- a/m4/strnlen.m4
+++ b/m4/strnlen.m4
@@ -1,4 +1,5 @@
-# strnlen.m4 serial 14
+# strnlen.m4
+# serial 14
dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
diff --git a/m4/strtoimax.m4 b/m4/strtoimax.m4
index b58fa48ff6e..2a0b50b3428 100644
--- a/m4/strtoimax.m4
+++ b/m4/strtoimax.m4
@@ -1,4 +1,5 @@
-# strtoimax.m4 serial 17
+# 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,
diff --git a/m4/strtoll.m4 b/m4/strtoll.m4
index 130b9094d88..03a50dec2f1 100644
--- a/m4/strtoll.m4
+++ b/m4/strtoll.m4
@@ -1,4 +1,5 @@
-# strtoll.m4 serial 12
+# 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,
diff --git a/m4/symlink.m4 b/m4/symlink.m4
index 62062cf1499..47968a1d33f 100644
--- a/m4/symlink.m4
+++ b/m4/symlink.m4
@@ -1,11 +1,12 @@
+# symlink.m4
# serial 10
-# See if we need to provide symlink replacement.
-
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,
dnl with or without modifications, as long as this notice is preserved.
+# See if we need to provide symlink replacement.
+
# Written by Eric Blake.
AC_DEFUN([gl_FUNC_SYMLINK],
diff --git a/m4/sys_random_h.m4 b/m4/sys_random_h.m4
index b050d079b92..62fd519e365 100644
--- a/m4/sys_random_h.m4
+++ b/m4/sys_random_h.m4
@@ -1,4 +1,5 @@
-# sys_random_h.m4 serial 8
+# sys_random_h.m4
+# serial 8
dnl Copyright (C) 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,
diff --git a/m4/sys_select_h.m4 b/m4/sys_select_h.m4
index 9e279fbab8d..550e066e171 100644
--- a/m4/sys_select_h.m4
+++ b/m4/sys_select_h.m4
@@ -1,4 +1,5 @@
-# sys_select_h.m4 serial 23
+# sys_select_h.m4
+# serial 23
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,
diff --git a/m4/sys_socket_h.m4 b/m4/sys_socket_h.m4
index af524849f03..3bf3cb47778 100644
--- a/m4/sys_socket_h.m4
+++ b/m4/sys_socket_h.m4
@@ -1,4 +1,5 @@
-# sys_socket_h.m4 serial 29
+# sys_socket_h.m4
+# serial 29
dnl Copyright (C) 2005-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,
diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4
index 75018537d57..3cc50ce6776 100644
--- a/m4/sys_stat_h.m4
+++ b/m4/sys_stat_h.m4
@@ -1,4 +1,5 @@
-# sys_stat_h.m4 serial 42 -*- Autoconf -*-
+# sys_stat_h.m4
+# serial 42 -*- Autoconf -*-
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,
diff --git a/m4/sys_time_h.m4 b/m4/sys_time_h.m4
index dc5353f3785..d3203088934 100644
--- a/m4/sys_time_h.m4
+++ b/m4/sys_time_h.m4
@@ -1,10 +1,11 @@
-# Configure a replacement for <sys/time.h>.
+# sys_time_h.m4
# serial 12
+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,
+dnl with or without modifications, as long as this notice is preserved.
-# Copyright (C) 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.
+# Configure a replacement for <sys/time.h>.
# Written by Paul Eggert and Martin Lambers.
diff --git a/m4/sys_types_h.m4 b/m4/sys_types_h.m4
index 37d0ccad403..7c7f2655272 100644
--- a/m4/sys_types_h.m4
+++ b/m4/sys_types_h.m4
@@ -1,4 +1,5 @@
-# sys_types_h.m4 serial 13
+# sys_types_h.m4
+# serial 14
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,
@@ -22,6 +23,9 @@ AC_DEFUN_ONCE([gl_SYS_TYPES_H],
dnl Whether to override the 'off_t' type.
AC_REQUIRE([gl_TYPE_OFF_T])
+ dnl Whether to define the 'off64_t' type.
+ AC_REQUIRE([gl_TYPE_OFF64_T])
+
dnl Whether to override the 'dev_t' and 'ino_t' types.
m4_ifdef([gl_WINDOWS_STAT_INODES], [
AC_REQUIRE([gl_WINDOWS_STAT_INODES])
diff --git a/m4/tempname.m4 b/m4/tempname.m4
index 31d35c83eb5..795a9803fd0 100644
--- a/m4/tempname.m4
+++ b/m4/tempname.m4
@@ -1,9 +1,9 @@
-#serial 5
-
-# Copyright (C) 2006-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.
+# tempname.m4
+# serial 5
+dnl Copyright (C) 2006-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.
# glibc provides __gen_tempname as a wrapper for mk[ds]temp. Expose
# it as a public API, and provide it on systems that are lacking.
diff --git a/m4/time_h.m4 b/m4/time_h.m4
index 32fade0f401..d2f3c9701cb 100644
--- a/m4/time_h.m4
+++ b/m4/time_h.m4
@@ -1,12 +1,11 @@
-# Configure a more-standard replacement for <time.h>.
-
-# Copyright (C) 2000-2001, 2003-2007, 2009-2024 Free Software Foundation, Inc.
-
+# time_h.m4
# serial 25
+dnl Copyright (C) 2000-2001, 2003-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.
-# 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.
+# Configure a more-standard replacement for <time.h>.
# Written by Paul Eggert and Jim Meyering.
diff --git a/m4/time_r.m4 b/m4/time_r.m4
index 4ee2175b690..3675390e871 100644
--- a/m4/time_r.m4
+++ b/m4/time_r.m4
@@ -1,10 +1,12 @@
-dnl Reentrant time functions: localtime_r, gmtime_r.
-
+# time_r.m4
+# serial 1
dnl Copyright (C) 2003, 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,
dnl with or without modifications, as long as this notice is preserved.
+dnl Reentrant time functions: localtime_r, gmtime_r.
+
dnl Written by Paul Eggert.
AC_DEFUN([gl_TIME_R],
diff --git a/m4/time_rz.m4 b/m4/time_rz.m4
index c3b72b7603b..8f45f2b1d3d 100644
--- a/m4/time_rz.m4
+++ b/m4/time_rz.m4
@@ -1,10 +1,12 @@
-dnl Time zone functions: tzalloc, localtime_rz, etc.
-
+# time_rz.m4
+# serial 1
dnl Copyright (C) 2015-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.
+dnl Time zone functions: tzalloc, localtime_rz, etc.
+
dnl Written by Paul Eggert.
AC_DEFUN([gl_TIME_RZ],
diff --git a/m4/timegm.m4 b/m4/timegm.m4
index 84336043e5d..c1ff26777b8 100644
--- a/m4/timegm.m4
+++ b/m4/timegm.m4
@@ -1,4 +1,5 @@
-# timegm.m4 serial 16
+# timegm.m4
+# serial 16
dnl Copyright (C) 2003, 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,
diff --git a/m4/timer_time.m4 b/m4/timer_time.m4
index 10b7654d30f..59a4cade539 100644
--- a/m4/timer_time.m4
+++ b/m4/timer_time.m4
@@ -1,4 +1,5 @@
-# timer_time.m4 serial 6
+# timer_time.m4
+# serial 6
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,
diff --git a/m4/timespec.m4 b/m4/timespec.m4
index 59a0db9966e..5333920ef5e 100644
--- a/m4/timespec.m4
+++ b/m4/timespec.m4
@@ -1,10 +1,9 @@
-#serial 15
-
-# 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,
-# with or without modifications, as long as this notice is preserved.
+# timespec.m4
+# serial 15
+dnl Copyright (C) 2000-2001, 2003-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.
dnl From Jim Meyering
diff --git a/m4/tm_gmtoff.m4 b/m4/tm_gmtoff.m4
index f2e51597fdf..0c7dcb2a09a 100644
--- a/m4/tm_gmtoff.m4
+++ b/m4/tm_gmtoff.m4
@@ -1,4 +1,5 @@
-# tm_gmtoff.m4 serial 3
+# tm_gmtoff.m4
+# serial 3
dnl Copyright (C) 2002, 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,
diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4
index e078bd617a7..81d1b9f6169 100644
--- a/m4/unistd_h.m4
+++ b/m4/unistd_h.m4
@@ -1,4 +1,5 @@
-# unistd_h.m4 serial 95
+# 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,
diff --git a/m4/unlocked-io.m4 b/m4/unlocked-io.m4
index 558f57d809b..e96cf5f8736 100644
--- a/m4/unlocked-io.m4
+++ b/m4/unlocked-io.m4
@@ -1,10 +1,9 @@
-# unlocked-io.m4 serial 16
-
-# Copyright (C) 1998-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,
-# with or without modifications, as long as this notice is preserved.
+# unlocked-io.m4
+# serial 16
+dnl Copyright (C) 1998-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.
dnl From Jim Meyering.
dnl
diff --git a/m4/utimens.m4 b/m4/utimens.m4
index 0f5bfd4c843..9996e3ef336 100644
--- a/m4/utimens.m4
+++ b/m4/utimens.m4
@@ -1,10 +1,10 @@
+# utimens.m4
+# serial 16
dnl Copyright (C) 2003-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.
-dnl serial 16
-
AC_DEFUN([gl_UTIMENS],
[
dnl Prerequisites of lib/utimens.c.
diff --git a/m4/utimensat.m4 b/m4/utimensat.m4
index 4af7f6f81c8..a583f376687 100644
--- a/m4/utimensat.m4
+++ b/m4/utimensat.m4
@@ -1,11 +1,12 @@
+# utimensat.m4
# serial 12
-# See if we need to provide utimensat replacement.
-
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,
dnl with or without modifications, as long as this notice is preserved.
+# See if we need to provide utimensat replacement.
+
# Written by Eric Blake.
AC_DEFUN([gl_FUNC_UTIMENSAT],
diff --git a/m4/vararrays.m4 b/m4/vararrays.m4
index 164bf0c49a9..9211f69d4d8 100644
--- a/m4/vararrays.m4
+++ b/m4/vararrays.m4
@@ -1,13 +1,13 @@
-# Check for variable-length arrays.
-
+# vararrays.m4
# serial 6
+dnl Copyright (C) 2001, 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.
-# From Paul Eggert
+# Check for variable-length arrays.
-# Copyright (C) 2001, 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.
+# From Paul Eggert
m4_version_prereq([2.70], [], [
diff --git a/m4/warnings.m4 b/m4/warnings.m4
index d487636aa36..fe7af01fc50 100644
--- a/m4/warnings.m4
+++ b/m4/warnings.m4
@@ -1,4 +1,5 @@
-# warnings.m4 serial 20
+# 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,
diff --git a/m4/wchar_t.m4 b/m4/wchar_t.m4
index 94353571b00..968832cb296 100644
--- a/m4/wchar_t.m4
+++ b/m4/wchar_t.m4
@@ -1,4 +1,5 @@
-# wchar_t.m4 serial 4 (gettext-0.18.2)
+# wchar_t.m4
+# serial 4 (gettext-0.18.2)
dnl Copyright (C) 2002-2003, 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,
diff --git a/m4/xattr.m4 b/m4/xattr.m4
index 7f72a81eeab..d8c08486834 100644
--- a/m4/xattr.m4
+++ b/m4/xattr.m4
@@ -1,10 +1,11 @@
-# xattr.m4 - check for Extended Attributes (Linux)
+# xattr.m4
# serial 7
+dnl Copyright (C) 2003-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.
-# Copyright (C) 2003-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.
+# Check for Extended Attributes (Linux)
AC_DEFUN([gl_FUNC_XATTR],
[
diff --git a/m4/zzgnulib.m4 b/m4/zzgnulib.m4
index eed5ecbfe1e..710fba4e297 100644
--- a/m4/zzgnulib.m4
+++ b/m4/zzgnulib.m4
@@ -1,4 +1,5 @@
-# zzgnulib.m4 serial 1
+# zzgnulib.m4
+# serial 1
dnl Copyright (C) 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,
diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp
index 1d8ae778168..d0b2da08656 100644
--- a/msdos/sedlibmk.inp
+++ b/msdos/sedlibmk.inp
@@ -198,6 +198,9 @@ s/@PACKAGE@/emacs/
# we get warnings building canonicalize-lgpl.o
/^GL_GNULIB_RAWMEMCHR *=/s/@GL_GNULIB_RAWMEMCHR@/1/
/^GL_GNULIB_[^ =]* *= *@/s/@[^@\n]*@/0/
+# These variables control whether ISO C23 features are generated,
+# e.g. those in stdbit.h.
+/^GL_STDC_[^ =]* *= *@/s/@[^@\n]*@/1/
/^GL_GSETTINGS_CFLAGS *=/s/@[^@\n]*@//
/^GL_GSETTINGS_LIBS *=/s/@[^@\n]*@//
# Miscellaneous variables.
@@ -251,6 +254,7 @@ s/@PACKAGE@/emacs/
/^HAVE_STRPBRK *=/s/@HAVE_STRPBRK@/1/
/^HAVE_STRSEP *=/s/@HAVE_STRSEP@/1/
/^HAVE_STRTOD *=/s/@HAVE_STRTOD@/1/
+/^HAVE_STRTOF *=/s/@HAVE_STRTOF@/1/
/^HAVE_STRTOLL *=/s/@HAVE_STRTOLL@/1/
/^HAVE_STRTOULL *=/s/@HAVE_STRTOULL@/1/
/^HAVE_STRUCT_TIMEVAL *=/s/@HAVE_STRUCT_TIMEVAL@/1/
@@ -321,6 +325,7 @@ s/@PACKAGE@/emacs/
/^NEXT_TIME_H *=/s/@[^@\n]*@/<time.h>/
/^NEXT_INTTYPES_H *=/s/@[^@\n]*@//
/^NEXT_UNISTD_H *=/s/@[^@\n]*@/<unistd.h>/
+/^NULLPTR_T_NEEDS_STDDEF *=/s/@[^@\n]*@/1/
/^OBJEXT *=/s/@[^@\n]*@/o/
/^PRAGMA_COLUMNS *=/s/@[^@\n]*@//
/^PRAGMA_SYSTEM_HEADER *=/s/@[^@\n]*@/\\\#pragma GCC system_header/
@@ -345,8 +350,10 @@ s/@PACKAGE@/emacs/
/^LIMITS_H *=/s/@[^@\n]*@/limits.h/
/^IEEE754_H *=/s/@[^@\n]*@/ieee754.h/
/^STDALIGN_H *=/s/@[^@\n]*@/stdalign.h/
+/^STDBIT_H *=/s/@[^@\n]*@/stdbit.h/
/^STDCKDINT_H *=/s/@[^@\n]*@/stdckdint.h/
/^STDDEF_H *=/s/@[^@\n]*@/stddef.h/
+/^STDDEF_NOT_IDEMPOTENT *=/s/@[^@\n]*@/1/
/^STDINT_H *=/s/@[^@\n]*@/stdint.h/
/^SYS_TIME_H_DEFINES_STRUCT_TIMESPEC *=/s/@[^@\n]*@/0/
/^TIME_H_DEFINES_STRUCT_TIMESPEC *=/s/@[^@\n]*@/0/
@@ -442,6 +449,7 @@ s/= @GL_GENERATE_GMP_H_CONDITION@/= 1/
s/= @GL_GENERATE_GMP_GMP_H_CONDITION@/= /
s/= @GL_GENERATE_MINI_GMP_H_CONDITION@/= 1/
s/= @GL_GENERATE_STDCKDINT_H_CONDITION@/= 1/
+s/= @GL_GENERATE_STDBIT_H_CONDITION@/= 1/
s/= @GL_COND_OBJ_STDIO_READ_CONDITION@/= /
s/= @GL_COND_OBJ_STDIO_WRITE_CONDITION@/= /
s/= @GL_COND_OBJ_STPNCPY_CONDITION@/= /
diff --git a/oldXMenu/Activate.c b/oldXMenu/Activate.c
index ffc5d5ecef1..d876ed234f7 100644
--- a/oldXMenu/Activate.c
+++ b/oldXMenu/Activate.c
@@ -117,7 +117,7 @@ along with this program. If not, see
<https://www.gnu.org/licenses/>. */
#include <X11/keysym.h>
/* For debug, set this to 0 to not grab the keyboard on menu popup */
-int x_menu_grab_keyboard = 1;
+static int x_menu_grab_keyboard = 1;
static Wait_func wait_func;
static void* wait_data;
diff --git a/src/.gdbinit b/src/.gdbinit
index 6c4dda67f06..7645d466a5e 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -822,15 +822,22 @@ Print $ as a frame pointer.
This command assumes $ is an Emacs Lisp frame value.
end
-define xcompiled
+define xclosure
xgetptr $
print (struct Lisp_Vector *) $ptr
output ($->contents[0])@($->header.size & 0xff)
echo \n
end
+document xclosure
+Print $ as a function pointer.
+This command assumes that $ is an Emacs Lisp byte-code or interpreted function
value.
+end
+
+define xcompiled
+ xclosure
+end
document xcompiled
-Print $ as a compiled function pointer.
-This command assumes that $ is an Emacs Lisp compiled value.
+Obsolete alias for "xclosure".
end
define xwindow
@@ -1038,8 +1045,8 @@ define xpr
if $vec == PVEC_FRAME
xframe
end
- if $vec == PVEC_COMPILED
- xcompiled
+ if $vec == PVEC_CLOSURE
+ xclosure
end
if $vec == PVEC_WINDOW
xwindow
diff --git a/src/Makefile.in b/src/Makefile.in
index 91d666be7eb..7bb4c42e52e 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -34,6 +34,11 @@ top_builddir = @top_builddir@
abs_top_srcdir=@abs_top_srcdir@
VPATH = $(srcdir)
+# Set these to 'not-set' when they are not set from top-level to please
+# 'load--fixup-all-elns' (bug#70842).
+ELN_DESTDIR=not-set
+BIN_DESTDIR=not-set
+
# This is not empty if this is a Makefile that will be copied to
# cross/src.
XCONFIGURE = @XCONFIGURE@
@@ -419,7 +424,8 @@ pdmp :=
endif
# Flags that might be in WARN_CFLAGS but are not valid for Objective C.
-NON_OBJC_CFLAGS = -Wignored-attributes -Wignored-qualifiers -Wopenmp-simd
-Wnested-externs
+NON_OBJC_CFLAGS = -Wignored-attributes -Wignored-qualifiers -Wopenmp-simd \
+ -Wnested-externs -Wstrict-flex-arrays
# Ditto, but for C++.
NON_CXX_CFLAGS = -Wmissing-prototypes -Wnested-externs -Wold-style-definition \
-Wstrict-prototypes -Wno-override-init
diff --git a/src/alloc.c b/src/alloc.c
index a693186f487..8054deca197 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -682,10 +682,10 @@ malloc_warning (const char *str)
void
display_malloc_warning (void)
{
- call3 (intern ("display-warning"),
- intern ("alloc"),
+ call3 (Qdisplay_warning,
+ Qalloc,
build_string (pending_malloc_warning),
- intern (":emergency"));
+ QCemergency);
pending_malloc_warning = 0;
}
@@ -3556,7 +3556,7 @@ cleanup_vector (struct Lisp_Vector *vector)
case PVEC_XWIDGET_VIEW:
case PVEC_TS_NODE:
case PVEC_SQLITE:
- case PVEC_COMPILED:
+ case PVEC_CLOSURE:
case PVEC_CHAR_TABLE:
case PVEC_SUB_CHAR_TABLE:
case PVEC_RECORD:
@@ -3909,18 +3909,18 @@ stack before executing the byte-code.
usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING
INTERACTIVE-SPEC &rest ELEMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- if (! ((FIXNUMP (args[COMPILED_ARGLIST])
- || CONSP (args[COMPILED_ARGLIST])
- || NILP (args[COMPILED_ARGLIST]))
- && STRINGP (args[COMPILED_BYTECODE])
- && !STRING_MULTIBYTE (args[COMPILED_BYTECODE])
- && VECTORP (args[COMPILED_CONSTANTS])
- && FIXNATP (args[COMPILED_STACK_DEPTH])))
+ if (! ((FIXNUMP (args[CLOSURE_ARGLIST])
+ || CONSP (args[CLOSURE_ARGLIST])
+ || NILP (args[CLOSURE_ARGLIST]))
+ && STRINGP (args[CLOSURE_CODE])
+ && !STRING_MULTIBYTE (args[CLOSURE_CODE])
+ && VECTORP (args[CLOSURE_CONSTANTS])
+ && FIXNATP (args[CLOSURE_STACK_DEPTH])))
error ("Invalid byte-code object");
#ifndef HAVE_MPS
/* Bytecode must be immovable. */
- pin_string (args[COMPILED_BYTECODE]);
+ pin_string (args[CLOSURE_CODE]);
#endif
/* We used to purecopy everything here, if purify-flag was set. This worked
@@ -3931,7 +3931,7 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH
&optional DOCSTRING INT
just wasteful and other times plainly wrong (e.g. those free vars may want
to be setcar'd). */
Lisp_Object val = Fvector (nargs, args);
- XSETPVECTYPE (XVECTOR (val), PVEC_COMPILED);
+ XSETPVECTYPE (XVECTOR (val), PVEC_CLOSURE);
return val;
}
@@ -3943,12 +3943,12 @@ usage: (make-closure PROTOTYPE &rest CLOSURE-VARS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object protofun = args[0];
- CHECK_TYPE (COMPILEDP (protofun), Qbyte_code_function_p, protofun);
+ CHECK_TYPE (CLOSUREP (protofun), Qbyte_code_function_p, protofun);
/* Create a copy of the constant vector, filling it with the closure
variables in the beginning. (The overwritten part should just
contain placeholder values.) */
- Lisp_Object proto_constvec = AREF (protofun, COMPILED_CONSTANTS);
+ Lisp_Object proto_constvec = AREF (protofun, CLOSURE_CONSTANTS);
ptrdiff_t constsize = ASIZE (proto_constvec);
ptrdiff_t nvars = nargs - 1;
if (nvars > constsize)
@@ -3968,7 +3968,7 @@ usage: (make-closure PROTOTYPE &rest CLOSURE-VARS) */)
#endif
v->header = XVECTOR (protofun)->header;
memcpy (v->contents, XVECTOR (protofun)->contents, protosize * word_size);
- v->contents[COMPILED_CONSTANTS] = constvec;
+ v->contents[CLOSURE_CONSTANTS] = constvec;
return make_lisp_ptr (v, Lisp_Vectorlike);
}
@@ -6215,7 +6215,7 @@ purecopy (Lisp_Object obj)
obj = make_lisp_hash_table (purecopy_hash_table (table));
}
- else if (COMPILEDP (obj) || VECTORP (obj) || RECORDP (obj))
+ else if (CLOSUREP (obj) || VECTORP (obj) || RECORDP (obj))
{
struct Lisp_Vector *objp = XVECTOR (obj);
ptrdiff_t nbytes = vector_nbytes (objp);
@@ -6229,7 +6229,7 @@ purecopy (Lisp_Object obj)
vec->contents[i] = purecopy (vec->contents[i]);
#ifndef HAVE_MPS
/* Byte code strings must be pinned. */
- if (COMPILEDP (obj) && size >= 2 && STRINGP (vec->contents[1])
+ if (CLOSUREP (obj) && size >= 2 && STRINGP (vec->contents[1])
&& !STRING_MULTIBYTE (vec->contents[1]))
pin_string (vec->contents[1]);
#endif
@@ -7280,6 +7280,7 @@ mark_frame (struct Lisp_Vector *ptr)
mark_object (f->conversion.compose_region_start);
mark_object (f->conversion.compose_region_end);
mark_object (f->conversion.compose_region_overlay);
+ mark_object (f->conversion.field);
for (tem = f->conversion.actions; tem; tem = tem->next)
mark_object (tem->data);
@@ -8254,11 +8255,11 @@ symbol_uses_obj (Lisp_Object symbol, Lisp_Object obj)
return (EQ (val, obj)
|| EQ (sym->u.s.function, obj)
|| (!NILP (sym->u.s.function)
- && COMPILEDP (sym->u.s.function)
- && EQ (AREF (sym->u.s.function, COMPILED_BYTECODE), obj))
+ && CLOSUREP (sym->u.s.function)
+ && EQ (AREF (sym->u.s.function, CLOSURE_CODE), obj))
|| (!NILP (val)
- && COMPILEDP (val)
- && EQ (AREF (val, COMPILED_BYTECODE), obj)));
+ && CLOSUREP (val)
+ && EQ (AREF (val, CLOSURE_CODE), obj)));
}
#endif
@@ -8564,6 +8565,8 @@ N should be nonnegative. */);
XSETSUBR (watcher, &Swatch_gc_cons_percentage.s);
Fadd_variable_watcher (Qgc_cons_percentage, watcher);
#endif
+ DEFSYM (Qalloc, "alloc");
+ DEFSYM (QCemergency, ":emergency");
}
#ifdef HAVE_MPS
@@ -8587,7 +8590,7 @@ enum defined_HAVE_PGTK { defined_HAVE_PGTK = false };
then xbacktrace could fail. Similarly for the other enums and
their values. Some non-GCC compilers don't like these constructs. */
#ifdef __GNUC__
-union
+extern union enums_for_gdb
{
enum CHARTAB_SIZE_BITS CHARTAB_SIZE_BITS;
enum char_table_specials char_table_specials;
@@ -8595,12 +8598,13 @@ union
enum CHECK_LISP_OBJECT_TYPE CHECK_LISP_OBJECT_TYPE;
enum DEFAULT_HASH_SIZE DEFAULT_HASH_SIZE;
enum Lisp_Bits Lisp_Bits;
- enum Lisp_Compiled Lisp_Compiled;
+ enum Lisp_Closure Lisp_Closure;
enum maxargs maxargs;
enum MAX_ALLOCA MAX_ALLOCA;
enum More_Lisp_Bits More_Lisp_Bits;
enum pvec_type pvec_type;
enum defined_HAVE_X_WINDOWS defined_HAVE_X_WINDOWS;
enum defined_HAVE_PGTK defined_HAVE_PGTK;
-} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};
+} const gdb_make_enums_visible;
+union enums_for_gdb const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};
#endif /* __GNUC__ */
diff --git a/src/android.c b/src/android.c
index 507ffc458d8..17b5d6d4115 100644
--- a/src/android.c
+++ b/src/android.c
@@ -115,6 +115,7 @@ struct android_emacs_window
jmethodID recreate_activity;
jmethodID clear_window;
jmethodID clear_area;
+ jmethodID set_wm_name;
};
struct android_emacs_cursor
@@ -129,6 +130,13 @@ struct android_key_character_map
jmethodID get_dead_char;
};
+struct android_emacs_handle
+{
+ jclass class;
+ jmethodID destroy_handle;
+ jfieldID handle;
+};
+
/* The API level of the current device. */
static int android_api_level;
@@ -146,7 +154,7 @@ char *android_cache_dir;
/* The list of archive files within which the Java virtual macine
looks for class files. */
-char *android_class_path;
+static char *android_class_path;
/* The display's pixel densities. */
double android_pixel_density_x, android_pixel_density_y;
@@ -177,7 +185,9 @@ static jfieldID emacs_gc_function, emacs_gc_clip_rects;
static jfieldID emacs_gc_clip_x_origin, emacs_gc_clip_y_origin;
static jfieldID emacs_gc_stipple, emacs_gc_clip_mask;
static jfieldID emacs_gc_fill_style, emacs_gc_ts_origin_x;
-static jfieldID emacs_gc_ts_origin_y;
+static jfieldID emacs_gc_ts_origin_y, emacs_gc_line_style;
+static jfieldID emacs_gc_line_width, emacs_gc_dash_offset;
+static jfieldID emacs_gc_dashes;
/* The constructor and one function. */
static jmethodID emacs_gc_constructor, emacs_gc_mark_dirty;
@@ -212,6 +222,10 @@ static struct android_emacs_cursor cursor_class;
/* Various methods associated with the KeyCharacterMap class. */
static struct android_key_character_map key_character_map_class;
+/* Various methods and fields associated with the EmacsHandleObject
+ class. */
+static struct android_emacs_handle handle_class;
+
/* The time at which Emacs was installed, which also supplies the
mtime of asset files. */
struct timespec emacs_installation_time;
@@ -1294,22 +1308,6 @@ android_create_lib_link (void)
#pragma GCC diagnostic ignored "-Wmissing-prototypes"
#endif
-JNIEXPORT jint JNICALL
-NATIVE_NAME (dup) (JNIEnv *env, jobject object, jint fd)
-{
- JNI_STACK_ALIGNMENT_PROLOGUE;
-
- return dup (fd);
-}
-
-JNIEXPORT jint JNICALL
-NATIVE_NAME (close) (JNIEnv *env, jobject object, jint fd)
-{
- JNI_STACK_ALIGNMENT_PROLOGUE;
-
- return close (fd);
-}
-
JNIEXPORT jstring JNICALL
NATIVE_NAME (getFingerprint) (JNIEnv *env, jobject object)
{
@@ -1618,7 +1616,7 @@ android_init_emacs_service (void)
"Lorg/gnu/emacs/EmacsGC;II)V");
FIND_METHOD (ring_bell, "ringBell", "(I)V");
FIND_METHOD (query_tree, "queryTree",
- "(Lorg/gnu/emacs/EmacsWindow;)[S");
+ "(Lorg/gnu/emacs/EmacsWindow;)[J");
FIND_METHOD (get_screen_width, "getScreenWidth", "(Z)I");
FIND_METHOD (get_screen_height, "getScreenHeight", "(Z)I");
FIND_METHOD (detect_mouse, "detectMouse", "()Z");
@@ -1632,7 +1630,7 @@ android_init_emacs_service (void)
FIND_METHOD (reset_ic, "resetIC",
"(Lorg/gnu/emacs/EmacsWindow;I)V");
FIND_METHOD (open_content_uri, "openContentUri",
- "([BZZZ)I");
+ "(Ljava/lang/String;ZZZ)I");
FIND_METHOD (check_content_uri, "checkContentUri",
"(Ljava/lang/String;ZZ)Z");
FIND_METHOD (query_battery, "queryBattery", "()[J");
@@ -1646,7 +1644,7 @@ android_init_emacs_service (void)
FIND_METHOD (request_directory_access, "requestDirectoryAccess",
"()I");
FIND_METHOD (get_document_trees, "getDocumentTrees",
- "([B)[Ljava/lang/String;");
+ "(Ljava/lang/String;)[Ljava/lang/String;");
FIND_METHOD (document_id_from_name, "documentIdFromName",
"(Ljava/lang/String;Ljava/lang/String;"
"[Ljava/lang/String;)I");
@@ -1721,7 +1719,7 @@ android_init_emacs_pixmap (void)
name, signature); \
eassert (pixmap_class.c_name);
- FIND_METHOD (constructor_mutable, "<init>", "(SIII)V");
+ FIND_METHOD (constructor_mutable, "<init>", "(III)V");
#undef FIND_METHOD
}
@@ -1845,6 +1843,7 @@ android_init_emacs_window (void)
FIND_METHOD (recreate_activity, "recreateActivity", "()V");
FIND_METHOD (clear_window, "clearWindow", "()V");
FIND_METHOD (clear_area, "clearArea", "(IIII)V");
+ FIND_METHOD (set_wm_name, "setWmName", "(Ljava/lang/String;)V");
#undef FIND_METHOD
}
@@ -1874,7 +1873,7 @@ android_init_emacs_cursor (void)
name, signature); \
eassert (cursor_class.c_name);
- FIND_METHOD (constructor, "<init>", "(SI)V");
+ FIND_METHOD (constructor, "<init>", "(I)V");
#undef FIND_METHOD
}
@@ -1904,6 +1903,42 @@ android_init_key_character_map (void)
eassert (key_character_map_class.get_dead_char);
}
+static void
+android_init_emacs_handle (void)
+{
+ jclass old;
+
+ handle_class.class
+ = (*android_java_env)->FindClass (android_java_env,
+ "org/gnu/emacs/EmacsHandleObject");
+ eassert (handle_class.class);
+
+ old = handle_class.class;
+ handle_class.class
+ = (jclass) (*android_java_env)->NewGlobalRef (android_java_env,
+ (jobject) old);
+ ANDROID_DELETE_LOCAL_REF (old);
+
+ if (!handle_class.class)
+ emacs_abort ();
+
+#define FIND_METHOD(c_name, name, signature) \
+ handle_class.c_name \
+ = (*android_java_env)->GetMethodID (android_java_env, \
+ handle_class.class, \
+ name, signature); \
+ eassert (handle_class.c_name);
+
+ FIND_METHOD (destroy_handle, "destroyHandle", "()V");
+#undef FIND_METHOD
+
+ handle_class.handle
+ = (*android_java_env)->GetFieldID (android_java_env,
+ handle_class.class,
+ "handle", "J");
+ eassert (handle_class.handle);
+}
+
JNIEXPORT void JNICALL
NATIVE_NAME (initEmacs) (JNIEnv *env, jobject object, jarray argv,
jobject dump_file_object)
@@ -1953,6 +1988,7 @@ NATIVE_NAME (initEmacs) (JNIEnv *env, jobject object,
jarray argv,
android_init_emacs_window ();
android_init_emacs_cursor ();
android_init_key_character_map ();
+ android_init_emacs_handle ();
/* Set HOME to the app data directory. */
setenv ("HOME", android_files_dir, 1);
@@ -2072,7 +2108,7 @@ NATIVE_NAME (onLowMemory) (JNIEnv *env, jobject object)
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendConfigureNotify) (JNIEnv *env, jobject object,
- jshort window, jlong time,
+ jlong window, jlong time,
jint x, jint y, jint width,
jint height)
{
@@ -2095,7 +2131,7 @@ NATIVE_NAME (sendConfigureNotify) (JNIEnv *env, jobject
object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendKeyPress) (JNIEnv *env, jobject object,
- jshort window, jlong time,
+ jlong window, jlong time,
jint state, jint keycode,
jint unicode_char)
{
@@ -2118,7 +2154,7 @@ NATIVE_NAME (sendKeyPress) (JNIEnv *env, jobject object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendKeyRelease) (JNIEnv *env, jobject object,
- jshort window, jlong time,
+ jlong window, jlong time,
jint state, jint keycode,
jint unicode_char)
{
@@ -2141,7 +2177,7 @@ NATIVE_NAME (sendKeyRelease) (JNIEnv *env, jobject object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendFocusIn) (JNIEnv *env, jobject object,
- jshort window, jlong time)
+ jlong window, jlong time)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -2158,7 +2194,7 @@ NATIVE_NAME (sendFocusIn) (JNIEnv *env, jobject object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendFocusOut) (JNIEnv *env, jobject object,
- jshort window, jlong time)
+ jlong window, jlong time)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -2175,7 +2211,7 @@ NATIVE_NAME (sendFocusOut) (JNIEnv *env, jobject object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendWindowAction) (JNIEnv *env, jobject object,
- jshort window, jint action)
+ jlong window, jint action)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -2192,7 +2228,7 @@ NATIVE_NAME (sendWindowAction) (JNIEnv *env, jobject
object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendEnterNotify) (JNIEnv *env, jobject object,
- jshort window, jint x, jint y,
+ jlong window, jint x, jint y,
jlong time)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -2212,7 +2248,7 @@ NATIVE_NAME (sendEnterNotify) (JNIEnv *env, jobject
object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendLeaveNotify) (JNIEnv *env, jobject object,
- jshort window, jint x, jint y,
+ jlong window, jint x, jint y,
jlong time)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -2232,7 +2268,7 @@ NATIVE_NAME (sendLeaveNotify) (JNIEnv *env, jobject
object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendMotionNotify) (JNIEnv *env, jobject object,
- jshort window, jint x, jint y,
+ jlong window, jint x, jint y,
jlong time)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -2252,7 +2288,7 @@ NATIVE_NAME (sendMotionNotify) (JNIEnv *env, jobject
object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendButtonPress) (JNIEnv *env, jobject object,
- jshort window, jint x, jint y,
+ jlong window, jint x, jint y,
jlong time, jint state,
jint button)
{
@@ -2275,7 +2311,7 @@ NATIVE_NAME (sendButtonPress) (JNIEnv *env, jobject
object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendButtonRelease) (JNIEnv *env, jobject object,
- jshort window, jint x, jint y,
+ jlong window, jint x, jint y,
jlong time, jint state,
jint button)
{
@@ -2298,7 +2334,7 @@ NATIVE_NAME (sendButtonRelease) (JNIEnv *env, jobject
object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendTouchDown) (JNIEnv *env, jobject object,
- jshort window, jint x, jint y,
+ jlong window, jint x, jint y,
jlong time, jint pointer_id,
jint flags)
{
@@ -2321,7 +2357,7 @@ NATIVE_NAME (sendTouchDown) (JNIEnv *env, jobject object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendTouchUp) (JNIEnv *env, jobject object,
- jshort window, jint x, jint y,
+ jlong window, jint x, jint y,
jlong time, jint pointer_id,
jint flags)
{
@@ -2344,7 +2380,7 @@ NATIVE_NAME (sendTouchUp) (JNIEnv *env, jobject object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendTouchMove) (JNIEnv *env, jobject object,
- jshort window, jint x, jint y,
+ jlong window, jint x, jint y,
jlong time, jint pointer_id,
jint flags)
{
@@ -2367,7 +2403,7 @@ NATIVE_NAME (sendTouchMove) (JNIEnv *env, jobject object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendWheel) (JNIEnv *env, jobject object,
- jshort window, jint x, jint y,
+ jlong window, jint x, jint y,
jlong time, jint state,
jfloat x_delta, jfloat y_delta)
{
@@ -2391,7 +2427,7 @@ NATIVE_NAME (sendWheel) (JNIEnv *env, jobject object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendIconified) (JNIEnv *env, jobject object,
- jshort window)
+ jlong window)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -2407,7 +2443,7 @@ NATIVE_NAME (sendIconified) (JNIEnv *env, jobject object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendDeiconified) (JNIEnv *env, jobject object,
- jshort window)
+ jlong window)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -2423,7 +2459,7 @@ NATIVE_NAME (sendDeiconified) (JNIEnv *env, jobject
object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendContextMenu) (JNIEnv *env, jobject object,
- jshort window, jint menu_event_id,
+ jlong window, jint menu_event_id,
jint menu_event_serial)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -2442,7 +2478,7 @@ NATIVE_NAME (sendContextMenu) (JNIEnv *env, jobject
object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendExpose) (JNIEnv *env, jobject object,
- jshort window, jint x, jint y,
+ jlong window, jint x, jint y,
jint width, jint height)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -2463,7 +2499,7 @@ NATIVE_NAME (sendExpose) (JNIEnv *env, jobject object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendDndDrag) (JNIEnv *env, jobject object,
- jshort window, jint x, jint y)
+ jlong window, jint x, jint y)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -2483,7 +2519,7 @@ NATIVE_NAME (sendDndDrag) (JNIEnv *env, jobject object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendDndUri) (JNIEnv *env, jobject object,
- jshort window, jint x, jint y,
+ jlong window, jint x, jint y,
jstring string)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -2520,7 +2556,7 @@ NATIVE_NAME (sendDndUri) (JNIEnv *env, jobject object,
JNIEXPORT jlong JNICALL
NATIVE_NAME (sendDndText) (JNIEnv *env, jobject object,
- jshort window, jint x, jint y,
+ jlong window, jint x, jint y,
jstring string)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -2645,6 +2681,13 @@ NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv
*env,
return !android_pass_multimedia_buttons_to_system;
}
+JNIEXPORT jint JNICALL
+NATIVE_NAME (getQuitKeycode) (JNIEnv *env, jobject object)
+{
+ /* Likewise. */
+ return (jint) android_quit_keycode;
+}
+
JNIEXPORT jboolean JNICALL
NATIVE_NAME (shouldForwardCtrlSpace) (JNIEnv *env, jobject object)
{
@@ -2702,7 +2745,6 @@ NATIVE_NAME (blitRect) (JNIEnv *env, jobject object,
x2 = MAX (x2, 0);
y2 = MAX (y2, 0);
-
if (x1 >= src_info.width
|| x1 >= dest_info.width)
x1 = MIN (dest_info.width - 1, src_info.width - 1);
@@ -2845,62 +2887,6 @@ NATIVE_NAME (setupSystemThread) (void)
This means that every local reference must be explicitly destroyed
with DeleteLocalRef. A helper macro is provided to do this. */
-struct android_handle_entry
-{
- /* The type. */
- enum android_handle_type type;
-
- /* The handle. */
- jobject handle;
-};
-
-/* Table of handles MAX_HANDLE long. */
-struct android_handle_entry android_handles[USHRT_MAX];
-
-/* The largest handle ID currently known, but subject to
- wraparound. */
-static android_handle max_handle;
-
-/* Allocate a new, unused, handle identifier. If Emacs is out of
- identifiers, return 0. */
-
-static android_handle
-android_alloc_id (void)
-{
- android_handle handle;
-
- /* 0 is never a valid handle ID. */
-
- if (!max_handle)
- max_handle++;
-
- /* See if the handle is already occupied. */
-
- if (android_handles[max_handle].handle)
- {
- /* Look for a fresh unoccupied handle. */
-
- handle = max_handle;
- max_handle++;
-
- while (handle != max_handle)
- {
- ++max_handle;
-
- /* Make sure the handle is valid. */
- if (!max_handle)
- ++max_handle;
-
- if (!android_handles[max_handle].handle)
- return max_handle++;
- }
-
- return ANDROID_NONE;
- }
-
- return max_handle++;
-}
-
/* Destroy the specified handle and mark it as free on the Java side
as well. */
@@ -2910,13 +2896,6 @@ android_destroy_handle (android_handle handle)
static jclass old, class;
static jmethodID method;
- if (!android_handles[handle].handle)
- {
- __android_log_print (ANDROID_LOG_ERROR, __func__,
- "Trying to destroy free handle!");
- emacs_abort ();
- }
-
if (!class)
{
class
@@ -2937,8 +2916,7 @@ android_destroy_handle (android_handle handle)
ANDROID_DELETE_LOCAL_REF (old);
}
- (*android_java_env)->CallVoidMethod (android_java_env,
- android_handles[handle].handle,
+ (*android_java_env)->CallVoidMethod (android_java_env, (jobject) handle,
method);
/* Just clear any exception thrown. If destroying the handle
@@ -2947,76 +2925,7 @@ android_destroy_handle (android_handle handle)
(*android_java_env)->ExceptionClear (android_java_env);
/* Delete the global reference regardless of any error. */
- (*android_java_env)->DeleteGlobalRef (android_java_env,
- android_handles[handle].handle);
- android_handles[handle].handle = NULL;
-}
-
-jobject
-android_resolve_handle (android_handle handle,
- enum android_handle_type type)
-{
- if (!handle)
- /* ANDROID_NONE. */
- return NULL;
-
- /* CheckJNI will normally ensure that the handle exists and is
- the right type, but with a less informative error message.
- Don't waste cycles doing our own checking here. */
-
-#ifdef ENABLE_CHECKING
-
- if (!android_handles[handle].handle)
- {
- __android_log_print (ANDROID_LOG_ERROR, __func__,
- "Trying to resolve free handle!");
- emacs_abort ();
- }
-
- if (android_handles[handle].type != type)
- {
- __android_log_print (ANDROID_LOG_ERROR, __func__,
- "Handle has wrong type!");
- emacs_abort ();
- }
-
-#endif /* ENABLE_CHECKING */
-
- return android_handles[handle].handle;
-}
-
-static jobject
-android_resolve_handle2 (android_handle handle,
- enum android_handle_type type,
- enum android_handle_type type2)
-{
- if (!handle)
- return NULL;
-
- /* CheckJNI will normally ensure that the handle exists and is
- the right type, but with a less informative error message.
- Don't waste cycles doing our own checking here. */
-
-#ifdef ENABLE_CHECKING
-
- if (!android_handles[handle].handle)
- {
- __android_log_print (ANDROID_LOG_ERROR, __func__,
- "Trying to resolve free handle!");
- emacs_abort ();
- }
-
- if (android_handles[handle].type != type
- && android_handles[handle].type != type2)
- {
- __android_log_print (ANDROID_LOG_ERROR, __func__,
- "Handle has wrong type!");
- emacs_abort ();
- }
-
-#endif /* ENABLE_CHECKING */
-
- return android_handles[handle].handle;
+ (*android_java_env)->DeleteGlobalRef (android_java_env, (jobject) handle);
}
void
@@ -3028,7 +2937,7 @@ android_change_window_attributes (android_window handle,
jobject window;
jint pixel;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
if (value_mask & ANDROID_CW_BACK_PIXEL)
{
@@ -3042,6 +2951,35 @@ android_change_window_attributes (android_window handle,
}
}
+/* Return a reference to the local reference HANDLE suitable for
+ indefinite retention and save its value into HANDLE, deleting HANDLE,
+ or signal an error if such a reference cannot be allocated. */
+
+static android_handle
+android_globalize_reference (jobject handle)
+{
+ jobject global;
+
+ /* Though Android 8.0 and later can support an unlimited number of
+ active local references, they remain inappropriate in threading
+ configurations for being local to the current thread. */
+
+ global = (*android_java_env)->NewGlobalRef (android_java_env,
+ handle);
+ (*android_java_env)->ExceptionClear (android_java_env);
+ ANDROID_DELETE_LOCAL_REF (handle);
+
+ if (__builtin_expect (global == NULL, 0))
+ error ("JNI global reference reserves exhausted");
+
+ /* Save the value of this handle into HANDLE. */
+ (*android_java_env)->SetLongField (android_java_env, global,
+ handle_class.handle,
+ (jlong) global);
+ verify (sizeof (jlong) >= sizeof (intptr_t));
+ return (intptr_t) global;
+}
+
/* Create a new window with the given width, height and
attributes. */
@@ -3055,16 +2993,10 @@ android_create_window (android_window parent, int x,
int y,
static jmethodID constructor;
jobject object, parent_object, old;
android_window window;
- android_handle prev_max_handle;
bool override_redirect;
- parent_object = android_resolve_handle (parent, ANDROID_HANDLE_WINDOW);
-
- prev_max_handle = max_handle;
- window = android_alloc_id ();
+ parent_object = android_resolve_handle (parent);
- if (!window)
- error ("Out of window handles!");
if (!class)
{
@@ -3074,7 +3006,7 @@ android_create_window (android_window parent, int x, int
y,
constructor
= (*android_java_env)->GetMethodID (android_java_env, class, "<init>",
- "(SLorg/gnu/emacs/EmacsWindow;"
+ "(Lorg/gnu/emacs/EmacsWindow;"
"IIIIZ)V");
eassert (constructor != NULL);
@@ -3091,28 +3023,12 @@ android_create_window (android_window parent, int x,
int y,
&& attrs->override_redirect);
object = (*android_java_env)->NewObject (android_java_env, class,
- constructor, (jshort) window,
- parent_object, (jint) x, (jint) y,
+ constructor, parent_object,
+ (jint) x, (jint) y,
(jint) width, (jint) height,
(jboolean) override_redirect);
- if (!object)
- {
- (*android_java_env)->ExceptionClear (android_java_env);
-
- max_handle = prev_max_handle;
- memory_full (0);
- }
-
- android_handles[window].type = ANDROID_HANDLE_WINDOW;
- android_handles[window].handle
- = (*android_java_env)->NewGlobalRef (android_java_env,
- object);
- (*android_java_env)->ExceptionClear (android_java_env);
- ANDROID_DELETE_LOCAL_REF (object);
-
- if (!android_handles[window].handle)
- memory_full (0);
-
+ android_exception_check ();
+ window = android_globalize_reference (object);
android_change_window_attributes (window, value_mask, attrs);
return window;
}
@@ -3130,13 +3046,6 @@ android_set_window_background (android_window window,
unsigned long pixel)
void
android_destroy_window (android_window window)
{
- if (android_handles[window].type != ANDROID_HANDLE_WINDOW)
- {
- __android_log_print (ANDROID_LOG_ERROR, __func__,
- "Trying to destroy something not a window!");
- emacs_abort ();
- }
-
android_destroy_handle (window);
}
@@ -3184,7 +3093,7 @@ android_init_emacs_gc_class (void)
emacs_gc_constructor
= (*android_java_env)->GetMethodID (android_java_env,
emacs_gc_class,
- "<init>", "(S)V");
+ "<init>", "()V");
eassert (emacs_gc_constructor);
emacs_gc_mark_dirty
@@ -3247,6 +3156,22 @@ android_init_emacs_gc_class (void)
= (*android_java_env)->GetFieldID (android_java_env,
emacs_gc_class,
"ts_origin_y", "I");
+ emacs_gc_line_style
+ = (*android_java_env)->GetFieldID (android_java_env,
+ emacs_gc_class,
+ "line_style", "I");
+ emacs_gc_line_width
+ = (*android_java_env)->GetFieldID (android_java_env,
+ emacs_gc_class,
+ "line_width", "I");
+ emacs_gc_dash_offset
+ = (*android_java_env)->GetFieldID (android_java_env,
+ emacs_gc_class,
+ "dash_offset", "I");
+ emacs_gc_dashes
+ = (*android_java_env)->GetFieldID (android_java_env,
+ emacs_gc_class,
+ "dashes", "[I");
}
struct android_gc *
@@ -3254,14 +3179,12 @@ android_create_gc (enum android_gc_value_mask mask,
struct android_gc_values *values)
{
struct android_gc *gc;
- android_handle prev_max_handle;
jobject object;
android_init_emacs_gc_class ();
gc = xmalloc (sizeof *gc);
- prev_max_handle = max_handle;
- gc->gcontext = android_alloc_id ();
+ gc->gcontext = 0;
gc->foreground = 0;
gc->background = 0xffffff;
gc->clip_rects = NULL;
@@ -3278,35 +3201,18 @@ android_create_gc (enum android_gc_value_mask mask,
gc->stipple = ANDROID_NONE;
gc->ts_x_origin = 0;
gc->ts_y_origin = 0;
-
- if (!gc->gcontext)
- {
- xfree (gc);
- error ("Out of GContext handles!");
- }
+ gc->line_style = ANDROID_LINE_SOLID;
+ gc->line_width = 0;
+ gc->dash_offset = 0;
+ gc->dashes = NULL;
+ gc->n_segments = 0;
object = (*android_java_env)->NewObject (android_java_env,
emacs_gc_class,
- emacs_gc_constructor,
- (jshort) gc->gcontext);
-
- if (!object)
- {
- (*android_java_env)->ExceptionClear (android_java_env);
-
- max_handle = prev_max_handle;
- memory_full (0);
- }
-
- android_handles[gc->gcontext].type = ANDROID_HANDLE_GCONTEXT;
- android_handles[gc->gcontext].handle
- = (*android_java_env)->NewGlobalRef (android_java_env, object);
- (*android_java_env)->ExceptionClear (android_java_env);
- ANDROID_DELETE_LOCAL_REF (object);
-
- if (!android_handles[gc->gcontext].handle)
- memory_full (0);
+ emacs_gc_constructor);
+ android_exception_check ();
+ gc->gcontext = android_globalize_reference (object);
android_change_gc (gc, mask, values);
return gc;
}
@@ -3316,6 +3222,7 @@ android_free_gc (struct android_gc *gc)
{
android_destroy_handle (gc->gcontext);
+ xfree (gc->dashes);
xfree (gc->clip_rects);
xfree (gc);
}
@@ -3325,14 +3232,13 @@ android_change_gc (struct android_gc *gc,
enum android_gc_value_mask mask,
struct android_gc_values *values)
{
- jobject what, gcontext;
+ jobject what, gcontext, array;
jboolean clip_changed;
clip_changed = false;
android_init_emacs_gc_class ();
- gcontext = android_resolve_handle (gc->gcontext,
- ANDROID_HANDLE_GCONTEXT);
+ gcontext = android_resolve_handle (gc->gcontext);
if (mask & ANDROID_GC_FOREGROUND)
{
@@ -3383,8 +3289,7 @@ android_change_gc (struct android_gc *gc,
if (mask & ANDROID_GC_CLIP_MASK)
{
- what = android_resolve_handle (values->clip_mask,
- ANDROID_HANDLE_PIXMAP);
+ what = android_resolve_handle (values->clip_mask);
(*android_java_env)->SetObjectField (android_java_env,
gcontext,
emacs_gc_clip_mask,
@@ -3405,8 +3310,7 @@ android_change_gc (struct android_gc *gc,
if (mask & ANDROID_GC_STIPPLE)
{
- what = android_resolve_handle (values->stipple,
- ANDROID_HANDLE_PIXMAP);
+ what = android_resolve_handle (values->stipple);
(*android_java_env)->SetObjectField (android_java_env,
gcontext,
emacs_gc_stipple,
@@ -3441,6 +3345,59 @@ android_change_gc (struct android_gc *gc,
gc->ts_y_origin = values->ts_y_origin;
}
+ if (mask & ANDROID_GC_LINE_STYLE)
+ {
+ (*android_java_env)->SetIntField (android_java_env,
+ gcontext,
+ emacs_gc_line_style,
+ values->line_style);
+ gc->line_style = values->line_style;
+ }
+
+ if (mask & ANDROID_GC_LINE_WIDTH)
+ {
+ (*android_java_env)->SetIntField (android_java_env,
+ gcontext,
+ emacs_gc_line_width,
+ values->line_width);
+ gc->line_width = values->line_width;
+ }
+
+ if (mask & ANDROID_GC_DASH_OFFSET)
+ {
+ (*android_java_env)->SetIntField (android_java_env,
+ gcontext,
+ emacs_gc_dash_offset,
+ values->dash_offset);
+ gc->dash_offset = values->dash_offset;
+ }
+
+ if (mask & ANDROID_GC_DASH_LIST)
+ {
+ /* Compare the new dash pattern with the old. */
+ if (gc->dashes && gc->n_segments == 1
+ && gc->dashes[0] == values->dash)
+ /* If they be identical, nothing needs to change. */
+ mask &= ~ANDROID_GC_DASH_LIST;
+ else
+ {
+ if (gc->n_segments != 1)
+ gc->dashes = xrealloc (gc->dashes, sizeof *gc->dashes);
+ gc->n_segments = 1;
+ gc->dashes[0] = values->dash;
+ array = (*android_java_env)->NewIntArray (android_java_env, 1);
+ android_exception_check ();
+ (*android_java_env)->SetIntArrayRegion (android_java_env,
+ array, 0, 1,
+ (jint *) &values->dash);
+ (*android_java_env)->SetObjectField (android_java_env,
+ gcontext,
+ emacs_gc_dashes,
+ array);
+ ANDROID_DELETE_LOCAL_REF (array);
+ }
+ }
+
if (mask)
{
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -3465,8 +3422,7 @@ android_set_clip_rectangles (struct android_gc *gc, int
clip_x_origin,
android_init_android_rect_class ();
android_init_emacs_gc_class ();
- gcontext = android_resolve_handle (gc->gcontext,
- ANDROID_HANDLE_GCONTEXT);
+ gcontext = android_resolve_handle (gc->gcontext);
array = (*android_java_env)->NewObjectArray (android_java_env,
n_clip_rects,
@@ -3532,6 +3488,74 @@ android_set_clip_rectangles (struct android_gc *gc, int
clip_x_origin,
n_clip_rects * sizeof *gc->clip_rects);
}
+void
+android_set_dashes (struct android_gc *gc, int dash_offset,
+ int *dash_list, int n)
+{
+ int i;
+ jobject array, gcontext;
+
+ gcontext = android_resolve_handle (gc->gcontext);
+
+ if (n == gc->n_segments
+ && (!gc->dashes || !memcmp (gc->dashes, dash_list,
+ sizeof *dash_list * n)))
+ /* No change in the dash list. */
+ goto set_offset;
+
+ if (!n)
+ {
+ /* Reset the dash list to its initial empty state. */
+ xfree (gc->dashes);
+ gc->dashes = NULL;
+ array = NULL;
+ }
+ else
+ {
+ /* If the size of the array has not changed, it can be reused. */
+
+ if (n != gc->n_segments)
+ {
+ gc->dashes = xrealloc (gc->dashes, sizeof *gc->dashes * n);
+ array = (*android_java_env)->NewIntArray (android_java_env, n);
+ android_exception_check ();
+ }
+ else
+ array = (*android_java_env)->GetObjectField (android_java_env,
+ gcontext,
+ emacs_gc_dashes);
+
+ /* Copy the list of segments into both arrays. */
+ for (i = 0; i < n; ++i)
+ gc->dashes[i] = dash_list[i];
+ verify (sizeof (int) == sizeof (jint));
+ (*android_java_env)->SetIntArrayRegion (android_java_env,
+ array, 0, n,
+ (jint *) dash_list);
+ }
+
+ /* Replace the dash array in the GContext object if required. */
+ if (n != gc->n_segments)
+ {
+ (*android_java_env)->SetObjectField (android_java_env,
+ gcontext,
+ emacs_gc_dashes,
+ array);
+ ANDROID_DELETE_LOCAL_REF (array);
+ }
+
+ gc->n_segments = n;
+
+ set_offset:
+ /* And the offset. */
+ if (dash_offset != gc->dash_offset)
+ (*android_java_env)->SetIntField (android_java_env,
+ gcontext,
+ emacs_gc_dash_offset,
+ dash_offset);
+ gc->dash_offset = dash_offset;
+}
+
void
android_reparent_window (android_window w, android_window parent_handle,
int x, int y)
@@ -3539,9 +3563,8 @@ android_reparent_window (android_window w, android_window
parent_handle,
jobject window, parent;
jmethodID method;
- window = android_resolve_handle (w, ANDROID_HANDLE_WINDOW);
- parent = android_resolve_handle (parent_handle,
- ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (w);
+ parent = android_resolve_handle (parent_handle);
method = window_class.reparent_to;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env, window,
@@ -3555,7 +3578,7 @@ android_clear_window (android_window handle)
{
jobject window;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
window,
@@ -3570,7 +3593,7 @@ android_map_window (android_window handle)
jobject window;
jmethodID map_window;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
map_window = window_class.map_window;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -3586,7 +3609,7 @@ android_unmap_window (android_window handle)
jobject window;
jmethodID unmap_window;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
unmap_window = window_class.unmap_window;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -3603,7 +3626,7 @@ android_resize_window (android_window handle, unsigned
int width,
jobject window;
jmethodID resize_window;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
resize_window = window_class.resize_window;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -3621,7 +3644,7 @@ android_move_window (android_window handle, int x, int y)
jobject window;
jmethodID move_window;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
move_window = window_class.move_window;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -3641,8 +3664,7 @@ android_swap_buffers (struct android_swap_info *swap_info,
for (i = 0; i < num_windows; ++i)
{
- window = android_resolve_handle (swap_info[i].swap_window,
- ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (swap_info[i].swap_window);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
window,
window_class.class,
@@ -3683,7 +3705,8 @@ android_get_gc_values (struct android_gc *gc,
values->ts_y_origin = gc->ts_y_origin;
/* Fields involving handles are not used by Emacs, and thus not
- implemented */
+ implemented. In addition, the size of GCClipMask and GCDashList is
+ not static, precluding their retrieval. */
}
void
@@ -3702,11 +3725,8 @@ android_fill_rectangle (android_drawable handle, struct
android_gc *gc,
{
jobject drawable, gcontext;
- drawable = android_resolve_handle2 (handle,
- ANDROID_HANDLE_WINDOW,
- ANDROID_HANDLE_PIXMAP);
- gcontext = android_resolve_handle (gc->gcontext,
- ANDROID_HANDLE_GCONTEXT);
+ drawable = android_resolve_handle (handle);
+ gcontext = android_resolve_handle (gc->gcontext);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
emacs_service,
@@ -4227,286 +4247,6 @@ android_blit_copy (int src_x, int src_y, int width, int
height,
}
-/* Xor a rectangle SRC_X, SRC_Y, WIDTH and HEIGHT from SRC, described
- by SRC_INFO, to DST_X and DST_Y in DST, as described by DST_INFO.
-
- Ignore the alpha channel when computing the exclusive-or of the
- destination pixel.
-
- If MASK is set, mask the source data using MASK_INFO, translating
- it by GC->clip_x_origin and GC->clip_y_origin. MASK must be a
- pixmap of depth 1.
-
- N.B. that currently only copies between bitmaps of depth 24 are
- implemented. */
-
-static void
-android_blit_xor (int src_x, int src_y, int width, int height,
- int dst_x, int dst_y, struct android_gc *gc,
- unsigned char *src, AndroidBitmapInfo *src_info,
- unsigned char *dst, AndroidBitmapInfo *dst_info,
- unsigned char *mask, AndroidBitmapInfo *mask_info)
-{
-#if 0
- uintptr_t start, end;
- int mask_offset;
- size_t pixel, offset, offset1;
- unsigned char *src_current, *dst_current;
- unsigned char *mask_current;
- int overflow, temp, i;
- bool backwards;
- unsigned int *long_src, *long_dst;
-#endif /* 0 */
-
- /* Note that this alu hasn't been tested -- it probably does not
- work! */
- emacs_abort ();
-
-#if 0
- /* Assert that the specified coordinates are within bounds. */
- eassert (src_x >= 0 && src_y >= 0
- && dst_x >= 0 && dst_y >= 0);
- eassert (src_x + width <= src_info->width);
- eassert (src_y + height <= src_info->height);
- eassert (dst_x + width <= dst_info->width);
- eassert (dst_y + height <= dst_info->height);
-
- /* Now check that each bitmap has the correct format. */
- eassert (src_info->format == dst_info->format
- && src_info->format == ANDROID_BITMAP_FORMAT_RGBA_8888);
- pixel = sizeof (unsigned int);
-
- /* Android doesn't have A1 bitmaps, so A8 is used to represent
- packed bitmaps of depth 1. */
- eassert (!mask || mask_info->format == ANDROID_BITMAP_FORMAT_A_8);
-
- /* Calculate the address of the first pixel of the first row to be
- copied in both src and dst. Compare them to determine the
- direction in which the copy is to take place. */
-
- overflow = ckd_mul (&start, src_y, src_info->stride);
- overflow |= ckd_mul (&end, src_x, pixel);
- overflow |= ckd_add (&start, (uintptr_t) src, start);
-
- if (overflow)
- return;
-
- src_current = (unsigned char *) start;
-
- overflow = ckd_mul (&start, dst_y, src_info->stride);
- overflow |= ckd_mul (&end, dst_x, pixel);
- overflow |= ckd_add (&start, (uintptr_t) dst, start);
-
- if (overflow)
- return;
-
- dst_current = (unsigned char *) start;
- backwards = false;
-
- /* Now see if copying should proceed from the bottom up. */
-
- if (src == dst && dst_current >= src_current)
- {
- backwards = true;
-
- /* Walk src and dst from bottom to top, in order to avoid
- overlap. Calculate the coordinate of the last pixel of the
- last row in both src and dst. */
-
- overflow = ckd_mul (&start, src_y + height - 1,
- src_info->stride);
- if (mask) /* If a mask is set, put the pointers before the end
- of the row. */
- overflow |= ckd_mul (&end, src_x + width - 1, pixel);
- else
- overflow |= ckd_mul (&end, src_x, pixel);
- overflow |= ckd_add (&start, start, end);
- overflow |= ckd_add (&start, (uintptr_t) src, start);
-
- if (overflow)
- return;
-
- src_current = (unsigned char *) start;
-
- overflow = ckd_mul (&start, dst_y + height - 1,
- dst_info->stride);
- if (mask) /* If a mask is set, put the pointers before the end
- of the row. */
- overflow |= ckd_mul (&end, dst_x + width - 1, pixel);
- else
- overflow |= ckd_mul (&end, dst_x, pixel);
- overflow |= ckd_add (&start, start, end);
- overflow |= ckd_add (&start, (uintptr_t) dst, start);
-
- if (overflow)
- return;
-
- dst_current = (unsigned char *) start;
- }
-
- if (!mask)
- {
- /* Change the direction of the copy depending on how SRC and DST
- overlap. */
-
- for (i = 0; i < height; ++i)
- {
- if (backwards)
- {
- for (i = width - 1; i <= 0; --i)
- (((unsigned int *) dst_current)[i])
- /* Keep the alpha channel intact. */
- ^= (((unsigned int *) src_current)[i]) & 0xffffff;
-
- /* Proceed to the last row. */
- src_current -= src_info->stride;
- dst_current -= dst_info->stride;
- }
- else
- {
- for (i = 0; i < width; ++i)
- (((unsigned int *) dst_current)[i])
- /* Keep the alpha channel intact. */
- ^= (((unsigned int *) src_current)[i]) & 0xffffff;
-
- /* Proceed to the next row. */
- src_current += src_info->stride;
- dst_current += dst_info->stride;
- }
- }
- }
- else
- {
- /* Adjust the source and destination Y. The start is MAX
- (dst_y, gc->clip_y_origin); the difference between that value
- and dst_y is the offset to apply to src_y. */
-
- temp = dst_y;
- dst_y = MAX (dst_y, gc->clip_y_origin);
- src_y += dst_y - temp;
- height -= dst_y - temp;
-
- /* Verify that the bounds are correct. */
- eassert (dst_y + height
- <= gc->clip_y_origin + mask_info->height);
- eassert (dst_y >= gc->clip_y_origin);
-
- /* There is a mask. For each scan line... */
-
- if (backwards)
- {
- /* Calculate the number of pixels at the end of the
- mask. */
-
- mask_offset = dst_x + width;
- mask_offset -= mask_info->width + gc->clip_x_origin;
-
- if (mask_info < 0)
- mask_info = 0;
-
- /* Calculate the last column of the mask that will be
- consulted. */
-
- temp = dst_x - gc->clip_x_origin;
- temp += MIN (mask_info->width - temp,
- width - mask_offset);
-
- if (temp < 0)
- return;
-
- /* Now calculate the last row of the mask that will be
- consulted. */
- i = dst_y - gc->clip_y_origin + height;
-
- /* Turn both into offsets. */
-
- 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;
-
- for (i = 0; i < height; ++i)
- {
- /* Skip backwards past the end of the mask. */
-
- long_src = (unsigned int *) (src_current - mask_offset * pixel);
- long_dst = (unsigned int *) (dst_current - mask_offset * pixel);
- mask = mask_current;
-
- /* For each pixel covered by the mask... */
- temp = MIN (mask_info->width - temp, width - mask_offset);
- while (temp--)
- /* XOR the source to the destination, masked by the
- mask. */
- *long_dst-- ^= ((*(long_src--) & (0u - (*(mask--) & 1)))
- & 0xffffff);
-
- /* Return to the last row. */
- src_current -= src_info->stride;
- dst_current -= dst_info->stride;
- mask_current -= mask_info->stride;
- }
- }
- else
- {
- /* Calculate the first column of the mask that will be
- consulted. */
-
- mask_offset = dst_x - gc->clip_x_origin;
-
- /* Adjust the mask by that much. */
-
- if (mask_offset > 0)
- mask += mask_offset;
- else
- {
- /* Offset src and dst by the mask offset. */
- src_current += -mask_offset * pixel;
- dst_current += -mask_offset * pixel;
- width -= mask_offset;
- }
-
- /* Now move mask to the position of the first row. */
-
- mask += gc->clip_y_origin * mask_info->stride;
-
- for (i = 0; i < height; ++i)
- {
- long_src = (unsigned int *) src_current;
- long_dst = (unsigned int *) dst_current;
- mask_current = mask;
-
- if (mask_offset > 0)
- {
- /* Copy bytes according to the mask. */
- temp = MIN (mask_info->width - mask_offset, width);
- while (temp--)
- *long_dst++ ^= ((*(long_src++)
- & (0u - (*(mask_current++) & 1)))
- & 0xffffff);
- }
- else
- {
- /* Copy bytes according to the mask. */
- temp = MIN (mask_info->width, width);
- while (temp--)
- *long_dst++ = ((*(long_src++)
- & (0u - (*(mask_current++) & 1)))
- & 0xffffff);
- }
-
- src_current += src_info->stride;
- dst_current += dst_info->stride;
- mask += mask_info->stride;
- }
- }
- }
-#endif /* 0 */
-}
-
void
android_copy_area (android_drawable src, android_drawable dest,
struct android_gc *gc, int src_x, int src_y,
@@ -4609,10 +4349,10 @@ android_copy_area (android_drawable src,
android_drawable dest,
do_blit = android_blit_copy;
break;
- case ANDROID_GC_XOR:
- do_blit = android_blit_xor;
- break;
-
+ /* case ANDROID_GC_INVERT: */
+ /* do_blit = android_blit_invert; */
+ /* A GC with its operation set to ANDROID_GC_INVERT is never given
+ to CopyArea. */
default:
emacs_abort ();
}
@@ -4653,7 +4393,9 @@ android_copy_area (android_drawable src, android_drawable
dest,
/* Now damage the destination drawable accordingly, should it be a
window. */
- if (android_handles[dest].type == ANDROID_HANDLE_WINDOW)
+ if ((*android_java_env)->IsInstanceOf (android_java_env,
+ (jobject) dest,
+ window_class.class))
android_damage_window (dest, &bounds);
fail2:
@@ -4699,11 +4441,8 @@ android_fill_polygon (android_drawable drawable, struct
android_gc *gc,
jobject point, drawable_object, gcontext;
int i;
- drawable_object = android_resolve_handle2 (drawable,
- ANDROID_HANDLE_WINDOW,
- ANDROID_HANDLE_PIXMAP);
- gcontext = android_resolve_handle (gc->gcontext,
- ANDROID_HANDLE_GCONTEXT);
+ drawable_object = android_resolve_handle (drawable);
+ gcontext = android_resolve_handle (gc->gcontext);
array = (*android_java_env)->NewObjectArray (android_java_env,
npoints,
@@ -4741,11 +4480,8 @@ android_draw_rectangle (android_drawable handle, struct
android_gc *gc,
{
jobject drawable, gcontext;
- drawable = android_resolve_handle2 (handle,
- ANDROID_HANDLE_WINDOW,
- ANDROID_HANDLE_PIXMAP);
- gcontext = android_resolve_handle (gc->gcontext,
- ANDROID_HANDLE_GCONTEXT);
+ drawable = android_resolve_handle (handle);
+ gcontext = android_resolve_handle (gc->gcontext);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
emacs_service,
@@ -4766,11 +4502,8 @@ android_draw_point (android_drawable handle, struct
android_gc *gc,
{
jobject drawable, gcontext;
- drawable = android_resolve_handle2 (handle,
- ANDROID_HANDLE_WINDOW,
- ANDROID_HANDLE_PIXMAP);
- gcontext = android_resolve_handle (gc->gcontext,
- ANDROID_HANDLE_GCONTEXT);
+ drawable = android_resolve_handle (handle);
+ gcontext = android_resolve_handle (gc->gcontext);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
emacs_service,
@@ -4790,11 +4523,8 @@ android_draw_line (android_drawable handle, struct
android_gc *gc,
{
jobject drawable, gcontext;
- drawable = android_resolve_handle2 (handle,
- ANDROID_HANDLE_WINDOW,
- ANDROID_HANDLE_PIXMAP);
- gcontext = android_resolve_handle (gc->gcontext,
- ANDROID_HANDLE_GCONTEXT);
+ drawable = android_resolve_handle (handle);
+ gcontext = android_resolve_handle (gc->gcontext);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
emacs_service,
@@ -4813,41 +4543,15 @@ android_pixmap
android_create_pixmap (unsigned int width, unsigned int height,
int depth)
{
- android_handle prev_max_handle;
jobject object;
- android_pixmap pixmap;
-
- /* First, allocate the pixmap handle. */
- prev_max_handle = max_handle;
- pixmap = android_alloc_id ();
-
- if (!pixmap)
- error ("Out of pixmap handles!");
object = (*android_java_env)->NewObject (android_java_env,
pixmap_class.class,
pixmap_class.constructor_mutable,
- (jshort) pixmap,
(jint) width, (jint) height,
(jint) depth);
-
- if (!object)
- {
- (*android_java_env)->ExceptionClear (android_java_env);
- max_handle = prev_max_handle;
- memory_full (0);
- }
-
- android_handles[pixmap].type = ANDROID_HANDLE_PIXMAP;
- android_handles[pixmap].handle
- = (*android_java_env)->NewGlobalRef (android_java_env, object);
- (*android_java_env)->ExceptionClear (android_java_env);
- ANDROID_DELETE_LOCAL_REF (object);
-
- if (!android_handles[pixmap].handle)
- memory_full (0);
-
- return pixmap;
+ android_exception_check ();
+ return android_globalize_reference (object);
}
void
@@ -4868,7 +4572,7 @@ android_clear_area (android_window handle, int x, int y,
{
jobject window;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
window,
@@ -4882,8 +4586,8 @@ android_pixmap
android_create_bitmap_from_data (char *bits, unsigned int width,
unsigned int height)
{
- return android_create_pixmap_from_bitmap_data (bits, 1, 0,
- width, height, 1);
+ return android_create_pixmap_from_bitmap_data (bits, width, height,
+ 1, 0, 1);
}
struct android_image *
@@ -5020,8 +4724,7 @@ android_get_image (android_drawable handle,
unsigned char *data1, *data2;
int i, x;
- drawable = android_resolve_handle2 (handle, ANDROID_HANDLE_WINDOW,
- ANDROID_HANDLE_PIXMAP);
+ drawable = android_resolve_handle (handle);
/* Look up the drawable and get the bitmap corresponding to it.
Then, lock the bitmap's bits. */
@@ -5155,7 +4858,7 @@ android_put_image (android_pixmap handle, struct
android_image *image)
unsigned char *data_1, *data_2;
int i, x;
- drawable = android_resolve_handle (handle, ANDROID_HANDLE_PIXMAP);
+ drawable = android_resolve_handle (handle);
/* Look up the drawable and get the bitmap corresponding to it.
Then, lock the bitmap's bits. */
@@ -5257,7 +4960,7 @@ android_set_input_focus (android_window handle, unsigned
long time)
jobject window;
jmethodID make_input_focus;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
make_input_focus = window_class.make_input_focus;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -5274,7 +4977,7 @@ android_raise_window (android_window handle)
jobject window;
jmethodID raise;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
raise = window_class.raise;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -5290,7 +4993,7 @@ android_lower_window (android_window handle)
jobject window;
jmethodID lower;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
lower = window_class.lower;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -5307,7 +5010,7 @@ android_reconfigure_wm_window (android_window handle,
{
jobject sibling, window;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
if (!(value_mask & ANDROID_CW_STACK_MODE))
return;
@@ -5319,8 +5022,7 @@ android_reconfigure_wm_window (android_window handle,
sibling = NULL;
if (value_mask & ANDROID_CW_SIBLING)
- sibling = android_resolve_handle (values->sibling,
- ANDROID_HANDLE_WINDOW);
+ sibling = android_resolve_handle (values->sibling);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
window,
@@ -5340,10 +5042,10 @@ android_query_tree (android_window handle,
android_window *root_return,
jobject window, array;
jsize nelements, i;
android_window *children;
- jshort *shorts;
+ jlong *longs;
jmethodID method;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
/* window can be NULL, so this is a service method. */
method = service_class.query_tree;
@@ -5363,25 +5065,25 @@ android_query_tree (android_window handle,
android_window *root_return,
/* Now fill in the children. */
children = xnmalloc (nelements - 1, sizeof *children);
- shorts
- = (*android_java_env)->GetShortArrayElements (android_java_env, array,
- NULL);
- android_exception_check_nonnull (shorts, array);
+ longs
+ = (*android_java_env)->GetLongArrayElements (android_java_env, array,
+ NULL);
+ android_exception_check_nonnull (longs, array);
for (i = 1; i < nelements; ++i)
/* Subtract one from the index into children, since the parent is
not included. */
- children[i - 1] = shorts[i];
+ children[i - 1] = longs[i];
/* Finally, return the parent and other values. */
*root_return = 0;
- *parent_return = shorts[0];
+ *parent_return = longs[0];
*children_return = children;
*nchildren_return = nelements - 1;
/* Release the array contents. */
- (*android_java_env)->ReleaseShortArrayElements (android_java_env, array,
- shorts, JNI_ABORT);
+ (*android_java_env)->ReleaseLongArrayElements (android_java_env, array,
+ longs, JNI_ABORT);
ANDROID_DELETE_LOCAL_REF (array);
return 1;
@@ -5400,7 +5102,7 @@ android_get_geometry (android_window handle,
jmethodID get_geometry;
jint *ints;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
get_geometry = window_class.get_window_geometry;
window_geometry
@@ -5462,7 +5164,7 @@ android_translate_coordinates (android_window src, int x,
jmethodID method;
jint *ints;
- window = android_resolve_handle (src, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (src);
method = window_class.translate_coordinates;
coordinates
= (*android_java_env)->CallNonvirtualObjectMethod (android_java_env,
@@ -5630,51 +5332,44 @@ android_wc_lookup_string (android_key_pressed_event
*event,
/* Now look up the window. */
rc = 0;
- if (!android_handles[event->window].handle
- || (android_handles[event->window].type
- != ANDROID_HANDLE_WINDOW))
+ window = android_resolve_handle (event->window);
+ string
+ = (*env)->CallNonvirtualObjectMethod (env, window,
+ window_class.class,
+ window_class.lookup_string,
+ (jint) event->serial);
+ android_exception_check ();
+
+ if (!string)
status = ANDROID_LOOKUP_NONE;
else
{
- window = android_handles[event->window].handle;
- string
- = (*env)->CallNonvirtualObjectMethod (env, window,
- window_class.class,
- window_class.lookup_string,
- (jint) event->serial);
- android_exception_check ();
+ /* Now return this input method string. */
+ characters = (*env)->GetStringChars (env, string, NULL);
+ android_exception_check_nonnull ((void *) characters, string);
- if (!string)
- status = ANDROID_LOOKUP_NONE;
- else
- {
- /* Now return this input method string. */
- characters = (*env)->GetStringChars (env, string, NULL);
- android_exception_check_nonnull ((void *) characters, string);
-
- /* Establish the size of the the string. */
- size = (*env)->GetStringLength (env, string);
+ /* Establish the size of the the string. */
+ size = (*env)->GetStringLength (env, string);
- /* Copy over the string data. */
- for (i = 0; i < MIN ((unsigned int) wchars_buffer, size); ++i)
- buffer_return[i] = characters[i];
+ /* Copy over the string data. */
+ for (i = 0; i < MIN ((unsigned int) wchars_buffer, size); ++i)
+ buffer_return[i] = characters[i];
- if (i < size)
- status = ANDROID_BUFFER_OVERFLOW;
- else
- status = ANDROID_LOOKUP_CHARS;
+ if (i < size)
+ status = ANDROID_BUFFER_OVERFLOW;
+ else
+ status = ANDROID_LOOKUP_CHARS;
- /* Return the number of characters that should have been
- written. */
+ /* Return the number of characters that should have been
+ written. */
- if (size > INT_MAX)
- rc = INT_MAX;
- else
- rc = size;
+ if (size > INT_MAX)
+ rc = INT_MAX;
+ else
+ rc = size;
- (*env)->ReleaseStringChars (env, string, characters);
- ANDROID_DELETE_LOCAL_REF (string);
- }
+ (*env)->ReleaseStringChars (env, string, characters);
+ ANDROID_DELETE_LOCAL_REF (string);
}
*status_return = status;
@@ -5708,8 +5403,7 @@ android_lock_bitmap (android_drawable drawable,
jobject object, bitmap;
void *data;
- object = android_resolve_handle2 (drawable, ANDROID_HANDLE_WINDOW,
- ANDROID_HANDLE_PIXMAP);
+ object = android_resolve_handle (drawable);
/* Look up the drawable and get the bitmap corresponding to it.
Then, lock the bitmap's bits. */
@@ -5763,7 +5457,7 @@ android_damage_window (android_drawable handle,
{
jobject drawable;
- drawable = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ drawable = android_resolve_handle (handle);
/* Post the damage to the drawable. */
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -5884,7 +5578,7 @@ android_set_dont_focus_on_map (android_window handle,
jmethodID method;
jobject window;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
method = window_class.set_dont_focus_on_map;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env, window,
@@ -5901,7 +5595,7 @@ android_set_dont_accept_focus (android_window handle,
jmethodID method;
jobject window;
- window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (handle);
method = window_class.set_dont_accept_focus;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env, window,
@@ -5911,6 +5605,27 @@ android_set_dont_accept_focus (android_window handle,
android_exception_check ();
}
+/* Set the WM name of HANDLE to STRING, a Java string. This name
+ provides the task description of activities that receive HANDLE. */
+
+void
+android_set_wm_name (android_window handle, jstring name)
+{
+ jmethodID method;
+ jobject window;
+
+ window = android_resolve_handle (handle);
+ method = window_class.set_wm_name;
+
+ if (android_get_current_api_level () < 21)
+ return;
+
+ (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, window,
+ window_class.class, method,
+ name);
+ android_exception_check ();
+}
+
void
android_get_keysym_name (int keysym, char *name_return, size_t size)
{
@@ -5980,7 +5695,7 @@ android_toggle_on_screen_keyboard (android_window window,
bool show)
jobject object;
jmethodID method;
- object = android_resolve_handle (window, ANDROID_HANDLE_WINDOW);
+ object = android_resolve_handle (window);
method = window_class.toggle_on_screen_keyboard;
/* Now display the on screen keyboard. */
@@ -5994,40 +5709,22 @@ android_toggle_on_screen_keyboard (android_window
window, bool show)
-#if defined __clang_major__ && __clang_major__ < 5
-# define HAS_BUILTIN_TRAP 0
-#elif 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__))
-# define HAS_BUILTIN_TRAP 1
-#elif defined __has_builtin
-# define HAS_BUILTIN_TRAP __has_builtin (__builtin_trap)
-#else /* !__has_builtin */
-# define HAS_BUILTIN_TRAP 0
-#endif /* defined __clang_major__ && __clang_major__ < 5 */
-
/* emacs_abort implementation for Android. This logs a stack
trace. */
void
emacs_abort (void)
{
-#ifndef HAS_BUILTIN_TRAP
volatile char *foo;
-#endif /* !HAS_BUILTIN_TRAP */
__android_log_print (ANDROID_LOG_FATAL, __func__,
"emacs_abort called, please review the following"
" stack trace");
-#ifndef HAS_BUILTIN_TRAP
/* Induce a NULL pointer dereference to make debuggerd generate a
tombstone. */
foo = NULL;
*foo = '\0';
-#else /* HAS_BUILTIN_TRAP */
- /* Crash through __builtin_trap instead. This appears to more
- uniformly elicit crash reports from debuggerd. */
- __builtin_trap ();
-#endif /* !HAS_BUILTIN_TRAP */
abort ();
}
@@ -6259,11 +5956,7 @@ android_build_jstring (const char *text)
if global_foo cannot be allocated, and after the global reference
is created. */
-#if __GNUC__ >= 3
#define likely(cond) __builtin_expect (cond, 1)
-#else /* __GNUC__ < 3 */
-#define likely(cond) (cond)
-#endif /* __GNUC__ >= 3 */
/* Check for JNI exceptions and call memory_full in that
situation. */
@@ -6975,7 +6668,7 @@ android_recreate_activity (android_window window)
jobject object;
jmethodID method;
- object = android_resolve_handle (window, ANDROID_HANDLE_WINDOW);
+ object = android_resolve_handle (window);
method = window_class.recreate_activity;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env, object,
@@ -7340,7 +7033,7 @@ android_update_ic (android_window window, ptrdiff_t
selection_start,
{
jobject object;
- object = android_resolve_handle (window, ANDROID_HANDLE_WINDOW);
+ object = android_resolve_handle (window);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
emacs_service,
@@ -7377,7 +7070,7 @@ android_reset_ic (android_window window, enum
android_ic_mode mode)
{
jobject object;
- object = android_resolve_handle (window, ANDROID_HANDLE_WINDOW);
+ object = android_resolve_handle (window);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
emacs_service,
@@ -7399,7 +7092,7 @@ android_update_extracted_text (android_window window,
void *text,
jobject object;
jmethodID method;
- object = android_resolve_handle (window, ANDROID_HANDLE_WINDOW);
+ object = android_resolve_handle (window);
method = service_class.update_extracted_text;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -7433,7 +7126,7 @@ android_update_cursor_anchor_info (android_window window,
float x,
jobject object;
jmethodID method;
- object = android_resolve_handle (window, ANDROID_HANDLE_WINDOW);
+ object = android_resolve_handle (window);
method = service_class.update_cursor_anchor_info;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -7468,7 +7161,7 @@ android_set_fullscreen (android_window window, bool
fullscreen)
if (android_api_level < 16)
return 1;
- object = android_resolve_handle (window, ANDROID_HANDLE_WINDOW);
+ object = android_resolve_handle (window);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
object,
@@ -7486,40 +7179,15 @@ android_set_fullscreen (android_window window, bool
fullscreen)
android_cursor
android_create_font_cursor (enum android_cursor_shape shape)
{
- android_cursor id;
- short prev_max_handle;
jobject object;
- /* First, allocate the cursor handle. */
- prev_max_handle = max_handle;
- id = android_alloc_id ();
-
- if (!id)
- error ("Out of cursor handles!");
-
/* Next, create the cursor. */
object = (*android_java_env)->NewObject (android_java_env,
cursor_class.class,
cursor_class.constructor,
- (jshort) id,
(jint) shape);
- if (!object)
- {
- (*android_java_env)->ExceptionClear (android_java_env);
- max_handle = prev_max_handle;
- memory_full (0);
- }
-
- android_handles[id].type = ANDROID_HANDLE_CURSOR;
- android_handles[id].handle
- = (*android_java_env)->NewGlobalRef (android_java_env, object);
- (*android_java_env)->ExceptionClear (android_java_env);
- ANDROID_DELETE_LOCAL_REF (object);
-
- if (!android_handles[id].handle)
- memory_full (0);
-
- return id;
+ android_exception_check ();
+ return android_globalize_reference (object);
}
void
@@ -7528,8 +7196,8 @@ android_define_cursor (android_window window,
android_cursor cursor)
jobject window1, cursor1;
jmethodID method;
- window1 = android_resolve_handle (window, ANDROID_HANDLE_WINDOW);
- cursor1 = android_resolve_handle (cursor, ANDROID_HANDLE_CURSOR);
+ window1 = android_resolve_handle (window);
+ cursor1 = android_resolve_handle (cursor);
method = window_class.define_cursor;
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -7542,13 +7210,6 @@ android_define_cursor (android_window window,
android_cursor cursor)
void
android_free_cursor (android_cursor cursor)
{
- if (android_handles[cursor].type != ANDROID_HANDLE_CURSOR)
- {
- __android_log_print (ANDROID_LOG_ERROR, __func__,
- "Trying to destroy something not a CURSOR!");
- emacs_abort ();
- }
-
android_destroy_handle (cursor);
}
diff --git a/src/android.h b/src/android.h
index 19adfa38087..29459b063f3 100644
--- a/src/android.h
+++ b/src/android.h
@@ -31,6 +31,8 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <pwd.h>
#include <sys/stat.h>
+#include <sys/select.h>
+
#include <dirent.h>
#include <stdio.h>
@@ -53,6 +55,22 @@ extern char *android_user_full_name (struct passwd *);
+/* Structure describing the android.os.ParcelFileDescriptor class used
+ to wrap file descriptors sent over IPC. */
+
+struct android_parcel_file_descriptor_class
+{
+ jclass class;
+ jmethodID close;
+ jmethodID get_fd;
+ jmethodID detach_fd;
+};
+
+/* The ParcelFileDescriptor class. */
+extern struct android_parcel_file_descriptor_class fd_class;
+
+extern void android_init_fd_class (JNIEnv *);
+
/* File I/O operations. Many of these are defined in
androidvfs.c. */
@@ -85,16 +103,9 @@ extern ssize_t android_readlinkat (int, const char
*restrict, char *restrict,
extern double android_pixel_density_x, android_pixel_density_y;
extern double android_scaled_pixel_density;
-enum android_handle_type
- {
- ANDROID_HANDLE_WINDOW,
- ANDROID_HANDLE_GCONTEXT,
- ANDROID_HANDLE_PIXMAP,
- ANDROID_HANDLE_CURSOR,
- };
+verify (sizeof (android_handle) == sizeof (jobject));
+#define android_resolve_handle(handle) ((jobject) (handle))
-extern jobject android_resolve_handle (android_handle,
- enum android_handle_type);
extern unsigned char *android_lock_bitmap (android_drawable,
AndroidBitmapInfo *,
jobject *);
@@ -109,6 +120,7 @@ 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);
+extern void android_set_wm_name (android_window, jstring);
extern int android_verify_jni_string (const char *);
extern jstring android_build_string (Lisp_Object, ...);
@@ -266,8 +278,6 @@ struct android_emacs_service
jmethodID draw_rectangle;
jmethodID draw_line;
jmethodID draw_point;
- jmethodID clear_window;
- jmethodID clear_area;
jmethodID ring_bell;
jmethodID query_tree;
jmethodID get_screen_width;
diff --git a/src/androidfns.c b/src/androidfns.c
index 9f7ac8b69b2..4246f6d2be4 100644
--- a/src/androidfns.c
+++ b/src/androidfns.c
@@ -19,6 +19,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <config.h>
#include <math.h>
+#include <stdlib.h>
#include "lisp.h"
#include "android.h"
@@ -211,18 +212,90 @@ android_set_parent_frame (struct frame *f, Lisp_Object
new_value,
FRAME_TERMINAL (f)->fullscreen_hook (f);
}
+/* Set the WM name to NAME for frame F. Also set the icon name.
+ If the frame already has an icon name, use that, otherwise set the
+ icon name to NAME. */
+
+static void
+android_set_name_internal (struct frame *f, Lisp_Object name)
+{
+ jstring java_name;
+
+ if (FRAME_ANDROID_WINDOW (f))
+ {
+ java_name = android_build_string (name, NULL);
+ android_set_wm_name (FRAME_ANDROID_WINDOW (f), java_name);
+ ANDROID_DELETE_LOCAL_REF (java_name);
+ }
+}
+
+/* Change the name of frame F to NAME. If NAME is nil, set F's name to
+ x_id_name.
+
+ If EXPLICIT is true, that indicates that lisp code is setting the
+ name; if NAME is a string, set F's name to NAME and set
+ F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
+
+ If EXPLICIT is false, that indicates that Emacs redisplay code is
+ suggesting a new name, which lisp code should override; if
+ F->explicit_name is set, ignore the new name; otherwise, set it. */
+
+static void
+android_set_name (struct frame *f, Lisp_Object name, bool explicit)
+{
+ /* Make sure that requests from lisp code override requests from
+ Emacs redisplay code. */
+ if (explicit)
+ {
+ /* If we're switching from explicit to implicit, we had better
+ update the mode lines and thereby update the title. */
+ if (f->explicit_name && NILP (name))
+ update_mode_lines = 37;
+
+ f->explicit_name = ! NILP (name);
+ }
+ else if (f->explicit_name)
+ return;
+
+ /* If NAME is nil, set the name to the x_id_name. */
+ if (NILP (name))
+ {
+ /* Check for no change needed in this very common case
+ before we do any consing. */
+ if (!strcmp (FRAME_DISPLAY_INFO (f)->x_id_name,
+ SSDATA (f->name)))
+ return;
+ name = build_string (FRAME_DISPLAY_INFO (f)->x_id_name);
+ }
+ else
+ CHECK_STRING (name);
+
+ /* Don't change the name if it's already NAME. */
+ if (! NILP (Fstring_equal (name, f->name)))
+ return;
+
+ fset_name (f, name);
+
+ /* For setting the frame title, the title parameter should override
+ the name parameter. */
+ if (! NILP (f->title))
+ name = f->title;
+
+ android_set_name_internal (f, name);
+}
+
void
android_implicitly_set_name (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
{
-
+ android_set_name (f, arg, false);
}
void
android_explicitly_set_name (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
{
-
+ android_set_name (f, arg, true);
}
/* Set the number of lines used for the tool bar of frame F to VALUE.
@@ -1202,7 +1275,10 @@ DEFUN ("xw-display-color-p", Fxw_display_color_p,
doc: /* SKIP: real doc in xfns.c. */)
(Lisp_Object terminal)
{
- return Qt;
+ struct android_display_info *dpyinfo;
+
+ dpyinfo = check_android_display_info (terminal);
+ return dpyinfo->n_planes > 8 ? Qt : Qnil;
}
DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
@@ -1210,7 +1286,11 @@ DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
doc: /* SKIP: real doc in xfns.c. */)
(Lisp_Object terminal)
{
- return Qnil;
+ struct android_display_info *dpyinfo;
+
+ dpyinfo = check_android_display_info (terminal);
+ return (dpyinfo->n_planes > 1 && dpyinfo->n_planes <= 8
+ ? Qt : Qnil);
}
DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
@@ -1345,7 +1425,12 @@ DEFUN ("x-display-visual-class", Fx_display_visual_class,
doc: /* SKIP: real doc in xfns.c. */)
(Lisp_Object terminal)
{
- check_android_display_info (terminal);
+ struct android_display_info *dpyinfo;
+
+ dpyinfo = check_android_display_info (terminal);
+
+ if (dpyinfo->n_planes < 24)
+ return Qstatic_gray;
return Qtrue_color;
}
@@ -1805,7 +1890,16 @@ Android, so there is no equivalent of
`x-open-connection'. */)
terminal = Qnil;
if (x_display_list)
- XSETTERMINAL (terminal, x_display_list->terminal);
+ {
+ XSETTERMINAL (terminal, x_display_list->terminal);
+
+ /* Update the display's bit depth from
+ `android_display_planes'. */
+ x_display_list->n_planes
+ = (android_display_planes > 8
+ ? 24 : (android_display_planes > 1
+ ? android_display_planes : 1));
+ }
return terminal;
#endif
@@ -2967,6 +3061,8 @@ android_set_title (struct frame *f, Lisp_Object name,
name = f->name;
else
CHECK_STRING (name);
+
+ android_set_name_internal (f, name);
}
static void
@@ -3479,6 +3575,7 @@ syms_of_androidfns (void)
{
/* Miscellaneous symbols used by some functions here. */
DEFSYM (Qtrue_color, "true-color");
+ DEFSYM (Qstatic_gray, "static-color");
DEFSYM (Qwhen_mapped, "when-mapped");
DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape,
diff --git a/src/androidfont.c b/src/androidfont.c
index 5fd3018b6d4..5cd23a006e8 100644
--- a/src/androidfont.c
+++ b/src/androidfont.c
@@ -136,26 +136,26 @@ struct androidfont_entity
/* Method and class identifiers associated with the EmacsFontDriver
class. */
-struct android_emacs_font_driver font_driver_class;
+static struct android_emacs_font_driver font_driver_class;
/* Field and class identifiers associated with the
EmacsFontDriver$FontSpec class. */
-struct android_emacs_font_spec font_spec_class;
+static struct android_emacs_font_spec font_spec_class;
/* Method and class identifiers associated with the Integer class. */
-struct android_integer integer_class;
+static struct android_integer integer_class;
/* Field and class identifiers associated with the
EmacsFontDriver$FontMetrics class. */
-struct android_emacs_font_metrics font_metrics_class;
+static struct android_emacs_font_metrics font_metrics_class;
/* Field and class identifiers associated with the
EmacsFontDriver$FontObject class. */
-struct android_emacs_font_object font_object_class;
+static struct android_emacs_font_object font_object_class;
/* The font cache. */
@@ -657,10 +657,8 @@ androidfont_draw (struct glyph_string *s, int from, int to,
verify (sizeof (unsigned int) == sizeof (jint));
info = (struct androidfont_info *) s->font;
- gcontext = android_resolve_handle (s->gc->gcontext,
- ANDROID_HANDLE_GCONTEXT);
- drawable = android_resolve_handle (FRAME_ANDROID_DRAWABLE (s->f),
- ANDROID_HANDLE_WINDOW);
+ gcontext = android_resolve_handle (s->gc->gcontext);
+ drawable = android_resolve_handle (FRAME_ANDROID_DRAWABLE (s->f));
chars = (*android_java_env)->NewIntArray (android_java_env,
to - from);
android_exception_check ();
diff --git a/src/androidgui.h b/src/androidgui.h
index f941c7cc577..79e42c7947c 100644
--- a/src/androidgui.h
+++ b/src/androidgui.h
@@ -19,6 +19,8 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#ifndef _ANDROID_GUI_H_
#define _ANDROID_GUI_H_
+#include <stdint.h>
+
struct android_char_struct
{
int rbearing;
@@ -30,7 +32,8 @@ struct android_char_struct
typedef struct android_char_struct XCharStruct;
-typedef unsigned short android_handle;
+/* Handles are but JNI handles cast to intptr_t. */
+typedef intptr_t android_handle;
typedef android_handle android_pixmap, Emacs_Pixmap;
typedef android_handle android_window, Emacs_Window;
@@ -56,7 +59,7 @@ struct android_point
enum android_gc_function
{
ANDROID_GC_COPY = 0,
- ANDROID_GC_XOR = 1,
+ ANDROID_GC_INVERT = 1,
};
enum android_gc_value_mask
@@ -71,6 +74,10 @@ enum android_gc_value_mask
ANDROID_GC_FILL_STYLE = (1 << 7),
ANDROID_GC_TILE_STIP_X_ORIGIN = (1 << 8),
ANDROID_GC_TILE_STIP_Y_ORIGIN = (1 << 9),
+ ANDROID_GC_LINE_STYLE = (1 << 10),
+ ANDROID_GC_LINE_WIDTH = (1 << 11),
+ ANDROID_GC_DASH_LIST = (1 << 12),
+ ANDROID_GC_DASH_OFFSET = (1 << 13),
};
enum android_fill_style
@@ -79,6 +86,12 @@ enum android_fill_style
ANDROID_FILL_OPAQUE_STIPPLED = 1,
};
+enum android_line_style
+ {
+ ANDROID_LINE_SOLID = 0,
+ ANDROID_LINE_ON_OFF_DASH = 1,
+ };
+
enum android_window_value_mask
{
ANDROID_CW_BACK_PIXEL = (1 << 1),
@@ -114,6 +127,18 @@ struct android_gc_values
/* The tile-stipple X and Y origins. */
int ts_x_origin, ts_y_origin;
+
+ /* The line style. */
+ enum android_line_style line_style;
+
+ /* The line width. */
+ int line_width;
+
+ /* Offset in pixels into the dash pattern specified below. */
+ int dash_offset;
+
+ /* One integer providing both segments of a even-odd dash pattern. */
+ int dash;
};
/* X-like graphics context structure. This is implemented in
@@ -152,6 +177,18 @@ struct android_gc
/* The tile-stipple X and Y origins. */
int ts_x_origin, ts_y_origin;
+
+ /* The line style. */
+ enum android_line_style line_style;
+
+ /* The line width. */
+ int line_width;
+
+ /* Offset in pixels into the dash pattern specified below. */
+ int dash_offset;
+
+ /* The segments of an even/odd dash pattern. */
+ int *dashes, n_segments;
};
enum android_swap_action
@@ -675,6 +712,7 @@ extern void android_set_clip_rectangles (struct android_gc
*,
int, int,
struct android_rectangle *,
int);
+extern void android_set_dashes (struct android_gc *, int, int *, int);
extern void android_change_gc (struct android_gc *,
enum android_gc_value_mask,
struct android_gc_values *);
diff --git a/src/androidmenu.c b/src/androidmenu.c
index 362d500ac1a..7d24087fa87 100644
--- a/src/androidmenu.c
+++ b/src/androidmenu.c
@@ -488,8 +488,7 @@ android_menu_show (struct frame *f, int x, int y, int
menuflags,
unbind_to (count1, Qnil);
/* Now, display the context menu. */
- window = android_resolve_handle (FRAME_ANDROID_WINDOW (f),
- ANDROID_HANDLE_WINDOW);
+ window = android_resolve_handle (FRAME_ANDROID_WINDOW (f));
rc = (*env)->CallNonvirtualBooleanMethod (env, context_menu,
menu_class.class,
menu_class.display,
diff --git a/src/androidselect.c b/src/androidselect.c
index 2f6114d0fcb..50982738743 100644
--- a/src/androidselect.c
+++ b/src/androidselect.c
@@ -21,6 +21,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <assert.h>
#include <minmax.h>
#include <unistd.h>
+#include <dlfcn.h>
#include <boot-time.h>
#include <sys/types.h>
@@ -93,14 +94,15 @@ android_init_emacs_clipboard (void)
name, signature); \
eassert (clipboard_class.c_name);
- FIND_METHOD (set_clipboard, "setClipboard", "([B)V");
+ FIND_METHOD (set_clipboard, "setClipboard", "(Ljava/lang/String;)V");
FIND_METHOD (owns_clipboard, "ownsClipboard", "()I");
FIND_METHOD (clipboard_exists, "clipboardExists", "()Z");
- FIND_METHOD (get_clipboard, "getClipboard", "()[B");
+ FIND_METHOD (get_clipboard, "getClipboard", "()Ljava/lang/String;");
FIND_METHOD (get_clipboard_targets, "getClipboardTargets",
- "()[[B");
+ "()[Ljava/lang/String;");
FIND_METHOD (get_clipboard_data, "getClipboardData",
- "([B)[J");
+ "(Ljava/lang/String;)Landroid/content/res/"
+ "AssetFileDescriptor;");
clipboard_class.make_clipboard
= (*android_java_env)->GetStaticMethodID (android_java_env,
@@ -149,28 +151,26 @@ DEFUN ("android-set-clipboard", Fandroid_set_clipboard,
doc: /* Set the clipboard text to STRING. */)
(Lisp_Object string)
{
- jarray bytes;
+ jstring text;
if (!android_init_gui)
error ("Accessing clipboard without display connection");
CHECK_STRING (string);
- string = ENCODE_UTF_8 (string);
+ string = code_convert_string_norecord (string, Qandroid_jni,
+ true);
- bytes = (*android_java_env)->NewByteArray (android_java_env,
- SBYTES (string));
+ text = (*android_java_env)->NewStringUTF (android_java_env,
+ SSDATA (string));
android_exception_check ();
- (*android_java_env)->SetByteArrayRegion (android_java_env, bytes,
- 0, SBYTES (string),
- (jbyte *) SDATA (string));
(*android_java_env)->CallVoidMethod (android_java_env,
clipboard,
clipboard_class.set_clipboard,
- bytes);
- android_exception_check_1 (bytes);
+ text);
+ android_exception_check_1 (text);
+ ANDROID_DELETE_LOCAL_REF (text);
- ANDROID_DELETE_LOCAL_REF (bytes);
return Qnil;
}
@@ -183,39 +183,39 @@ Alternatively, return nil if the clipboard is empty. */)
(void)
{
Lisp_Object string;
- jarray bytes;
+ jstring text;
jmethodID method;
- size_t length;
- jbyte *data;
+ jsize length;
+ const char *data;
if (!android_init_gui)
error ("No Android display connection!");
method = clipboard_class.get_clipboard;
- bytes
+ text
= (*android_java_env)->CallObjectMethod (android_java_env,
clipboard,
method);
android_exception_check ();
- if (!bytes)
+ if (!text)
return Qnil;
- length = (*android_java_env)->GetArrayLength (android_java_env,
- bytes);
- data = (*android_java_env)->GetByteArrayElements (android_java_env,
- bytes, NULL);
- android_exception_check_nonnull (data, bytes);
-
- string = make_unibyte_string ((char *) data, length);
+ /* Retrieve a pointer to the raw JNI-encoded bytes of the string. */
+ length = (*android_java_env)->GetStringUTFLength (android_java_env,
+ text);
+ data = (*android_java_env)->GetStringUTFChars (android_java_env, text,
+ NULL);
+ android_exception_check_nonnull ((void *) data, text);
- (*android_java_env)->ReleaseByteArrayElements (android_java_env,
- bytes, data,
- JNI_ABORT);
- ANDROID_DELETE_LOCAL_REF (bytes);
+ /* Copy them into a unibyte string for decoding. */
+ string = make_unibyte_string (data, length);
+ (*android_java_env)->ReleaseStringUTFChars (android_java_env, text,
+ data);
+ ANDROID_DELETE_LOCAL_REF (text);
/* Now decode the resulting string. */
- return code_convert_string_norecord (string, Qutf_8, false);
+ return code_convert_string_norecord (string, Qandroid_jni, false);
}
DEFUN ("android-clipboard-exists-p", Fandroid_clipboard_exists_p,
@@ -282,11 +282,11 @@ Value is a list of MIME types as strings, each defining a
single extra
data type available from the clipboard. */)
(void)
{
- jarray bytes_array;
- jbyteArray bytes;
+ jarray all_targets;
+ jstring string;
jmethodID method;
- size_t length, length1, i;
- jbyte *data;
+ size_t length, i;
+ const char *data;
Lisp_Object targets, tem;
if (!android_init_gui)
@@ -295,44 +295,42 @@ data type available from the clipboard. */)
targets = Qnil;
block_input ();
method = clipboard_class.get_clipboard_targets;
- bytes_array = (*android_java_env)->CallObjectMethod (android_java_env,
+ all_targets = (*android_java_env)->CallObjectMethod (android_java_env,
clipboard, method);
android_exception_check ();
- if (!bytes_array)
+ if (!all_targets)
goto fail;
length = (*android_java_env)->GetArrayLength (android_java_env,
- bytes_array);
+ all_targets);
for (i = 0; i < length; ++i)
{
/* Retrieve the MIME type. */
- bytes
+ string
= (*android_java_env)->GetObjectArrayElement (android_java_env,
- bytes_array, i);
- android_exception_check_nonnull (bytes, bytes_array);
+ all_targets, i);
+ android_exception_check_nonnull (string, all_targets);
/* Cons it onto the list of targets. */
- length1 = (*android_java_env)->GetArrayLength (android_java_env,
- bytes);
- data = (*android_java_env)->GetByteArrayElements (android_java_env,
- bytes, NULL);
- android_exception_check_nonnull_1 (data, bytes, bytes_array);
+ data = (*android_java_env)->GetStringUTFChars (android_java_env,
+ string, NULL);
+ android_exception_check_nonnull_1 ((void *) data, string,
+ all_targets);
/* Decode the string. */
- tem = make_unibyte_string ((char *) data, length1);
- tem = code_convert_string_norecord (tem, Qutf_8, false);
+ tem = build_unibyte_string ((char *) data);
+ tem = code_convert_string_norecord (tem, Qandroid_jni, false);
targets = Fcons (tem, targets);
/* Delete the retrieved data. */
- (*android_java_env)->ReleaseByteArrayElements (android_java_env,
- bytes, data,
- JNI_ABORT);
- ANDROID_DELETE_LOCAL_REF (bytes);
+ (*android_java_env)->ReleaseStringUTFChars (android_java_env,
+ string, data);
+ ANDROID_DELETE_LOCAL_REF (string);
}
unblock_input ();
- ANDROID_DELETE_LOCAL_REF (bytes_array);
+ ANDROID_DELETE_LOCAL_REF (all_targets);
return Fnreverse (targets);
fail:
@@ -340,6 +338,62 @@ data type available from the clipboard. */)
return Qnil;
}
+
+
+struct android_asset_file_descriptor
+{
+ jclass class;
+ jmethodID close;
+ jmethodID get_length;
+ jmethodID get_start_offset;
+ jmethodID get_file_descriptor;
+ jmethodID get_parcel_file_descriptor;
+ jmethodID get_fd;
+};
+
+/* Methods associated with the AssetFileDescriptor class. */
+static struct android_asset_file_descriptor asset_fd_class;
+
+/* Initialize virtual function IDs and class pointers in connection with
+ the AssetFileDescriptor class. */
+
+static void
+android_init_asset_file_descriptor (void)
+{
+ jclass old;
+
+ asset_fd_class.class
+ = (*android_java_env)->FindClass (android_java_env,
+ "android/content/res/"
+ "AssetFileDescriptor");
+ eassert (asset_fd_class.class);
+
+ old = asset_fd_class.class;
+ asset_fd_class.class
+ = (jclass) (*android_java_env)->NewGlobalRef (android_java_env,
+ old);
+ ANDROID_DELETE_LOCAL_REF (old);
+
+ if (!asset_fd_class.class)
+ emacs_abort ();
+
+#define FIND_METHOD(c_name, name, signature) \
+ asset_fd_class.c_name \
+ = (*android_java_env)->GetMethodID (android_java_env, \
+ asset_fd_class.class, \
+ name, signature); \
+ eassert (asset_fd_class.c_name);
+
+ FIND_METHOD (close, "close", "()V");
+ FIND_METHOD (get_length, "getLength", "()J");
+ FIND_METHOD (get_start_offset, "getStartOffset", "()J");
+ FIND_METHOD (get_file_descriptor, "getFileDescriptor",
+ "()Ljava/io/FileDescriptor;");
+ FIND_METHOD (get_parcel_file_descriptor, "getParcelFileDescriptor",
+ "()Landroid/os/ParcelFileDescriptor;");
+#undef FIND_METHOD
+}
+
/* Free the memory inside PTR, a pointer to a char pointer. */
static void
@@ -348,6 +402,125 @@ android_xfree_inside (void *ptr)
xfree (*(char **) ptr);
}
+/* Close the referent of, then delete, the local reference to an asset
+ file descriptor referenced by AFD. */
+
+static void
+close_asset_fd (void *afd)
+{
+ jobject *afd_1;
+
+ afd_1 = afd;
+ (*android_java_env)->CallVoidMethod (android_java_env, *afd_1,
+ asset_fd_class.close);
+ (*android_java_env)->ExceptionClear (android_java_env);
+ ANDROID_DELETE_LOCAL_REF (*afd_1);
+}
+
+/* Return the offset, file descriptor and length of the data contained
+ in the asset file descriptor AFD, in *FD, *OFFSET, and *LENGTH.
+ Value is 0 upon success, 1 otherwise. */
+
+static int
+extract_fd_offsets (jobject afd, int *fd, jlong *offset, jlong *length)
+{
+ jobject java_fd;
+ void *handle;
+#if __ANDROID_API__ <= 11
+ static int (*jniGetFDFromFileDescriptor) (JNIEnv *, jobject);
+#endif /* __ANDROID_API__ <= 11 */
+ static int (*AFileDescriptor_getFd) (JNIEnv *, jobject);
+ jmethodID method;
+
+ method = asset_fd_class.get_start_offset;
+ *offset = (*android_java_env)->CallLongMethod (android_java_env,
+ afd, method);
+ android_exception_check ();
+ method = asset_fd_class.get_length;
+ *length = (*android_java_env)->CallLongMethod (android_java_env,
+ afd, method);
+ android_exception_check ();
+
+#if __ANDROID_API__ <= 11
+ if (android_get_current_api_level () <= 11)
+ {
+ /* Load libnativehelper and link to a private interface that is
+ the only means of retrieving the file descriptor from an asset
+ file descriptor on these systems. */
+
+ if (!jniGetFDFromFileDescriptor)
+ {
+ handle = dlopen ("libnativehelper.so",
+ RTLD_LAZY | RTLD_GLOBAL);
+ if (!handle)
+ goto failure;
+ jniGetFDFromFileDescriptor = dlsym (handle,
+ "jniGetFDFromFileDescriptor");
+ if (!jniGetFDFromFileDescriptor)
+ goto failure;
+ }
+
+ method = asset_fd_class.get_file_descriptor;
+ java_fd = (*android_java_env)->CallObjectMethod (android_java_env,
+ afd, method);
+ android_exception_check ();
+ *fd = (*jniGetFDFromFileDescriptor) (android_java_env, java_fd);
+ ANDROID_DELETE_LOCAL_REF (java_fd);
+
+ if (*fd >= 0)
+ return 0;
+ }
+ else
+#endif /* __ANDROID_API__ <= 11 */
+#if __ANDROID_API__ <= 30
+ if (android_get_current_api_level () <= 30)
+ {
+ /* Convert this AssetFileDescriptor into a ParcelFileDescriptor,
+ whose getFd method will return its native file descriptor. */
+ method = asset_fd_class.get_parcel_file_descriptor;
+ java_fd = (*android_java_env)->CallObjectMethod (android_java_env,
+ afd, method);
+ android_exception_check ();
+
+ /* Initialize fd_class if not already complete. */
+ android_init_fd_class (android_java_env);
+ *fd = (*android_java_env)->CallIntMethod (android_java_env,
+ java_fd,
+ fd_class.get_fd);
+ if (*fd >= 0)
+ return 0;
+ }
+ else
+#endif /* __ANDROID_API__ <= 30 */
+ {
+ /* Load libnativehelper (now a public interface) and link to
+ AFileDescriptor_getFd. */
+ if (!AFileDescriptor_getFd)
+ {
+ handle = dlopen ("libnativehelper.so",
+ RTLD_LAZY | RTLD_GLOBAL);
+ if (!handle)
+ goto failure;
+ AFileDescriptor_getFd = dlsym (handle, "AFileDescriptor_getFd");
+ if (!AFileDescriptor_getFd)
+ goto failure;
+ }
+
+ method = asset_fd_class.get_file_descriptor;
+ java_fd = (*android_java_env)->CallObjectMethod (android_java_env,
+ afd, method);
+ android_exception_check ();
+ *fd = (*AFileDescriptor_getFd) (android_java_env, java_fd);
+ ANDROID_DELETE_LOCAL_REF (java_fd);
+
+ if (*fd >= 0)
+ return 0;
+ }
+
+ failure:
+ return 1;
+}
+
DEFUN ("android-get-clipboard-data", Fandroid_get_clipboard_data,
Sandroid_get_clipboard_data, 1, 1, 0,
doc: /* Return the clipboard data of the given MIME TYPE.
@@ -361,62 +534,46 @@ does not have any corresponding data. In that case, use
`android-get-clipboard' instead. */)
(Lisp_Object type)
{
- jlongArray array;
- jbyteArray bytes;
+ jobject afd;
+ jstring mime_type;
jmethodID method;
int fd;
ptrdiff_t rc;
- jlong offset, length, *longs;
+ jlong offset, length;
specpdl_ref ref;
char *buffer, *start;
if (!android_init_gui)
error ("No Android display connection!");
- /* Encode the string as UTF-8. */
CHECK_STRING (type);
- type = ENCODE_UTF_8 (type);
- /* Then give it to the selection code. */
+ /* Convert TYPE into a Java string. */
block_input ();
- bytes = (*android_java_env)->NewByteArray (android_java_env,
- SBYTES (type));
- (*android_java_env)->SetByteArrayRegion (android_java_env, bytes,
- 0, SBYTES (type),
- (jbyte *) SDATA (type));
- android_exception_check ();
-
+ mime_type = android_build_string (type, NULL);
method = clipboard_class.get_clipboard_data;
- array = (*android_java_env)->CallObjectMethod (android_java_env,
- clipboard, method,
- bytes);
- android_exception_check_1 (bytes);
- ANDROID_DELETE_LOCAL_REF (bytes);
+ afd = (*android_java_env)->CallObjectMethod (android_java_env,
+ clipboard, method,
+ mime_type);
+ android_exception_check_1 (mime_type);
+ ANDROID_DELETE_LOCAL_REF (mime_type);
- if (!array)
+ if (!afd)
goto fail;
- longs = (*android_java_env)->GetLongArrayElements (android_java_env,
- array, NULL);
- android_exception_check_nonnull (longs, array);
-
- /* longs[0] is the file descriptor.
- longs[1] is an offset to apply to the file.
- longs[2] is either -1, or the number of bytes to read from the
- file. */
- fd = longs[0];
- offset = longs[1];
- length = longs[2];
-
- (*android_java_env)->ReleaseLongArrayElements (android_java_env,
- array, longs,
- JNI_ABORT);
- ANDROID_DELETE_LOCAL_REF (array);
+ /* Extract the file descriptor from the AssetFileDescriptor
+ object. */
+ ref = SPECPDL_INDEX ();
+ record_unwind_protect_ptr (close_asset_fd, &afd);
+
+ if (extract_fd_offsets (afd, &fd, &offset, &length))
+ {
+ unblock_input ();
+ return unbind_to (ref, Qnil);
+ }
unblock_input ();
- /* Now begin reading from longs[0]. */
- ref = SPECPDL_INDEX ();
- record_unwind_protect_int (close_file_unwind, fd);
+ /* Now begin reading from fd. */
if (length != -1)
{
@@ -1004,6 +1161,7 @@ init_androidselect (void)
return;
android_init_emacs_clipboard ();
+ android_init_asset_file_descriptor ();
android_init_emacs_desktop_notification ();
make_clipboard = clipboard_class.make_clipboard;
diff --git a/src/androidterm.c b/src/androidterm.c
index c920375fdbe..94a115a66a6 100644
--- a/src/androidterm.c
+++ b/src/androidterm.c
@@ -151,14 +151,8 @@ android_flash (struct frame *f)
fd_set fds;
block_input ();
-
- values.function = ANDROID_GC_XOR;
- values.foreground = (FRAME_FOREGROUND_PIXEL (f)
- ^ FRAME_BACKGROUND_PIXEL (f));
-
- gc = android_create_gc ((ANDROID_GC_FUNCTION
- | ANDROID_GC_FOREGROUND),
- &values);
+ values.function = ANDROID_GC_INVERT;
+ gc = android_create_gc (ANDROID_GC_FUNCTION, &values);
/* Get the height not including a menu bar widget. */
int height = FRAME_PIXEL_HEIGHT (f);
@@ -1964,10 +1958,33 @@ android_parse_color (struct frame *f, const char
*color_name,
bool
android_alloc_nearest_color (struct frame *f, Emacs_Color *color)
{
+ unsigned int ntsc;
+
gamma_correct (f, color);
- color->pixel = RGB_TO_ULONG (color->red / 256,
- color->green / 256,
- color->blue / 256);
+
+ if (FRAME_DISPLAY_INFO (f)->n_planes == 1)
+ {
+ /* Black and white. I think this is the luminance formula applied
+ by the X server on generic monochrome framebuffers. */
+ color->pixel = ((((30l * color->red
+ + 59l * color->green
+ + 11l * color->blue) >> 8)
+ >= (((1 << 8) -1) * 50))
+ ? 0xffffff : 0);
+ }
+ else if (FRAME_DISPLAY_INFO (f)->n_planes <= 8)
+ {
+ /* 256 grays. */
+ ntsc = min (255, ((color->red * 0.299
+ + color->green * 0.587
+ + color->blue * 0.114)
+ / 256));
+ color->pixel = RGB_TO_ULONG (ntsc, ntsc, ntsc);
+ }
+ else
+ color->pixel = RGB_TO_ULONG (color->red / 256,
+ color->green / 256,
+ color->blue / 256);
return true;
}
@@ -1980,8 +1997,8 @@ android_query_colors (struct frame *f, Emacs_Color
*colors, int ncolors)
for (i = 0; i < ncolors; ++i)
{
colors[i].red = RED_FROM_ULONG (colors[i].pixel) * 257;
- colors[i].green = RED_FROM_ULONG (colors[i].pixel) * 257;
- colors[i].blue = RED_FROM_ULONG (colors[i].pixel) * 257;
+ colors[i].green = GREEN_FROM_ULONG (colors[i].pixel) * 257;
+ colors[i].blue = BLUE_FROM_ULONG (colors[i].pixel) * 257;
}
}
@@ -2630,7 +2647,7 @@ android_draw_fringe_bitmap (struct window *w, struct
glyph_row *row,
clipmask = ANDROID_NONE;
background = face->background;
cursor_pixel = f->output_data.android->cursor_pixel;
- depth = FRAME_DISPLAY_INFO (f)->n_planes;
+ depth = FRAME_DISPLAY_INFO (f)->n_image_planes;
/* Intersect the destination rectangle with that of the row.
Setting a clip mask overrides the clip rectangles provided by
@@ -3717,19 +3734,15 @@ static void
android_get_scale_factor (int *scale_x, int *scale_y)
{
/* This is 96 everywhere else, but 160 on Android. */
- const int base_res = 160;
- struct android_display_info *dpyinfo;
+ int base_res = 160;
- dpyinfo = x_display_list;
*scale_x = *scale_y = 1;
+ eassert (x_display_list);
- if (dpyinfo)
- {
- if (dpyinfo->resx > base_res)
- *scale_x = floor (dpyinfo->resx / base_res);
- if (dpyinfo->resy > base_res)
- *scale_y = floor (dpyinfo->resy / base_res);
- }
+ if (x_display_list->resx > base_res)
+ *scale_x = floor (x_display_list->resx / base_res);
+ if (x_display_list->resy > base_res)
+ *scale_y = floor (x_display_list->resy / base_res);
}
static void
@@ -4012,6 +4025,80 @@ android_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
s->char2b = NULL;
}
+/* Draw a dashed underline of thickness THICKNESS and width WIDTH onto F
+ at a vertical offset of OFFSET from the position of the glyph string
+ S, with each segment SEGMENT pixels in length. */
+
+static void
+android_draw_dash (struct frame *f, struct glyph_string *s, int width,
+ int segment, int offset, int thickness)
+{
+ struct android_gc *gc;
+ struct android_gc_values gcv;
+ int y_center;
+
+ /* Configure the GC, the dash pattern and a suitable offset. */
+ gc = s->gc;
+
+ gcv.line_style = ANDROID_LINE_ON_OFF_DASH;
+ gcv.line_width = thickness;
+ android_change_gc (s->gc, (ANDROID_GC_LINE_STYLE
+ | ANDROID_GC_LINE_WIDTH), &gcv);
+ android_set_dashes (s->gc, s->x, &segment, 1);
+
+ /* Offset the origin of the line by half the line width. */
+ y_center = s->ybase + offset + thickness / 2;
+ android_draw_line (FRAME_ANDROID_WINDOW (f), gc,
+ s->x, y_center, s->x + width, y_center);
+
+ /* Restore the initial line style. */
+ gcv.line_style = ANDROID_LINE_SOLID;
+ gcv.line_width = 1;
+ android_change_gc (s->gc, (ANDROID_GC_LINE_STYLE
+ | ANDROID_GC_LINE_WIDTH), &gcv);
+}
+
+/* Draw an underline of STYLE onto F at an offset of POSITION from the
+ baseline of the glyph string S, DECORATION_WIDTH in length, and
+ THICKNESS in height. */
+
+static void
+android_fill_underline (struct frame *f, struct glyph_string *s,
+ enum face_underline_type style, int position,
+ int decoration_width, int thickness)
+{
+ int segment;
+
+ segment = thickness * 3;
+
+ switch (style)
+ {
+ /* FACE_UNDERLINE_DOUBLE_LINE is treated identically to SINGLE, as
+ the second line will be filled by another invocation of this
+ function. */
+ case FACE_UNDERLINE_SINGLE:
+ case FACE_UNDERLINE_DOUBLE_LINE:
+ android_fill_rectangle (FRAME_ANDROID_DRAWABLE (f),
+ s->gc, s->x, s->ybase + position,
+ decoration_width, thickness);
+ break;
+
+ case FACE_UNDERLINE_DOTS:
+ segment = thickness;
+ FALLTHROUGH;
+
+ case FACE_UNDERLINE_DASHES:
+ android_draw_dash (f, s, decoration_width, segment, position,
+ thickness);
+ break;
+
+ case FACE_NO_UNDERLINE:
+ case FACE_UNDERLINE_WAVE:
+ default:
+ emacs_abort ();
+ }
+}
+
static void
android_draw_glyph_string (struct glyph_string *s)
{
@@ -4135,7 +4222,7 @@ android_draw_glyph_string (struct glyph_string *s)
/* Draw underline. */
if (s->face->underline)
{
- if (s->face->underline == FACE_UNDER_WAVE)
+ if (s->face->underline == FACE_UNDERLINE_WAVE)
{
if (s->face->underline_defaulted_p)
android_draw_underwave (s, decoration_width);
@@ -4148,13 +4235,13 @@ android_draw_glyph_string (struct glyph_string *s)
android_set_foreground (s->gc, xgcv.foreground);
}
}
- else if (s->face->underline == FACE_UNDER_LINE)
+ else if (s->face->underline >= FACE_UNDERLINE_SINGLE)
{
unsigned long thickness, position;
- int y;
if (s->prev
- && s->prev->face->underline == FACE_UNDER_LINE
+ && (s->prev->face->underline != FACE_UNDERLINE_WAVE
+ && s->prev->face->underline >= FACE_UNDERLINE_SINGLE)
&& (s->prev->face->underline_at_descent_line_p
== s->face->underline_at_descent_line_p)
&& (s->prev->face->underline_pixels_above_descent_line
@@ -4231,19 +4318,35 @@ android_draw_glyph_string (struct glyph_string *s)
thickness = (s->y + s->height) - (s->ybase + position);
s->underline_thickness = thickness;
s->underline_position = position;
- y = s->ybase + position;
- if (s->face->underline_defaulted_p)
- android_fill_rectangle (FRAME_ANDROID_DRAWABLE (s->f), s->gc,
- s->x, y, decoration_width, thickness);
- else
- {
- struct android_gc_values xgcv;
- android_get_gc_values (s->gc, ANDROID_GC_FOREGROUND, &xgcv);
- android_set_foreground (s->gc, s->face->underline_color);
- android_fill_rectangle (FRAME_ANDROID_DRAWABLE (s->f), s->gc,
- s->x, y, decoration_width, thickness);
- android_set_foreground (s->gc, xgcv.foreground);
- }
+
+ {
+ struct android_gc_values xgcv;
+
+ if (!s->face->underline_defaulted_p)
+ {
+ android_get_gc_values (s->gc, ANDROID_GC_FOREGROUND, &xgcv);
+ android_set_foreground (s->gc, s->face->underline_color);
+ }
+
+ android_fill_underline (s->f, s, s->face->underline,
+ position, decoration_width,
+ thickness);
+
+ /* Place a second underline above the first if this was
+ requested in the face specification. */
+
+ if (s->face->underline == FACE_UNDERLINE_DOUBLE_LINE)
+ {
+ /* Compute the position of the second underline. */
+ position = position - thickness - 1;
+ android_fill_underline (s->f, s, s->face->underline,
+ position, decoration_width,
+ thickness);
+ }
+
+ if (!s->face->underline_defaulted_p)
+ android_set_foreground (s->gc, xgcv.foreground);
+ }
}
}
/* Draw overline. */
@@ -4822,7 +4925,7 @@ android_copy_java_string (JNIEnv *env, jstring string,
size_t *length)
}
JNIEXPORT void JNICALL
-NATIVE_NAME (beginBatchEdit) (JNIEnv *env, jobject object, jshort window)
+NATIVE_NAME (beginBatchEdit) (JNIEnv *env, jobject object, jlong window)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -4843,7 +4946,7 @@ NATIVE_NAME (beginBatchEdit) (JNIEnv *env, jobject
object, jshort window)
}
JNIEXPORT void JNICALL
-NATIVE_NAME (endBatchEdit) (JNIEnv *env, jobject object, jshort window)
+NATIVE_NAME (endBatchEdit) (JNIEnv *env, jobject object, jlong window)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -4864,7 +4967,7 @@ NATIVE_NAME (endBatchEdit) (JNIEnv *env, jobject object,
jshort window)
}
JNIEXPORT void JNICALL
-NATIVE_NAME (commitCompletion) (JNIEnv *env, jobject object, jshort window,
+NATIVE_NAME (commitCompletion) (JNIEnv *env, jobject object, jlong window,
jstring completion_text, jint position)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -4898,7 +5001,7 @@ NATIVE_NAME (commitCompletion) (JNIEnv *env, jobject
object, jshort window,
}
JNIEXPORT void JNICALL
-NATIVE_NAME (commitText) (JNIEnv *env, jobject object, jshort window,
+NATIVE_NAME (commitText) (JNIEnv *env, jobject object, jlong window,
jstring commit_text, jint position)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -4933,7 +5036,7 @@ NATIVE_NAME (commitText) (JNIEnv *env, jobject object,
jshort window,
JNIEXPORT void JNICALL
NATIVE_NAME (deleteSurroundingText) (JNIEnv *env, jobject object,
- jshort window, jint left_length,
+ jlong window, jint left_length,
jint right_length)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -4956,7 +5059,7 @@ NATIVE_NAME (deleteSurroundingText) (JNIEnv *env, jobject
object,
JNIEXPORT void JNICALL
NATIVE_NAME (finishComposingText) (JNIEnv *env, jobject object,
- jshort window)
+ jlong window)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -4977,7 +5080,7 @@ NATIVE_NAME (finishComposingText) (JNIEnv *env, jobject
object,
}
JNIEXPORT void JNICALL
-NATIVE_NAME (replaceText) (JNIEnv *env, jobject object, jshort window,
+NATIVE_NAME (replaceText) (JNIEnv *env, jobject object, jlong window,
jint start, jint end, jobject text,
int new_cursor_position, jobject attribute)
{
@@ -5143,7 +5246,7 @@ android_text_to_string (JNIEnv *env, char *buffer,
ptrdiff_t n,
}
JNIEXPORT jstring JNICALL
-NATIVE_NAME (getTextAfterCursor) (JNIEnv *env, jobject object, jshort window,
+NATIVE_NAME (getTextAfterCursor) (JNIEnv *env, jobject object, jlong window,
jint length, jint flags)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -5187,7 +5290,7 @@ NATIVE_NAME (getTextAfterCursor) (JNIEnv *env, jobject
object, jshort window,
}
JNIEXPORT jstring JNICALL
-NATIVE_NAME (getTextBeforeCursor) (JNIEnv *env, jobject object, jshort window,
+NATIVE_NAME (getTextBeforeCursor) (JNIEnv *env, jobject object, jlong window,
jint length, jint flags)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -5231,7 +5334,7 @@ NATIVE_NAME (getTextBeforeCursor) (JNIEnv *env, jobject
object, jshort window,
}
JNIEXPORT void JNICALL
-NATIVE_NAME (setComposingText) (JNIEnv *env, jobject object, jshort window,
+NATIVE_NAME (setComposingText) (JNIEnv *env, jobject object, jlong window,
jstring composing_text,
jint new_cursor_position)
{
@@ -5266,7 +5369,7 @@ NATIVE_NAME (setComposingText) (JNIEnv *env, jobject
object, jshort window,
}
JNIEXPORT void JNICALL
-NATIVE_NAME (setComposingRegion) (JNIEnv *env, jobject object, jshort window,
+NATIVE_NAME (setComposingRegion) (JNIEnv *env, jobject object, jlong window,
jint start, jint end)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -5288,7 +5391,7 @@ NATIVE_NAME (setComposingRegion) (JNIEnv *env, jobject
object, jshort window,
}
JNIEXPORT void JNICALL
-NATIVE_NAME (setSelection) (JNIEnv *env, jobject object, jshort window,
+NATIVE_NAME (setSelection) (JNIEnv *env, jobject object, jlong window,
jint start, jint end)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -5366,7 +5469,7 @@ android_get_selection (void *data)
}
JNIEXPORT jintArray JNICALL
-NATIVE_NAME (getSelection) (JNIEnv *env, jobject object, jshort window)
+NATIVE_NAME (getSelection) (JNIEnv *env, jobject object, jlong window)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -5405,7 +5508,7 @@ NATIVE_NAME (getSelection) (JNIEnv *env, jobject object,
jshort window)
JNIEXPORT void JNICALL
NATIVE_NAME (performEditorAction) (JNIEnv *env, jobject object,
- jshort window, int action)
+ jlong window, int action)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -5457,7 +5560,7 @@ NATIVE_NAME (performEditorAction) (JNIEnv *env, jobject
object,
JNIEXPORT void JNICALL
NATIVE_NAME (performContextMenuAction) (JNIEnv *env, jobject object,
- jshort window, int action)
+ jlong window, int action)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -5604,10 +5707,10 @@ struct android_extracted_text_class
/* Fields and methods associated with the `ExtractedTextRequest'
class. */
-struct android_extracted_text_request_class request_class;
+static struct android_extracted_text_request_class request_class;
/* Fields and methods associated with the `ExtractedText' class. */
-struct android_extracted_text_class text_class;
+static struct android_extracted_text_class text_class;
/* Return an ExtractedText object corresponding to the extracted text
TEXT. START is a character position describing the offset of the
@@ -5662,7 +5765,7 @@ android_build_extracted_text (jstring text, ptrdiff_t
start,
JNIEXPORT jobject JNICALL
NATIVE_NAME (getExtractedText) (JNIEnv *env, jobject ignored_object,
- jshort window, jobject request,
+ jlong window, jobject request,
jint flags)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -5774,7 +5877,7 @@ NATIVE_NAME (getExtractedText) (JNIEnv *env, jobject
ignored_object,
JNIEXPORT jstring JNICALL
NATIVE_NAME (getSelectedText) (JNIEnv *env, jobject object,
- jshort window)
+ jlong window)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -5804,7 +5907,7 @@ NATIVE_NAME (getSelectedText) (JNIEnv *env, jobject
object,
JNIEXPORT void JNICALL
NATIVE_NAME (requestSelectionUpdate) (JNIEnv *env, jobject object,
- jshort window)
+ jlong window)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -5826,7 +5929,7 @@ NATIVE_NAME (requestSelectionUpdate) (JNIEnv *env,
jobject object,
JNIEXPORT void JNICALL
NATIVE_NAME (requestCursorUpdates) (JNIEnv *env, jobject object,
- jshort window, jint mode)
+ jlong window, jint mode)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -5855,7 +5958,7 @@ NATIVE_NAME (requestCursorUpdates) (JNIEnv *env, jobject
object,
JNIEXPORT void JNICALL
NATIVE_NAME (clearInputFlags) (JNIEnv *env, jobject object,
- jshort window)
+ jlong window)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -5970,7 +6073,7 @@ android_get_surrounding_text (void *data)
Value is the object upon success, else NULL. */
static jobject
-android_get_surrounding_text_internal (JNIEnv *env, jshort window,
+android_get_surrounding_text_internal (JNIEnv *env, jlong window,
jint before_length,
jint after_length,
ptrdiff_t *conversion_start,
@@ -6063,7 +6166,7 @@ android_get_surrounding_text_internal (JNIEnv *env,
jshort window,
JNIEXPORT jobject JNICALL
NATIVE_NAME (getSurroundingText) (JNIEnv *env, jobject object,
- jshort window, jint before_length,
+ jlong window, jint before_length,
jint after_length, jint flags)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -6073,7 +6176,7 @@ NATIVE_NAME (getSurroundingText) (JNIEnv *env, jobject
object,
}
JNIEXPORT jobject JNICALL
-NATIVE_NAME (takeSnapshot) (JNIEnv *env, jobject object, jshort window)
+NATIVE_NAME (takeSnapshot) (JNIEnv *env, jobject object, jlong window)
{
JNI_STACK_ALIGNMENT_PROLOGUE;
@@ -6156,14 +6259,24 @@ android_update_selection (struct frame *f, struct
window *w)
jobject extracted;
jstring string;
bool mark_active;
+ ptrdiff_t field_start, field_end;
+
+ /* Offset these values by the start offset of the field. */
+ get_conversion_field (f, &field_start, &field_end);
if (MARKERP (f->conversion.compose_region_start))
{
eassert (MARKERP (f->conversion.compose_region_end));
/* Indexing in android starts from 0 instead of 1. */
- start = marker_position (f->conversion.compose_region_start) - 1;
- end = marker_position (f->conversion.compose_region_end) - 1;
+ start = marker_position (f->conversion.compose_region_start);
+ end = marker_position (f->conversion.compose_region_end);
+
+ /* Offset and detect underflow. */
+ start = max (start, field_start) - field_start;
+ end = min (end, field_end) - field_start;
+ if (end < 0 || start < 0)
+ end = start = -1;
}
else
start = -1, end = -1;
@@ -6179,24 +6292,27 @@ android_update_selection (struct frame *f, struct
window *w)
/* Figure out where the point and mark are. If the mark is not
active, then point is set to equal mark. */
b = XBUFFER (w->contents);
- point = min (w->ephemeral_last_point,
+ point = min (min (max (w->ephemeral_last_point,
+ field_start),
+ field_end) - field_start,
TYPE_MAXIMUM (jint));
mark = ((!NILP (BVAR (b, mark_active))
&& w->last_mark != -1)
- ? min (w->last_mark, TYPE_MAXIMUM (jint))
+ ? min (min (max (w->last_mark, field_start),
+ field_end) - field_start,
+ TYPE_MAXIMUM (jint))
: point);
- /* Send the update. Android doesn't employ a concept of ``point''
- and ``mark''; instead, it only has a selection, where the start
- of the selection is less than or equal to the end, and the region
- is ``active'' when those two values differ. Also, convert the
- indices from 1-based Emacs indices to 0-based Android ones. */
- android_update_ic (FRAME_ANDROID_WINDOW (f), min (point, mark) - 1,
- max (point, mark) - 1, start, end);
+ /* Send the update. Android doesn't employ a concept of "point" and
+ "mark"; instead, it only has a selection, where the start of the
+ selection is less than or equal to the end, and the region is
+ "active" when those two values differ. The indices will have been
+ converted from 1-based Emacs indices to 0-based Android ones. */
+ android_update_ic (FRAME_ANDROID_WINDOW (f), min (point, mark),
+ max (point, mark), start, end);
/* Update the extracted text as well, if the input method has asked
- for updates. 1 is
- InputConnection.GET_EXTRACTED_TEXT_MONITOR. */
+ for updates. 1 is InputConnection.GET_EXTRACTED_TEXT_MONITOR. */
if (FRAME_ANDROID_OUTPUT (f)->extracted_text_flags & 1)
{
@@ -6363,8 +6479,6 @@ static struct textconv_interface
text_conversion_interface =
-extern frame_parm_handler android_frame_parm_handlers[];
-
#endif /* !ANDROID_STUBIFY */
static struct redisplay_interface android_redisplay_interface =
@@ -6504,8 +6618,8 @@ android_term_init (void)
terminal = android_create_terminal (dpyinfo);
terminal->kboard = allocate_kboard (Qandroid);
terminal->kboard->reference_count++;
-
dpyinfo->n_planes = 24;
+ dpyinfo->n_image_planes = 24;
/* This function should only be called once at startup. */
eassert (!x_display_list);
@@ -6535,6 +6649,26 @@ android_term_init (void)
terminal->name = xstrdup ("android");
+ {
+ Lisp_Object system_name = Fsystem_name ();
+ static char const title[] = "GNU Emacs";
+ if (STRINGP (system_name))
+ {
+ static char const at[] = " at ";
+ ptrdiff_t nbytes = sizeof (title) + sizeof (at);
+ if (ckd_add (&nbytes, nbytes, SBYTES (system_name)))
+ memory_full (SIZE_MAX);
+ dpyinfo->x_id_name = xmalloc (nbytes);
+ sprintf (dpyinfo->x_id_name, "%s%s%s", title, at,
+ SDATA (system_name));
+ }
+ else
+ {
+ dpyinfo->x_id_name = xmalloc (sizeof (title));
+ strcpy (dpyinfo->x_id_name, title);
+ }
+ }
+
/* The display "connection" is now set up, and it must never go
away. */
terminal->reference_count = 30000;
@@ -6680,6 +6814,22 @@ so it is important to limit the wait.
If set to a non-float value, there will be no wait at all. */);
Vandroid_wait_for_event_timeout = make_float (0.1);
+ DEFVAR_INT ("android-quit-keycode", android_quit_keycode,
+ doc: /* Keycode that signals quit when typed twice in rapid succession.
+
+This is the key code of a key whose repeated activation should prompt
+Emacs to quit, enabling quitting on systems where a keyboard capable of
+typing C-g is unavailable, when set to a key that does exist on the
+device. Its value must be a keycode defined by the operating system,
+and defaults to 25 (KEYCODE_VOLUME_DOWN), though one of the following
+values might be desired on those devices where this default is also
+unavailable, or if another key must otherwise serve this function
+instead:
+
+ - 4 (KEYCODE_BACK)
+ - 24 (KEYCODE_VOLUME_UP) */);
+ android_quit_keycode = 25;
+
DEFVAR_BOOL ("x-use-underline-position-properties",
x_use_underline_position_properties,
doc: /* SKIP: real doc in xterm.c. */);
@@ -6702,6 +6852,17 @@ Emacs is running on. */);
doc: /* Name of the developer of the running version of Android. */);
Vandroid_build_manufacturer = Qnil;
+ DEFVAR_INT ("android-display-planes", android_display_planes,
+ doc: /* Depth and visual class of the display.
+This variable controls the visual class and depth of the display, which
+cannot be detected on Android. The default value of 24, and values from
+there to 8 represent a TrueColor display providing 24 planes, values
+between 8 and 1 StaticGray displays providing that many planes, and 1 or
+lower monochrome displays with a single plane. Modifications to this
+variable must be completed before the window system is initialized, in,
+for instance, `early-init.el', or they will be of no effect. */);
+ android_display_planes = 24;
+
DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym,
doc: /* SKIP: real doc in xterm.c. */);
Vx_ctrl_keysym = Qnil;
diff --git a/src/androidterm.h b/src/androidterm.h
index fd4cc99f641..c8f1ab655a9 100644
--- a/src/androidterm.h
+++ b/src/androidterm.h
@@ -77,8 +77,9 @@ struct android_display_info
/* Mouse highlight information. */
Mouse_HLInfo mouse_highlight;
- /* Number of planes on this screen. Always 24. */
- int n_planes;
+ /* Number of planes on this screen, and the same for the purposes of
+ image processing. */
+ int n_planes, n_image_planes;
/* Mask of things causing the mouse to be grabbed. */
int grabbed;
@@ -89,6 +90,9 @@ struct android_display_info
/* Minimum font height over all fonts in font_table. */
int smallest_font_height;
+ /* Default name for all frames on this display. */
+ char *x_id_name;
+
/* The number of fonts opened for this display. */
int n_fonts;
@@ -391,6 +395,7 @@ extern struct android_display_info *x_display_list;
/* From androidfns.c. */
+extern frame_parm_handler android_frame_parm_handlers[];
extern void android_free_gcs (struct frame *);
extern void android_default_font_parameter (struct frame *, Lisp_Object);
extern void android_set_preeditarea (struct window *, int, int);
diff --git a/src/androidvfs.c b/src/androidvfs.c
index 88ea345a298..c0bd86e54b8 100644
--- a/src/androidvfs.c
+++ b/src/androidvfs.c
@@ -290,17 +290,6 @@ struct emacs_directory_entry_class
jfieldID d_name;
};
-/* Structure describing the android.os.ParcelFileDescriptor class used
- to wrap file descriptors sent over IPC. */
-
-struct android_parcel_file_descriptor_class
-{
- jclass class;
- jmethodID close;
- jmethodID get_fd;
- jmethodID detach_fd;
-};
-
/* The java.lang.String class. */
jclass java_string_class;
@@ -313,7 +302,7 @@ static struct emacs_directory_entry_class entry_class;
/* Fields and methods associated with the ParcelFileDescriptor
class. */
-static struct android_parcel_file_descriptor_class fd_class;
+struct android_parcel_file_descriptor_class fd_class;
/* Global references to several exception classes. */
static jclass file_not_found_exception, security_exception;
@@ -380,13 +369,18 @@ android_init_entry_class (JNIEnv *env)
}
-/* Initialize `fd_class' using the given JNI environment ENV. Calling
- this function is not necessary on Android 4.4 and earlier. */
+/* Initialize `fd_class' using the given JNI environment ENV. Called on
+ API 12 (Android 3.1) and later by androidselect.c and on 5.0 and
+ later in this file. */
-static void
+void
android_init_fd_class (JNIEnv *env)
{
jclass old;
+ static bool fd_class_initialized;
+
+ if (fd_class_initialized)
+ return;
fd_class.class
= (*env)->FindClass (env, "android/os/ParcelFileDescriptor");
@@ -409,6 +403,8 @@ android_init_fd_class (JNIEnv *env)
FIND_METHOD (get_fd, "getFd", "()I");
FIND_METHOD (detach_fd, "detachFd", "()I");
#undef FIND_METHOD
+
+ fd_class_initialized = true;
}
@@ -2817,7 +2813,7 @@ android_content_opendir (struct android_vnode *vnode)
/* Android 4.3 and earlier don't support /content/by-authority. */
if (api < 19)
- dir->next_name++;
+ dir->next_name += 2;
/* Link this stream onto the list of all content directory
streams. */
@@ -3027,6 +3023,104 @@ android_check_content_access (const char *uri, int mode)
+/* Functions shared by authority and SAF nodes. */
+
+/* Check for JNI exceptions, clear them, and set errno accordingly.
+ Also, free each of the N local references given as arguments if an
+ exception takes place.
+
+ Value is 1 if an exception has taken place, 0 otherwise.
+
+ If the exception thrown derives from FileNotFoundException, set
+ errno to ENOENT.
+
+ If the exception thrown derives from SecurityException, set errno
+ to EACCES.
+
+ If the exception thrown derives from OperationCanceledException,
+ set errno to EINTR.
+
+ If the exception thrown derives from UnsupportedOperationException,
+ set errno to ENOSYS.
+
+ If the exception thrown derives from OutOfMemoryException, call
+ `memory_full'.
+
+ If the exception thrown is anything else, set errno to EIO. */
+
+static int
+android_saf_exception_check (int n, ...)
+{
+ jthrowable exception;
+ JNIEnv *env;
+ va_list ap;
+ int new_errno;
+
+ env = android_java_env;
+ va_start (ap, n);
+
+ /* First, check for an exception. */
+
+ if (!(*env)->ExceptionCheck (env))
+ {
+ /* No exception has taken place. Return 0. */
+ va_end (ap);
+ return 0;
+ }
+
+ /* Print the exception. */
+ (*env)->ExceptionDescribe (env);
+
+ exception = (*env)->ExceptionOccurred (env);
+
+ if (!exception)
+ /* JNI couldn't return a local reference to the exception. */
+ memory_full (0);
+
+ /* Clear the exception, making it safe to subsequently call other
+ JNI functions. */
+ (*env)->ExceptionClear (env);
+
+ /* Delete each of the N arguments. */
+
+ while (n > 0)
+ {
+ ANDROID_DELETE_LOCAL_REF (va_arg (ap, jobject));
+ n--;
+ }
+
+ /* Now set errno or signal memory_full as required. */
+
+ if ((*env)->IsInstanceOf (env, (jobject) exception,
+ file_not_found_exception))
+ new_errno = ENOENT;
+ else if ((*env)->IsInstanceOf (env, (jobject) exception,
+ security_exception))
+ new_errno = EACCES;
+ else if ((*env)->IsInstanceOf (env, (jobject) exception,
+ operation_canceled_exception))
+ new_errno = EINTR;
+ else if ((*env)->IsInstanceOf (env, (jobject) exception,
+ unsupported_operation_exception))
+ new_errno = ENOSYS;
+ else if ((*env)->IsInstanceOf (env, (jobject) exception,
+ out_of_memory_error))
+ {
+ ANDROID_DELETE_LOCAL_REF ((jobject) exception);
+ memory_full (0);
+ }
+ else
+ new_errno = EIO;
+
+ /* expression is still a local reference! */
+ ANDROID_DELETE_LOCAL_REF ((jobject) exception);
+ errno = new_errno;
+ va_end (ap);
+ return 1;
+}
+
+
+
/* Content authority-based vnode implementation.
/content/by-authority is a simple vnode implementation that converts
@@ -3130,8 +3224,10 @@ android_authority_name (struct android_vnode *vnode,
char *name,
return NULL;
}
- /* NAME must be a valid JNI string, so that it can be encoded
- properly. */
+ /* If the URI is not a valid JNI string, return immediately. This
+ should not be possible, since /content file names are encoded
+ into JNI strings at the naming stage; the check is performed
+ only out of an abundance of caution. */
if (android_verify_jni_string (name))
goto no_entry;
@@ -3169,7 +3265,6 @@ android_authority_open (struct android_vnode *vnode, int
flags,
AAsset **asset)
{
struct android_authority_vnode *vp;
- size_t length;
jobject string;
int fd;
JNIEnv *env;
@@ -3189,22 +3284,11 @@ android_authority_open (struct android_vnode *vnode,
int flags,
feasible. */
env = android_java_env;
- /* Allocate a buffer to hold the file name. */
- length = strlen (vp->uri);
- string = (*env)->NewByteArray (env, length);
- if (!string)
- {
- (*env)->ExceptionClear (env);
- errno = ENOMEM;
- return -1;
- }
-
- /* Copy the URI into this byte array. */
- (*env)->SetByteArrayRegion (env, string, 0, length,
- (jbyte *) vp->uri);
+ /* Allocate a JNI string to hold VP->uri. */
+ string = (*env)->NewStringUTF (env, vp->uri);
+ android_exception_check ();
/* Try to open the file descriptor. */
-
fd = (*env)->CallNonvirtualIntMethod (env, emacs_service,
service_class.class,
service_class.open_content_uri,
@@ -3215,13 +3299,9 @@ android_authority_open (struct android_vnode *vnode, int
flags,
(jboolean) !(mode & O_WRONLY),
(jboolean) ((mode & O_TRUNC)
!= 0));
- if ((*env)->ExceptionCheck (env))
- {
- (*env)->ExceptionClear (env);
- errno = ENOMEM;
- ANDROID_DELETE_LOCAL_REF (string);
- return -1;
- }
+ if (android_saf_exception_check (1, string))
+ return -1;
+ ANDROID_DELETE_LOCAL_REF (string);
/* If fd is -1, just assume that the file does not exist,
and return -1 with errno set to ENOENT. */
@@ -3229,18 +3309,12 @@ android_authority_open (struct android_vnode *vnode,
int flags,
if (fd == -1)
{
errno = ENOENT;
- goto skip;
+ return -1;
}
if (mode & O_CLOEXEC)
android_close_on_exec (fd);
- skip:
- ANDROID_DELETE_LOCAL_REF (string);
-
- if (fd == -1)
- return -1;
-
*fd_return = fd;
return 0;
}
@@ -3959,7 +4033,7 @@ android_saf_root_opendir (struct android_vnode *vnode)
struct android_saf_root_vnode *vp;
jobjectArray array;
jmethodID method;
- jbyteArray authority;
+ jstring authority;
struct android_saf_root_vdir *dir;
size_t length;
@@ -3969,15 +4043,10 @@ android_saf_root_opendir (struct android_vnode *vnode)
{
/* Build a string containing the authority. */
length = strlen (vp->authority);
- authority = (*android_java_env)->NewByteArray (android_java_env,
- length);
+ authority = (*android_java_env)->NewStringUTF (android_java_env,
+ vp->authority);
android_exception_check ();
- /* Copy the authority name to that byte array. */
- (*android_java_env)->SetByteArrayRegion (android_java_env,
- authority, 0, length,
- (jbyte *) vp->authority);
-
/* Acquire a list of every tree provided by this authority. */
method = service_class.get_document_trees;
@@ -4109,100 +4178,6 @@ android_saf_root_get_directory (int dirfd)
thread. */
static bool inside_saf_critical_section;
-/* Check for JNI exceptions, clear them, and set errno accordingly.
- Also, free each of the N local references given as arguments if an
- exception takes place.
-
- Value is 1 if an exception has taken place, 0 otherwise.
-
- If the exception thrown derives from FileNotFoundException, set
- errno to ENOENT.
-
- If the exception thrown derives from SecurityException, set errno
- to EACCES.
-
- If the exception thrown derives from OperationCanceledException,
- set errno to EINTR.
-
- If the exception thrown derives from UnsupportedOperationException,
- set errno to ENOSYS.
-
- If the exception thrown derives from OutOfMemoryException, call
- `memory_full'.
-
- If the exception thrown is anything else, set errno to EIO. */
-
-static int
-android_saf_exception_check (int n, ...)
-{
- jthrowable exception;
- JNIEnv *env;
- va_list ap;
- int new_errno;
-
- env = android_java_env;
- va_start (ap, n);
-
- /* First, check for an exception. */
-
- if (!(*env)->ExceptionCheck (env))
- {
- /* No exception has taken place. Return 0. */
- va_end (ap);
- return 0;
- }
-
- /* Print the exception. */
- (*env)->ExceptionDescribe (env);
-
- exception = (*env)->ExceptionOccurred (env);
-
- if (!exception)
- /* JNI couldn't return a local reference to the exception. */
- memory_full (0);
-
- /* Clear the exception, making it safe to subsequently call other
- JNI functions. */
- (*env)->ExceptionClear (env);
-
- /* Delete each of the N arguments. */
-
- while (n > 0)
- {
- ANDROID_DELETE_LOCAL_REF (va_arg (ap, jobject));
- n--;
- }
-
- /* Now set errno or signal memory_full as required. */
-
- if ((*env)->IsInstanceOf (env, (jobject) exception,
- file_not_found_exception))
- new_errno = ENOENT;
- else if ((*env)->IsInstanceOf (env, (jobject) exception,
- security_exception))
- new_errno = EACCES;
- else if ((*env)->IsInstanceOf (env, (jobject) exception,
- operation_canceled_exception))
- new_errno = EINTR;
- else if ((*env)->IsInstanceOf (env, (jobject) exception,
- unsupported_operation_exception))
- new_errno = ENOSYS;
- else if ((*env)->IsInstanceOf (env, (jobject) exception,
- out_of_memory_error))
- {
- ANDROID_DELETE_LOCAL_REF ((jobject) exception);
- memory_full (0);
- }
- else
- new_errno = EIO;
-
- /* expression is still a local reference! */
- ANDROID_DELETE_LOCAL_REF ((jobject) exception);
- errno = new_errno;
- va_end (ap);
- return 1;
-}
-
/* Return file status for the document designated by ID_NAME within
the document tree identified by URI_NAME.
@@ -5587,6 +5562,10 @@ android_saf_tree_closedir (struct android_vdir *vdir)
free (dir->name);
/* Yes, DIR->cursor is a local reference. */
+ (*android_java_env)->CallVoidMethod (android_java_env,
+ dir->cursor,
+ cursor_class.close);
+ (*android_java_env)->ExceptionClear (android_java_env);
ANDROID_DELETE_LOCAL_REF (dir->cursor);
/* If the ``directory file descriptor'' has been opened, close
@@ -6586,10 +6565,11 @@ static struct android_special_vnode special_vnodes[] =
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. */
+ `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 adverse
+ consequences affecting files stored on different filesystems,
+ including virtual ones. */
static Lisp_Object
android_vfs_convert_name (const char *name, Lisp_Object coding)
@@ -6903,15 +6883,9 @@ android_vfs_init (JNIEnv *env, jobject manager)
eassert (java_string_class);
(*env)->DeleteLocalRef (env, old);
- /* And initialize those used on Android 5.0 and later. */
-
- if (android_get_current_api_level () < 21)
+ if (android_get_current_api_level () < 19)
return;
- android_init_cursor_class (env);
- android_init_entry_class (env);
- android_init_fd_class (env);
-
/* Initialize each of the exception classes used by
`android_saf_exception_check'. */
@@ -6940,6 +6914,15 @@ android_vfs_init (JNIEnv *env, jobject manager)
(*env)->DeleteLocalRef (env, old);
eassert (out_of_memory_error);
+ /* And initialize those used on Android 5.0 and later. */
+
+ if (android_get_current_api_level () < 21)
+ return;
+
+ android_init_cursor_class (env);
+ android_init_entry_class (env);
+ android_init_fd_class (env);
+
/* Initialize the semaphore used to wait for SAF operations to
complete. */
@@ -7821,10 +7804,10 @@ DEFUN ("android-relinquish-directory-access",
Sandroid_relinquish_directory_access, 1, 1,
"DDirectory: ",
doc: /* Relinquish access to the provided directory.
-DIRECTORY must be an inferior directory to a subdirectory of
-/content/storage. Once the command completes, the parent of DIRECTORY
-below that subdirectory from will cease to appear there, but no files
-will be removed. */)
+DIRECTORY must be the toplevel directory of an open SAF volume (i.e., a
+file under /content/storage), or one of its inferiors. Once the command
+completes, the SAF directory holding this directory will vanish, but no
+files will be removed. */)
(Lisp_Object file)
{
struct android_vnode *vp;
@@ -7840,7 +7823,14 @@ will be removed. */)
return Qnil;
file = ENCODE_FILE (Fexpand_file_name (file, Qnil));
- vp = android_name_file (SSDATA (file));
+
+ if (!NILP (call1 (Qfile_remote_p, file)))
+ signal_error ("Cannot relinquish access to remote file", file);
+
+ vp = android_name_file (SSDATA (file));
+
+ if (!vp)
+ report_file_error ("Relinquishing directory", file);
if (vp->type != ANDROID_VNODE_SAF_TREE)
{
diff --git a/src/buffer.c b/src/buffer.c
index 291c7d3f911..8f983692124 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -931,8 +931,8 @@ Interactively, CLONE and INHIBIT-BUFFER-HOOKS are nil. */)
bset_local_minor_modes (b, Qnil);
bset_auto_save_file_name (b, Qnil);
set_buffer_internal_1 (b);
- Fset (intern ("buffer-save-without-query"), Qnil);
- Fset (intern ("buffer-file-number"), Qnil);
+ Fset (Qbuffer_save_without_query, Qnil);
+ Fset (Qbuffer_file_number, Qnil);
if (!NILP (Flocal_variable_p (Qbuffer_stale_function, base_buffer)))
Fkill_local_variable (Qbuffer_stale_function);
/* Cloned buffers need extra setup, to do things such as deep
@@ -1477,7 +1477,7 @@ No argument or nil as argument means use current buffer
as BUFFER. */)
}
tem = buffer_local_variables_1 (buf, PER_BUFFER_VAR_OFFSET (undo_list),
- intern ("buffer-undo-list"));
+ Qbuffer_undo_list);
if (!NILP (tem))
result = Fcons (tem, result);
@@ -1704,11 +1704,11 @@ This does not change the name of the visited file (if
any). */)
Fsetcar (Frassq (buf, Vbuffer_alist), newname);
if (NILP (BVAR (current_buffer, filename))
&& !NILP (BVAR (current_buffer, auto_save_file_name)))
- call0 (intern ("rename-auto-save-file"));
+ call0 (Qrename_auto_save_file);
run_buffer_list_update_hook (current_buffer);
- call2 (intern ("uniquify--rename-buffer-advice"),
+ call2 (Quniquify__rename_buffer_advice,
requestedname, unique);
/* Refetch since that last call may have done GC. */
@@ -1956,7 +1956,7 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
{
tem = do_yes_or_no_p (build_string ("Delete auto-save file? "));
if (!NILP (tem))
- call0 (intern ("delete-auto-save-file-if-necessary"));
+ call0 (Qdelete_auto_save_file_if_necessary);
}
/* If the hooks have killed the buffer, exit now. */
@@ -2251,7 +2251,7 @@ the current buffer's major mode. */)
error ("Attempt to set major mode for a dead buffer");
if (strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0)
- function = find_symbol_value (intern ("initial-major-mode"));
+ function = find_symbol_value (Qinitial_major_mode);
else
{
function = BVAR (&buffer_defaults, major_mode);
@@ -2936,7 +2936,7 @@ current buffer is cleared. */)
/* Represent all the above changes by a special undo entry. */
bset_undo_list (current_buffer,
Fcons (list3 (Qapply,
- intern ("set-buffer-multibyte"),
+ Qset_buffer_multibyte,
NILP (flag) ? Qt : Qnil),
old_undo));
}
@@ -6112,4 +6112,13 @@ There is no reason to change that value except for
debugging purposes. */);
DEFSYM (Qbuffer_stale_function, "buffer-stale-function");
Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
+
+ DEFSYM (Qbuffer_save_without_query, "buffer-save-without-query");
+ DEFSYM (Qbuffer_file_number, "buffer-file-number");
+ DEFSYM (Qbuffer_undo_list, "buffer-undo-list");
+ DEFSYM (Qrename_auto_save_file, "rename-auto-save-file");
+ DEFSYM (Quniquify__rename_buffer_advice, "uniquify--rename-buffer-advice");
+ DEFSYM (Qdelete_auto_save_file_if_necessary,
"delete-auto-save-file-if-necessary");
+ DEFSYM (Qinitial_major_mode, "initial-major-mode");
+ DEFSYM (Qset_buffer_multibyte, "set-buffer-multibyte");
}
diff --git a/src/bytecode.c b/src/bytecode.c
index 9f5a3a0e89b..824083069a3 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -490,7 +490,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
Lisp_Object *top = NULL;
unsigned char const *pc = NULL;
- Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE);
+ Lisp_Object bytestr = AREF (fun, CLOSURE_CODE);
setup_frame: ;
eassert (!STRING_MULTIBYTE (bytestr));
@@ -504,8 +504,8 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
when returning, to detect unwind imbalances. This would require adding
a field to the frame header. */
- Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS);
- Lisp_Object maxdepth = AREF (fun, COMPILED_STACK_DEPTH);
+ Lisp_Object vector = AREF (fun, CLOSURE_CONSTANTS);
+ Lisp_Object maxdepth = AREF (fun, CLOSURE_STACK_DEPTH);
ptrdiff_t const_length = ASIZE (vector);
ptrdiff_t bytestr_length = SCHARS (bytestr);
Lisp_Object *vectorp = XVECTOR (vector)->contents;
@@ -640,8 +640,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
varref:
{
Lisp_Object v1 = vectorp[op], v2;
- if (!BARE_SYMBOL_P (v1)
- || XBARE_SYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL
+ if (XBARE_SYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL
|| (v2 = XBARE_SYMBOL (v1)->u.s.val.value,
BASE_EQ (v2, Qunbound)))
v2 = Fsymbol_value (v1);
@@ -715,8 +714,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
Lisp_Object val = POP;
/* Inline the most common case. */
- if (BARE_SYMBOL_P (sym)
- && !BASE_EQ (val, Qunbound)
+ if (!BASE_EQ (val, Qunbound)
&& XBARE_SYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL
&& !XBARE_SYMBOL (sym)->u.s.trapped_write)
SET_SYMBOL_VAL (XBARE_SYMBOL (sym), val);
@@ -809,14 +807,14 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
/* 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))
+ if (CLOSUREP (call_fun))
{
- Lisp_Object template = AREF (call_fun, COMPILED_ARGLIST);
+ Lisp_Object template = AREF (call_fun, CLOSURE_ARGLIST);
if (FIXNUMP (template))
{
/* Fast path for lexbound functions. */
fun = call_fun;
- bytestr = AREF (call_fun, COMPILED_BYTECODE),
+ bytestr = AREF (call_fun, CLOSURE_CODE),
args_template = XFIXNUM (template);
nargs = call_nargs;
args = call_args;
@@ -914,8 +912,8 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
bc->fp = fp;
Lisp_Object fun = fp->fun;
- Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE);
- Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS);
+ Lisp_Object bytestr = AREF (fun, CLOSURE_CODE);
+ Lisp_Object vector = AREF (fun, CLOSURE_CONSTANTS);
bytestr_data = SDATA (bytestr);
vectorp = XVECTOR (vector)->contents;
if (BYTE_CODE_SAFE)
@@ -991,8 +989,8 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
struct bc_frame *fp = bc->fp;
Lisp_Object fun = fp->fun;
- Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE);
- Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS);
+ Lisp_Object bytestr = AREF (fun, CLOSURE_CODE);
+ Lisp_Object vector = AREF (fun, CLOSURE_CONSTANTS);
bytestr_data = SDATA (bytestr);
vectorp = XVECTOR (vector)->contents;
if (BYTE_CODE_SAFE)
diff --git a/src/callint.c b/src/callint.c
index b31faba8704..1af9666e5a4 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -228,7 +228,7 @@ static Lisp_Object
read_file_name (Lisp_Object default_filename, Lisp_Object mustmatch,
Lisp_Object initial, Lisp_Object predicate)
{
- return CALLN (Ffuncall, intern ("read-file-name"),
+ return CALLN (Ffuncall, Qread_file_name,
callint_message, Qnil, default_filename,
mustmatch, initial, predicate);
}
@@ -319,10 +319,10 @@ invoke it (via an `interactive' spec that contains, for
instance, an
{
Lisp_Object funval = Findirect_function (function, Qt);
uintmax_t events = num_input_events;
+ Lisp_Object env = CLOSUREP (funval) && CONSP (AREF (funval,
CLOSURE_CODE))
+ ? AREF (funval, CLOSURE_CONSTANTS) : Qnil;
/* Compute the arg values using the user's expression. */
- specs = Feval (specs,
- CONSP (funval) && EQ (Qclosure, XCAR (funval))
- ? CAR_SAFE (XCDR (funval)) : Qnil);
+ specs = Feval (specs, env);
if (events != num_input_events || !NILP (record_flag))
{
/* We should record this command on the command history.
@@ -330,7 +330,7 @@ invoke it (via an `interactive' spec that contains, for
instance, an
and turn them into things we can eval. */
Lisp_Object values = quotify_args (Fcopy_sequence (specs));
fix_command (function, values);
- call4 (intern ("add-to-history"), intern ("command-history"),
+ call4 (Qadd_to_history, Qcommand_history,
Fcons (function, values), Qnil, Qt);
}
@@ -687,12 +687,12 @@ invoke it (via an `interactive' spec that contains, for
instance, an
break;
case 'x': /* Lisp expression read but not evaluated. */
- args[i] = call1 (intern ("read-minibuffer"), callint_message);
+ args[i] = call1 (Qread_minibuffer, callint_message);
visargs[i] = last_minibuf_string;
break;
case 'X': /* Lisp expression read and evaluated. */
- args[i] = call1 (intern ("eval-minibuffer"), callint_message);
+ args[i] = call1 (Qeval_minibuffer, callint_message);
visargs[i] = last_minibuf_string;
break;
@@ -766,7 +766,7 @@ invoke it (via an `interactive' spec that contains, for
instance, an
visargs[i] = (varies[i] > 0
? list1 (intern (callint_argfuns[varies[i]]))
: quotify_arg (args[i]));
- call4 (intern ("add-to-history"), intern ("command-history"),
+ call4 (Qadd_to_history, Qcommand_history,
Flist (nargs - 1, visargs + 1), Qnil, Qt);
}
@@ -912,4 +912,7 @@ use `event-start', `event-end', and `event-click-count'.
*/);
defsubr (&Sprefix_numeric_value);
DEFSYM (Qinteractive_args, "interactive-args");
+ DEFSYM (Qread_file_name, "read-file-name");
+ DEFSYM (Qcommand_history, "command-history");
+ DEFSYM (Qeval_minibuffer, "eval-minibuffer");
}
diff --git a/src/callproc.c b/src/callproc.c
index db36ef569e6..e116298baef 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -914,7 +914,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
/* If the caller required, let the buffer inherit the
coding-system used to decode the process output. */
if (inherit_process_coding_system)
- call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
+ call1 (Qafter_insert_file_set_buffer_file_coding_system,
make_fixnum (total_read));
}
@@ -1041,7 +1041,7 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
{
specpdl_ref count1 = SPECPDL_INDEX ();
- specbind (intern ("coding-system-for-write"), val);
+ specbind (Qcoding_system_for_write, val);
/* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
happen to get a ".Z" suffix. */
specbind (Qfile_name_handler_alist, Qnil);
@@ -2246,4 +2246,8 @@ the system. */);
defsubr (&Scall_process);
defsubr (&Sgetenv_internal);
defsubr (&Scall_process_region);
+
+ DEFSYM (Qafter_insert_file_set_buffer_file_coding_system,
+ "after-insert-file-set-buffer-file-coding-system");
+ DEFSYM (Qcoding_system_for_write, "coding-system-for-write");
}
diff --git a/src/charset.c b/src/charset.c
index 6635afe938d..e408052f305 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -863,7 +863,7 @@ usage: (define-charset-internal ...) */)
if (nargs != charset_arg_max)
Fsignal (Qwrong_number_of_arguments,
- Fcons (intern ("define-charset-internal"),
+ Fcons (Qdefine_charset_internal,
make_fixnum (nargs)));
attrs = make_nil_vector (charset_attr_max);
@@ -2362,6 +2362,7 @@ void
syms_of_charset (void)
{
DEFSYM (Qcharsetp, "charsetp");
+ DEFSYM (Qdefine_charset_internal, "define-charset-internal");
/* Special charset symbols. */
DEFSYM (Qascii, "ascii");
diff --git a/src/cmds.c b/src/cmds.c
index 81788b07242..f7a3f9e7ac6 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -428,7 +428,7 @@ internal_self_insert (int c, EMACS_INT n)
&& SYMBOLP (XSYMBOL (sym)->u.s.function))
{
Lisp_Object prop;
- prop = Fget (XSYMBOL (sym)->u.s.function, intern ("no-self-insert"));
+ prop = Fget (XSYMBOL (sym)->u.s.function, Qno_self_insert);
if (! NILP (prop))
return 1;
}
@@ -507,6 +507,7 @@ syms_of_cmds (void)
DEFSYM (Qundo_auto_amalgamate, "undo-auto-amalgamate");
DEFSYM (Qundo_auto__this_command_amalgamating,
"undo-auto--this-command-amalgamating");
+ DEFSYM (Qno_self_insert, "no-self-insert");
DEFSYM (Qkill_forward_chars, "kill-forward-chars");
diff --git a/src/coding.c b/src/coding.c
index 97c1c8b126c..cbb5d3e7a29 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -806,7 +806,7 @@ record_conversion_result (struct coding_system *coding,
case CODING_RESULT_SUCCESS:
break;
default:
- Vlast_code_conversion_error = intern ("Unknown error");
+ Vlast_code_conversion_error = QUnknown_error;
}
}
@@ -11508,7 +11508,7 @@ usage: (define-coding-system-internal ...) */)
short_args:
Fsignal (Qwrong_number_of_arguments,
- Fcons (intern ("define-coding-system-internal"),
+ Fcons (Qdefine_coding_system_internal,
make_fixnum (nargs)));
}
@@ -12311,6 +12311,9 @@ internal character representation. */);
Fset (AREF (Vcoding_category_table, i), Qno_conversion);
pdumper_do_now_and_after_load (reset_coding_after_pdumper_load);
+
+ DEFSYM (QUnknown_error, "Unknown error");
+ DEFSYM (Qdefine_coding_system_internal, "define-coding-system-internal");
}
static void
diff --git a/src/comp.c b/src/comp.c
index a3756857205..39e1795bfdc 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -636,6 +636,7 @@ typedef struct {
gcc_jit_function *func; /* Current function being compiled. */
bool func_has_non_local; /* From comp-func has-non-local slot. */
EMACS_INT func_speed; /* From comp-func speed slot. */
+ EMACS_INT func_safety; /* From comp-func safety slot. */
gcc_jit_block *block; /* Current basic block being compiled. */
gcc_jit_lvalue *scratch; /* Used as scratch slot for some code sequence
(switch). */
ptrdiff_t frame_size; /* Size of the following array in elements. */
@@ -747,7 +748,7 @@ static Lisp_Object
comp_hash_string (Lisp_Object string)
{
Lisp_Object digest = make_uninit_string (MD5_DIGEST_SIZE * 2);
- md5_buffer (SSDATA (string), SCHARS (string), SSDATA (digest));
+ md5_buffer (SSDATA (string), SBYTES (string), SSDATA (digest));
hexbuf_digest (SSDATA (digest), SDATA (digest), MD5_DIGEST_SIZE);
return Fsubstring (digest, Qnil, make_fixnum (HASH_LENGTH));
@@ -2589,7 +2590,8 @@ emit_call_with_type_hint (gcc_jit_function *func,
Lisp_Object insn,
Lisp_Object type)
{
bool hint_match =
- !NILP (CALL2I (comp-mvar-type-hint-match-p, SECOND (insn), type));
+ !comp.func_safety
+ && !NILP (CALL2I (comp-mvar-type-hint-match-p, SECOND (insn), type));
gcc_jit_rvalue *args[] =
{ emit_mvar_rval (SECOND (insn)),
gcc_jit_context_new_rvalue_from_int (comp.ctxt,
@@ -2605,7 +2607,8 @@ emit_call2_with_type_hint (gcc_jit_function *func,
Lisp_Object insn,
Lisp_Object type)
{
bool hint_match =
- !NILP (CALL2I (comp-mvar-type-hint-match-p, SECOND (insn), type));
+ !comp.func_safety
+ && !NILP (CALL2I (comp-mvar-type-hint-match-p, SECOND (insn), type));
gcc_jit_rvalue *args[] =
{ emit_mvar_rval (SECOND (insn)),
emit_mvar_rval (THIRD (insn)),
@@ -4285,6 +4288,7 @@ compile_function (Lisp_Object func)
comp.func_has_non_local = !NILP (CALL1I (comp-func-has-non-local, func));
comp.func_speed = XFIXNUM (CALL1I (comp-func-speed, func));
+ comp.func_safety = XFIXNUM (CALL1I (comp-func-safety, func));
comp.func_relocs_local =
gcc_jit_function_new_local (comp.func,
@@ -5202,7 +5206,7 @@ maybe_defer_native_compilation (Lisp_Object function_name,
if (!native_comp_jit_compilation
|| noninteractive
|| !NILP (Vpurify_flag)
- || !COMPILEDP (definition)
+ || !CLOSUREP (definition)
|| !STRINGP (Vload_true_file_name)
|| !suffix_p (Vload_true_file_name, ".elc")
|| !NILP (Fgethash (Vload_true_file_name, V_comp_no_native_file_h,
Qnil)))
@@ -5301,7 +5305,7 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit
*comp_u)
if (NILP (Fgethash (x, comp_u->lambda_gc_guard_h, Qnil)))
return false;
}
- else if (!EQ (data_imp_relocs[i], AREF (comp_u->data_impure_vec, i)))
+ else if (!EQ (x, AREF (comp_u->data_impure_vec, i)))
return false;
}
return true;
diff --git a/src/data.c b/src/data.c
index 8a677298fc0..16f4696b295 100644
--- a/src/data.c
+++ b/src/data.c
@@ -23,8 +23,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <math.h>
#include <stdio.h>
-#include <count-one-bits.h>
-#include <count-trailing-zeros.h>
#include <intprops.h>
#include "lisp.h"
@@ -52,11 +50,6 @@ INTFWDP (lispfwd a)
return XFWDTYPE (a) == Lisp_Fwd_Int;
}
static bool
-KBOARD_OBJFWDP (lispfwd a)
-{
- return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj;
-}
-static bool
OBJFWDP (lispfwd a)
{
return XFWDTYPE (a) == Lisp_Fwd_Obj;
@@ -250,7 +243,9 @@ a fixed set of types. */)
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_CLOSURE:
+ return CONSP (AREF (object, CLOSURE_CODE))
+ ? Qinterpreted_function : Qbyte_code_function;
case PVEC_BUFFER: return Qbuffer;
case PVEC_CHAR_TABLE: return Qchar_table;
case PVEC_BOOL_VECTOR: return Qbool_vector;
@@ -523,12 +518,32 @@ DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
return Qnil;
}
+DEFUN ("closurep", Fclosurep, Sclosurep,
+ 1, 1, 0,
+ doc: /* Return t if OBJECT is a function of type `closure'. */)
+ (Lisp_Object object)
+{
+ if (CLOSUREP (object))
+ return Qt;
+ return Qnil;
+}
+
DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
1, 1, 0,
doc: /* Return t if OBJECT is a byte-compiled function object. */)
(Lisp_Object object)
{
- if (COMPILEDP (object))
+ if (CLOSUREP (object) && STRINGP (AREF (object, CLOSURE_CODE)))
+ return Qt;
+ return Qnil;
+}
+
+DEFUN ("interpreted-function-p", Finterpreted_function_p,
+ Sinterpreted_function_p, 1, 1, 0,
+ doc: /* Return t if OBJECT is a function of type
`interpreted-function'. */)
+ (Lisp_Object object)
+{
+ if (CLOSUREP (object) && CONSP (AREF (object, CLOSURE_CODE)))
return Qt;
return Qnil;
}
@@ -1148,19 +1163,19 @@ Value, if non-nil, is a list (interactive SPEC). */)
(*spec != '(') ? build_string (spec) :
Fcar (Fread_from_string (build_string (spec), Qnil,
Qnil)));
}
- else if (COMPILEDP (fun))
+ else if (CLOSUREP (fun))
{
- if (PVSIZE (fun) > COMPILED_INTERACTIVE)
+ if (PVSIZE (fun) > CLOSURE_INTERACTIVE)
{
- Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE);
+ Lisp_Object form = AREF (fun, CLOSURE_INTERACTIVE);
/* The vector form is the new form, where the first
element is the interactive spec, and the second is the
command modes. */
return list2 (Qinteractive, VECTORP (form) ? AREF (form, 0) : form);
}
- else if (PVSIZE (fun) > COMPILED_DOC_STRING)
+ else if (PVSIZE (fun) > CLOSURE_DOC_STRING)
{
- Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING);
+ Lisp_Object doc = AREF (fun, CLOSURE_DOC_STRING);
/* An invalid "docstring" is a sign that we have an OClosure. */
genfun = !(NILP (doc) || VALID_DOCSTRING_P (doc));
}
@@ -1179,17 +1194,11 @@ Value, if non-nil, is a list (interactive SPEC). */)
else if (CONSP (fun))
{
Lisp_Object funcar = XCAR (fun);
- if (EQ (funcar, Qclosure)
- || EQ (funcar, Qlambda))
+ if (EQ (funcar, Qlambda))
{
Lisp_Object form = Fcdr (XCDR (fun));
- if (EQ (funcar, Qclosure))
- form = Fcdr (form);
Lisp_Object spec = Fassq (Qinteractive, form);
- if (NILP (spec) && VALID_DOCSTRING_P (CAR_SAFE (form)))
- /* A "docstring" is a sign that we may have an OClosure. */
- genfun = true;
- else if (NILP (Fcdr (Fcdr (spec))))
+ if (NILP (Fcdr (Fcdr (spec))))
return spec;
else
return list2 (Qinteractive, Fcar (Fcdr (spec)));
@@ -1230,11 +1239,11 @@ The value, if non-nil, is a list of mode name symbols.
*/)
{
return XSUBR (fun)->command_modes;
}
- else if (COMPILEDP (fun))
+ else if (CLOSUREP (fun))
{
- if (PVSIZE (fun) <= COMPILED_INTERACTIVE)
+ if (PVSIZE (fun) <= CLOSURE_INTERACTIVE)
return Qnil;
- Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE);
+ Lisp_Object form = AREF (fun, CLOSURE_INTERACTIVE);
if (VECTORP (form))
/* New form -- the second element is the command modes. */
return AREF (form, 1);
@@ -1262,12 +1271,9 @@ The value, if non-nil, is a list of mode name symbols.
*/)
else if (CONSP (fun))
{
Lisp_Object funcar = XCAR (fun);
- if (EQ (funcar, Qclosure)
- || EQ (funcar, Qlambda))
+ if (EQ (funcar, Qlambda))
{
Lisp_Object form = Fcdr (XCDR (fun));
- if (EQ (funcar, Qclosure))
- form = Fcdr (form);
return Fcdr (Fcdr (Fassq (Qinteractive, form)));
}
}
@@ -1298,6 +1304,26 @@ If OBJECT is not a symbol, just return it. */)
return object;
}
+/* Return the KBOARD to which bindings currently established and values
+ set should apply. */
+
+KBOARD *
+kboard_for_bindings (void)
+{
+ /* We used to simply use current_kboard here, but from Lisp code, its
+ value is often unexpected. It seems nicer to allow constructions
+ like this to work as intuitively expected:
+
+ (with-selected-frame frame
+ (define-key local-function-map "\eOP" [f1]))
+
+ On the other hand, this affects the semantics of last-command and
+ real-last-command, and people may rely on that. I took a quick
+ look at the Lisp codebase, and I don't think anything will break.
+ --lorentey */
+
+ return FRAME_KBOARD (SELECTED_FRAME ());
+}
/* Given the raw contents of a symbol value cell,
return the Lisp value of the symbol.
@@ -1323,19 +1349,8 @@ do_symval_forwarding (lispfwd valcontents)
XBUFFER_OBJFWD (valcontents)->offset);
case Lisp_Fwd_Kboard_Obj:
- /* We used to simply use current_kboard here, but from Lisp
- code, its value is often unexpected. It seems nicer to
- allow constructions like this to work as intuitively expected:
-
- (with-selected-frame frame
- (define-key local-function-map "\eOP" [f1]))
-
- On the other hand, this affects the semantics of
- last-command and real-last-command, and people may rely on
- that. I took a quick look at the Lisp codebase, and I
- don't think anything will break. --lorentey */
- return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
- + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
+ return *(Lisp_Object *) (XKBOARD_OBJFWD (valcontents)->offset
+ + (char *) kboard_for_bindings ());
default: emacs_abort ();
}
}
@@ -1483,7 +1498,7 @@ store_symval_forwarding (lispfwd valcontents, Lisp_Object
newval,
case Lisp_Fwd_Kboard_Obj:
{
- char *base = (char *) FRAME_KBOARD (SELECTED_FRAME ());
+ char *base = (char *) kboard_for_bindings ();
char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
*(Lisp_Object *) p = newval;
}
@@ -1762,7 +1777,8 @@ set_internal (Lisp_Object symbol, Lisp_Object newval,
Lisp_Object where,
&& !PER_BUFFER_VALUE_P (buf, idx))
{
if (let_shadows_buffer_binding_p (sym))
- set_default_internal (symbol, newval, bindflag);
+ set_default_internal (symbol, newval, bindflag,
+ NULL);
else
SET_PER_BUFFER_VALUE_P (buf, idx, 1);
}
@@ -1985,7 +2001,7 @@ local bindings in certain buffers. */)
void
set_default_internal (Lisp_Object symbol, Lisp_Object value,
- enum Set_Internal_Bind bindflag)
+ enum Set_Internal_Bind bindflag, KBOARD *where)
{
CHECK_SYMBOL (symbol);
struct Lisp_Symbol *sym = XSYMBOL (symbol);
@@ -2065,6 +2081,13 @@ set_default_internal (Lisp_Object symbol, Lisp_Object
value,
}
}
}
+ else if (KBOARD_OBJFWDP (valcontents))
+ {
+ char *base = (char *) (where ? where
+ : kboard_for_bindings ());
+ char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
+ *(Lisp_Object *) p = value;
+ }
else
set_internal (symbol, value, Qnil, bindflag);
return;
@@ -2079,7 +2102,7 @@ The default value is seen in buffers that do not have
their own values
for this variable. */)
(Lisp_Object symbol, Lisp_Object value)
{
- set_default_internal (symbol, value, SET_INTERNAL_SET);
+ set_default_internal (symbol, value, SET_INTERNAL_SET, NULL);
return value;
}
@@ -2556,7 +2579,7 @@ or a byte-code object. IDX starts at 0. */)
ptrdiff_t size = 0;
if (VECTORP (array))
size = ASIZE (array);
- else if (COMPILEDP (array) || RECORDP (array))
+ else if (CLOSUREP (array) || RECORDP (array))
size = PVSIZE (array);
else
wrong_type_argument (Qarrayp, array);
@@ -3497,12 +3520,8 @@ representation. */)
}
eassume (FIXNUMP (value));
- EMACS_INT v = XFIXNUM (value) < 0 ? -1 - XFIXNUM (value) : XFIXNUM (value);
- return make_fixnum (EMACS_UINT_WIDTH <= UINT_WIDTH
- ? count_one_bits (v)
- : EMACS_UINT_WIDTH <= ULONG_WIDTH
- ? count_one_bits_l (v)
- : count_one_bits_ll (v));
+ EMACS_UINT v = XFIXNUM (value) < 0 ? -1 - XFIXNUM (value) : XFIXNUM (value);
+ return make_fixnum (stdc_count_ones (v));
}
DEFUN ("ash", Fash, Sash, 2, 2, 0,
@@ -3659,36 +3678,6 @@ bool_vector_spare_mask (EMACS_INT nr_bits)
return (((bits_word) 1) << (nr_bits % BITS_PER_BITS_WORD)) - 1;
}
-/* Shift VAL right by the width of an unsigned long long.
- ULLONG_WIDTH must be less than BITS_PER_BITS_WORD. */
-
-static bits_word
-shift_right_ull (bits_word w)
-{
- /* Pacify bogus GCC warning about shift count exceeding type width. */
- int shift = ULLONG_WIDTH - BITS_PER_BITS_WORD < 0 ? ULLONG_WIDTH : 0;
- return w >> shift;
-}
-
-/* Return the number of 1 bits in W. */
-
-static int
-count_one_bits_word (bits_word w)
-{
- if (BITS_WORD_MAX <= UINT_MAX)
- return count_one_bits (w);
- else if (BITS_WORD_MAX <= ULONG_MAX)
- return count_one_bits_l (w);
- else
- {
- int i = 0, count = 0;
- while (count += count_one_bits_ll (w),
- (i += ULLONG_WIDTH) < BITS_PER_BITS_WORD)
- w = shift_right_ull (w);
- return count;
- }
-}
-
enum bool_vector_op { bool_vector_exclusive_or,
bool_vector_union,
bool_vector_intersection,
@@ -3795,55 +3784,6 @@ bool_vector_binop_driver (Lisp_Object a,
return dest;
}
-/* PRECONDITION must be true. Return VALUE. This odd construction
- works around a bogus GCC diagnostic "shift count >= width of type". */
-
-static int
-pre_value (bool precondition, int value)
-{
- eassume (precondition);
- return precondition ? value : 0;
-}
-
-/* Compute the number of trailing zero bits in val. If val is zero,
- return the number of bits in val. */
-static int
-count_trailing_zero_bits (bits_word val)
-{
- if (BITS_WORD_MAX == UINT_MAX)
- return count_trailing_zeros (val);
- if (BITS_WORD_MAX == ULONG_MAX)
- return count_trailing_zeros_l (val);
- if (BITS_WORD_MAX == ULLONG_MAX)
- return count_trailing_zeros_ll (val);
-
- /* The rest of this code is for the unlikely platform where bits_word differs
- in width from unsigned int, unsigned long, and unsigned long long. */
- val |= ~ BITS_WORD_MAX;
- if (BITS_WORD_MAX <= UINT_MAX)
- return count_trailing_zeros (val);
- if (BITS_WORD_MAX <= ULONG_MAX)
- return count_trailing_zeros_l (val);
- else
- {
- int count;
- for (count = 0;
- count < BITS_PER_BITS_WORD - ULLONG_WIDTH;
- count += ULLONG_WIDTH)
- {
- if (val & ULLONG_MAX)
- return count + count_trailing_zeros_ll (val);
- val = shift_right_ull (val);
- }
-
- if (BITS_PER_BITS_WORD % ULLONG_WIDTH != 0
- && BITS_WORD_MAX == (bits_word) -1)
- val |= (bits_word) 1 << pre_value (ULONG_MAX < BITS_WORD_MAX,
- BITS_PER_BITS_WORD % ULLONG_WIDTH);
- return count + count_trailing_zeros_ll (val);
- }
-}
-
DEFUN ("bool-vector-exclusive-or", Fbool_vector_exclusive_or,
Sbool_vector_exclusive_or, 2, 3, 0,
doc: /* Return A ^ B, bitwise exclusive or.
@@ -3958,7 +3898,7 @@ value from A's length. */)
adata = bool_vector_data (a);
for (i = 0; i < nwords; i++)
- count += count_one_bits_word (adata[i]);
+ count += stdc_count_ones (adata[i]);
return make_fixnum (count);
}
@@ -4006,7 +3946,7 @@ A is a bool vector, B is t or nil, and I is an index into
A. */)
/* Do not count the pad bits. */
mword |= (bits_word) 1 << (BITS_PER_BITS_WORD - offset);
- count = count_trailing_zero_bits (mword);
+ count = stdc_trailing_zeros (mword);
pos++;
if (count + offset < BITS_PER_BITS_WORD)
return make_fixnum (count);
@@ -4026,7 +3966,7 @@ A is a bool vector, B is t or nil, and I is an index into
A. */)
in the current mword. */
mword = bits_word_to_host_endian (adata[pos]);
mword ^= twiddle;
- count += count_trailing_zero_bits (mword);
+ count += stdc_trailing_zeros (mword);
}
else if (nr_bits % BITS_PER_BITS_WORD != 0)
{
@@ -4235,7 +4175,8 @@ syms_of_data (void)
DEFSYM (Qspecial_form, "special-form");
DEFSYM (Qprimitive_function, "primitive-function");
DEFSYM (Qsubr_native_elisp, "subr-native-elisp");
- DEFSYM (Qcompiled_function, "compiled-function");
+ DEFSYM (Qbyte_code_function, "byte-code-function");
+ DEFSYM (Qinterpreted_function, "interpreted-function");
DEFSYM (Qbuffer, "buffer");
DEFSYM (Qframe, "frame");
DEFSYM (Qvector, "vector");
@@ -4301,6 +4242,8 @@ syms_of_data (void)
defsubr (&Smarkerp);
defsubr (&Ssubrp);
defsubr (&Sbyte_code_function_p);
+ defsubr (&Sinterpreted_function_p);
+ defsubr (&Sclosurep);
defsubr (&Smodule_function_p);
defsubr (&Schar_or_string_p);
defsubr (&Sthreadp);
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 0441b07a3b2..35ce03c7911 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -474,7 +474,7 @@ xd_signature (char *signature, int dtype, int parent_type,
Lisp_Object object)
subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
if (strcmp (subsig, x) != 0)
- wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt));
+ wrong_type_argument (QD_Bus, CAR_SAFE (elt));
elt = CDR_SAFE (XD_NEXT_VALUE (elt));
}
@@ -493,8 +493,7 @@ xd_signature (char *signature, int dtype, int parent_type,
Lisp_Object object)
xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
- wrong_type_argument (intern ("D-Bus"),
- CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
+ wrong_type_argument (QD_Bus, CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
sprintf (signature, "%c", dtype);
break;
@@ -528,7 +527,7 @@ xd_signature (char *signature, int dtype, int parent_type,
Lisp_Object object)
/* Check the parent object type. */
if (parent_type != DBUS_TYPE_ARRAY)
- wrong_type_argument (intern ("D-Bus"), object);
+ wrong_type_argument (QD_Bus, object);
/* Compose the signature from the elements. It is enclosed by
curly braces. */
@@ -542,7 +541,7 @@ xd_signature (char *signature, int dtype, int parent_type,
Lisp_Object object)
xd_signature_cat (signature, x);
if (!XD_BASIC_DBUS_TYPE (subtype))
- wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt)));
+ wrong_type_argument (QD_Bus, CAR_SAFE (XD_NEXT_VALUE (elt)));
/* Second element. */
elt = CDR_SAFE (XD_NEXT_VALUE (elt));
@@ -552,15 +551,14 @@ xd_signature (char *signature, int dtype, int
parent_type, Lisp_Object object)
xd_signature_cat (signature, x);
if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
- wrong_type_argument (intern ("D-Bus"),
- CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
+ wrong_type_argument (QD_Bus, CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
/* Closing signature. */
xd_signature_cat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
break;
default:
- wrong_type_argument (intern ("D-Bus"), object);
+ wrong_type_argument (QD_Bus, object);
}
XD_DEBUG_MESSAGE ("%s", signature);
@@ -1480,7 +1478,7 @@ usage: (dbus-message-internal &rest REST) */)
bus or an unknown name, we regard it as broadcast message
due to backward compatibility. */
if (dbus_bus_name_has_owner (connection, SSDATA (service), NULL))
- uname = call2 (intern ("dbus-get-name-owner"), bus, service);
+ uname = call2 (Qdbus_get_name_owner, bus, service);
else
uname = Qnil;
@@ -1886,6 +1884,7 @@ syms_of_dbusbind (void)
list2 (Qdbus_error, Qerror));
Fput (Qdbus_error, Qerror_message,
build_pure_c_string ("D-Bus error"));
+ DEFSYM (QD_Bus, "D-Bus");
/* Lisp symbols of the system and session buses. */
DEFSYM (QCsystem, ":system");
@@ -1924,6 +1923,9 @@ syms_of_dbusbind (void)
DEFSYM (QCsignal, ":signal");
DEFSYM (QCmonitor, ":monitor");
+ /* Miscellaneous Lisp symbols. */
+ DEFSYM (Qdbus_get_name_owner, "dbus-get-name-owner");
+
DEFVAR_LISP ("dbus-compiled-version",
Vdbus_compiled_version,
doc: /* The version of D-Bus Emacs is compiled against. */);
diff --git a/src/dired.c b/src/dired.c
index bfbacf70917..37a9cad992f 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -351,8 +351,11 @@ directory_files_internal (Lisp_Object directory,
Lisp_Object full,
specpdl_ptr = specpdl_ref_to_ptr (count);
if (NILP (nosort))
- list = CALLN (Fsort, Fnreverse (list),
- attrs ? Qfile_attributes_lessp : Qstring_lessp);
+ {
+ Lisp_Object ordered = Fnreverse (list);
+ list = CALLN (Fsort, ordered,
+ attrs ? Qfile_attributes_lessp : Qstring_lessp);
+ }
(void) directory_volatile;
return list;
diff --git a/src/dispextern.h b/src/dispextern.h
index 5ce57a42e95..81609911d1f 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -69,12 +69,6 @@ typedef struct
unsigned width, height;
} Emacs_Rectangle;
-#else
-
-typedef struct android_rectangle Emacs_Rectangle;
-
-#endif
-
/* XGCValues-like struct used by non-X GUI code. */
typedef struct
{
@@ -88,6 +82,19 @@ typedef struct
#define GCForeground 0x01
#define GCBackground 0x02
+#else
+
+typedef struct android_rectangle Emacs_Rectangle;
+typedef struct android_gc_values Emacs_GC;
+
+#define GCForeground ANDROID_GC_FOREGROUND
+#define GCBackground ANDROID_GC_BACKGROUND
+#define GCFillStyle ANDROID_GC_FILL_STYLE
+#define GCStipple ANDROID_GC_STIPPLE
+#define FillOpaqueStippled ANDROID_FILL_OPAQUE_STIPPLED
+
+#endif
+
#endif /* HAVE_X_WINDOWS */
#ifdef MSDOS
@@ -1694,9 +1701,15 @@ enum face_box_type
enum face_underline_type
{
+ /* Note: order matches the order of the Smulx terminfo extension, and
+ is also relied on to remain in its present order by
+ x_draw_glyph_string and company. */
FACE_NO_UNDERLINE = 0,
- FACE_UNDER_LINE,
- FACE_UNDER_WAVE
+ FACE_UNDERLINE_SINGLE,
+ FACE_UNDERLINE_DOUBLE_LINE,
+ FACE_UNDERLINE_WAVE,
+ FACE_UNDERLINE_DOTS,
+ FACE_UNDERLINE_DASHES,
};
/* Structure describing a realized face.
@@ -1780,7 +1793,7 @@ struct face
ENUM_BF (face_box_type) box : 2;
/* Style of underlining. */
- ENUM_BF (face_underline_type) underline : 2;
+ ENUM_BF (face_underline_type) underline : 3;
/* If `box' above specifies a 3D type, true means use box_color for
drawing shadows. */
@@ -1812,7 +1825,6 @@ struct face
string meaning the default color of the TTY. */
bool_bf tty_bold_p : 1;
bool_bf tty_italic_p : 1;
- bool_bf tty_underline_p : 1;
bool_bf tty_reverse_p : 1;
bool_bf tty_strike_through_p : 1;
@@ -2421,7 +2433,9 @@ struct it
bool_bf string_from_display_prop_p : 1;
/* True means `string' comes from a `line-prefix' or `wrap-prefix'
- property. */
+ property, and that these properties were already handled, even if
+ their value is not a string. This is used to avoid processing
+ the same line/wrap prefix more than once for the same glyph row. */
bool_bf string_from_prefix_prop_p : 1;
/* True means we are iterating an object that came from a value of a
@@ -3435,6 +3449,7 @@ enum tool_bar_item_image
#define TTY_CAP_DIM 0x08
#define TTY_CAP_ITALIC 0x10
#define TTY_CAP_STRIKE_THROUGH 0x20
+#define TTY_CAP_UNDERLINE_STYLED (0x32 & TTY_CAP_UNDERLINE)
/***********************************************************************
diff --git a/src/dispnew.c b/src/dispnew.c
index 4d7586bdc1e..f1693ecb5d3 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -6530,7 +6530,7 @@ init_faces_initial (void)
FRAME_FOREGROUND_PIXEL (sf) = FACE_TTY_DEFAULT_FG_COLOR;
FRAME_BACKGROUND_PIXEL (sf) = FACE_TTY_DEFAULT_BG_COLOR;
- call0 (intern ("tty-set-up-initial-frame-faces"));
+ call0 (Qtty_set_up_initial_frame_faces);
}
/* Initialization done when Emacs fork is started, before doing stty.
diff --git a/src/doc.c b/src/doc.c
index b5a9ed498af..36633a920c6 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -517,11 +517,27 @@ store_function_docstring (Lisp_Object obj, EMACS_INT
offset)
if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
fun = XCDR (fun);
/* Lisp_Subrs have a slot for it. */
- if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun))
+ if (SUBRP (fun))
XSUBR (fun)->doc = offset;
+ else if (CLOSUREP (fun))
+ {
+ /* This bytecode object must have a slot for the docstring, since
+ we've found a docstring for it. */
+ if (PVSIZE (fun) > CLOSURE_DOC_STRING
+ /* Don't overwrite a non-docstring value placed there, such as
+ the symbols used for Oclosures. */
+ && VALID_DOCSTRING_P (AREF (fun, CLOSURE_DOC_STRING)))
+ ASET (fun, CLOSURE_DOC_STRING, make_fixnum (offset));
+ else
+ {
+ AUTO_STRING (format, "No doc string slot for compiled: %S");
+ CALLN (Fmessage, format, obj);
+ }
+ }
else
{
- AUTO_STRING (format, "Ignoring DOC string on non-subr: %S");
+ AUTO_STRING (format, "Ignoring DOC string on non-compiled"
+ "non-subr: %S");
CALLN (Fmessage, format, obj);
}
}
@@ -548,8 +564,8 @@ the same file name is found in the `doc-directory'. */)
ptrdiff_t dirlen;
/* Preloaded defcustoms using custom-initialize-delay are added to
this list, but kept unbound. See https://debbugs.gnu.org/11565 */
- Lisp_Object delayed_init =
- find_symbol_value (intern ("custom-delayed-init-variables"));
+ Lisp_Object delayed_init
+ = find_symbol_value (Qcustom_delayed_init_variables);
if (!CONSP (delayed_init)) delayed_init = Qnil;
@@ -763,4 +779,5 @@ compute the correct value for the current terminal in the
nil case. */);
defsubr (&Sdocumentation_property);
defsubr (&Ssnarf_documentation);
defsubr (&Stext_quoting_style);
+ DEFSYM (Qcustom_delayed_init_variables, "custom-delayed-init-variables");
}
diff --git a/src/dosfns.c b/src/dosfns.c
index 96087116c19..f883c7a8b8a 100644
--- a/src/dosfns.c
+++ b/src/dosfns.c
@@ -563,7 +563,7 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qtime, tem), attrs);
attrs = Fcons (Fcons (Qthcount, make_fixnum (1)), attrs);
attrs = Fcons (Fcons (Qstart,
- Fsymbol_value (intern ("before-init-time"))),
+ Fsymbol_value (Qbefore_init_time)),
attrs);
attrs = Fcons (Fcons (Qvsize,
INT_TO_INTEGER ((unsigned long) sbrk (0) / 1024)),
@@ -794,5 +794,6 @@ If non-zero, this variable contains the character to be
returned when the
decimal point key in the numeric keypad is pressed when Num Lock is on.
If zero, the decimal point key returns the country code specific value. */);
dos_decimal_point = 0;
+ DEFSYM (Qbefore_init_time, "before-init-time");
}
#endif /* MSDOS */
diff --git a/src/editfns.c b/src/editfns.c
index fc297896119..51c4f83b426 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -370,7 +370,7 @@ at POSITION. */)
Either BEG or END may be 0, in which case the corresponding value
is not stored. */
-static void
+void
find_field (Lisp_Object pos, Lisp_Object merge_at_boundary,
Lisp_Object beg_limit,
ptrdiff_t *beg, Lisp_Object end_limit, ptrdiff_t *end)
@@ -1247,11 +1247,10 @@ is in general a comma-separated list. */)
if (!pw)
return Qnil;
-#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
- p = android_user_full_name (pw);
-#else
p = USER_FULL_NAME;
-#endif
+ if (!p)
+ return Qnil;
+
/* Chop off everything after the first comma, since 'pw_gecos' is a
comma-separated list. */
q = strchr (p, ',');
diff --git a/src/emacs.c b/src/emacs.c
index 4e249da0fc1..dbc1d998e47 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -167,6 +167,7 @@ static const char emacs_copyright[] = COPYRIGHT;
static const char emacs_bugreport[] = PACKAGE_BUGREPORT;
/* Put version info into the executable in the form that 'ident' uses. */
+extern char const RCS_Id[];
char const EXTERNALLY_VISIBLE RCS_Id[]
= "$Id" ": GNU Emacs " PACKAGE_VERSION
" (" EMACS_CONFIGURATION " " EMACS_CONFIG_FEATURES ") $";
@@ -566,9 +567,8 @@ init_cmdargs (int argc, char **argv, int skip_args, char
const *original_pwd)
{
if (NILP (Vpurify_flag))
{
- Lisp_Object file_truename = intern ("file-truename");
- if (!NILP (Ffboundp (file_truename)))
- dir = call1 (file_truename, dir);
+ if (!NILP (Ffboundp (Qfile_truename)))
+ dir = call1 (Qfile_truename, dir);
}
dir = Fexpand_file_name (build_string ("../.."), dir);
}
@@ -1667,6 +1667,7 @@ main (int argc, char **argv)
inhibit_window_system = 0;
/* Handle the -t switch, which specifies filename to use as terminal. */
+ dev_tty = xstrdup (DEV_TTY); /* the default terminal */
while (!only_version)
{
char *term;
@@ -1689,6 +1690,8 @@ main (int argc, char **argv)
exit (EXIT_FAILURE);
}
fprintf (stderr, "Using %s\n", term);
+ xfree (dev_tty);
+ dev_tty = xstrdup (term);
#ifdef HAVE_WINDOW_SYSTEM
inhibit_window_system = true; /* -t => -nw */
#endif
@@ -3013,6 +3016,25 @@ killed. */
#ifdef HAVE_NATIVE_COMP
eln_load_path_final_clean_up ();
#endif
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ if (android_init_gui)
+ {
+ struct sigaction sa;
+
+ /* Calls to exit may be followed by invalid accesses from
+ toolkit-managed threads as the thread group is destroyed, which
+ are inconsequential when the process is being terminated, but
+ which must be suppressed to inhibit reporting of superfluous
+ crashes by the system.
+
+ Execution won't return to Emacs whatever the value of RESTART,
+ as `android_restart_emacs' will only ever abort or succeed. */
+ sigemptyset (&sa.sa_mask);
+ sa.sa_handler = _exit;
+ sigaction (SIGSEGV, &sa, NULL);
+ sigaction (SIGBUS, &sa, NULL);
+ }
+#endif /* HAVE_ANDROID && !ANDROID_STUBIFY */
if (!NILP (restart))
{
@@ -3192,7 +3214,7 @@ You must run Emacs in batch mode in order to dump it. */)
/* Bind `command-line-processed' to nil before dumping,
so that the dumped Emacs will process its command line
and set up to work with X windows if appropriate. */
- symbol = intern ("command-line-processed");
+ symbol = Qcommand_line_processed;
specbind (symbol, Qnil);
CHECK_STRING (filename);
@@ -3443,7 +3465,7 @@ decode_env_path (const char *evarname, const char
*defalt, bool empty)
if (SYMBOLP (tem))
{
Lisp_Object prop;
- prop = Fget (tem, intern ("safe-magic"));
+ prop = Fget (tem, Qsafe_magic);
if (! NILP (prop))
tem = Qnil;
}
@@ -3552,6 +3574,9 @@ syms_of_emacs (void)
DEFSYM (Qkill_emacs_hook, "kill-emacs-hook");
DEFSYM (Qrun_hook_query_error_with_timeout,
"run-hook-query-error-with-timeout");
+ DEFSYM (Qfile_truename, "file-truename");
+ DEFSYM (Qcommand_line_processed, "command-line-processed");
+ DEFSYM (Qsafe_magic, "safe-magic");
#ifdef HAVE_UNEXEC
defsubr (&Sdump_emacs);
diff --git a/src/epaths.in b/src/epaths.in
index 275d13985aa..a928830dba2 100644
--- a/src/epaths.in
+++ b/src/epaths.in
@@ -94,10 +94,11 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
# define PATH_DATA "/assets/etc/"
# define PATH_DOC "/assets/etc/"
# define PATH_INFO "/assets/info/"
- # define PATH_GAME ""
- # define PATH_BITMAPS ""
+ # define PATH_GAME (android_game_path)
+ # define PATH_BITMAPS "/assets/bitmaps/"
extern char *android_site_load_path;
extern char *android_lib_dir;
+extern char *android_game_path;
#endif
diff --git a/src/eval.c b/src/eval.c
index c581339c5e4..d15c07394b7 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -102,7 +102,14 @@ static Lisp_Object
specpdl_where (union specbinding *pdl)
{
eassert (pdl->kind > SPECPDL_LET);
- return pdl->let.where;
+ return pdl->let.where.buf;
+}
+
+static KBOARD *
+specpdl_kboard (union specbinding *pdl)
+{
+ eassert (pdl->kind == SPECPDL_LET);
+ return pdl->let.where.kbd;
}
#ifndef HAVE_MPS
@@ -299,7 +306,7 @@ call_debugger (Lisp_Object arg)
displayed if the debugger is invoked during redisplay. */
debug_while_redisplaying = redisplaying_p;
redisplaying_p = 0;
- specbind (intern ("debugger-may-continue"),
+ specbind (Qdebugger_may_continue,
debug_while_redisplaying ? Qnil : Qt);
specbind (Qinhibit_redisplay, Qnil);
specbind (Qinhibit_debugger, Qt);
@@ -517,6 +524,41 @@ usage: (quote ARG) */)
return XCAR (args);
}
+DEFUN ("make-interpreted-closure", Fmake_interpreted_closure,
+ Smake_interpreted_closure, 3, 5, 0,
+ doc: /* Make an interpreted closure.
+ARGS should be the list of formal arguments.
+BODY should be a non-empty list of forms.
+ENV should be a lexical environment, like the second argument of `eval'.
+IFORM if non-nil should be of the form (interactive ...). */)
+ (Lisp_Object args, Lisp_Object body, Lisp_Object env,
+ Lisp_Object docstring, Lisp_Object iform)
+{
+ Lisp_Object ifcdr, value, slots[6];
+
+ CHECK_CONS (body); /* Make sure it's not confused with byte-code! */
+ CHECK_LIST (args);
+ CHECK_LIST (iform);
+ ifcdr = CDR (iform);
+ if (NILP (CDR (ifcdr)))
+ value = CAR (ifcdr);
+ else
+ value = CALLN (Fvector, XCAR (ifcdr), XCDR (ifcdr));
+ slots[0] = args;
+ slots[1] = body;
+ slots[2] = env;
+ slots[3] = Qnil;
+ slots[4] = docstring;
+ slots[5] = value;
+ /* Adjusting the size is indispensable since, as for byte-code objects,
+ we distinguish interactive functions by the presence or absence of the
+ iform slot. */
+ Lisp_Object val
+ = Fvector (!NILP (iform) ? 6 : !NILP (docstring) ? 5 : 3, slots);
+ XSETPVECTYPE (XVECTOR (val), PVEC_CLOSURE);
+ return val;
+}
+
DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
doc: /* Like `quote', but preferred for objects which are functions.
In byte compilation, `function' causes its argument to be handled by
@@ -532,33 +574,55 @@ usage: (function ARG) */)
if (!NILP (XCDR (args)))
xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
- if (!NILP (Vinternal_interpreter_environment)
- && CONSP (quoted)
+ if (CONSP (quoted)
&& EQ (XCAR (quoted), Qlambda))
{ /* This is a lambda expression within a lexical environment;
return an interpreted closure instead of a simple lambda. */
Lisp_Object cdr = XCDR (quoted);
- Lisp_Object tmp = cdr;
- if (CONSP (tmp)
- && (tmp = XCDR (tmp), CONSP (tmp))
- && (tmp = XCAR (tmp), CONSP (tmp))
- && (EQ (QCdocumentation, XCAR (tmp))))
- { /* Handle the special (:documentation <form>) to build the docstring
+ Lisp_Object args = Fcar (cdr);
+ cdr = Fcdr (cdr);
+ Lisp_Object docstring = Qnil, iform = Qnil;
+ if (CONSP (cdr))
+ {
+ docstring = XCAR (cdr);
+ if (STRINGP (docstring))
+ {
+ Lisp_Object tmp = XCDR (cdr);
+ if (!NILP (tmp))
+ cdr = tmp;
+ else /* It's not a docstring, it's a return value. */
+ docstring = Qnil;
+ }
+ /* Handle the special (:documentation <form>) to build the docstring
dynamically. */
- Lisp_Object docstring = eval_sub (Fcar (XCDR (tmp)));
- if (SYMBOLP (docstring) && !NILP (docstring))
- /* Hack for OClosures: Allow the docstring to be a symbol
- * (the OClosure's type). */
- docstring = Fsymbol_name (docstring);
- CHECK_STRING (docstring);
- cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr))));
- }
- if (NILP (Vinternal_make_interpreted_closure_function))
- return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment,
cdr));
+ else if (CONSP (docstring)
+ && EQ (QCdocumentation, XCAR (docstring))
+ && (docstring = eval_sub (Fcar (XCDR (docstring))),
+ true))
+ cdr = XCDR (cdr);
+ else
+ docstring = Qnil; /* Not a docstring after all. */
+ }
+ if (CONSP (cdr))
+ {
+ iform = XCAR (cdr);
+ if (CONSP (iform)
+ && EQ (Qinteractive, XCAR (iform)))
+ cdr = XCDR (cdr);
+ else
+ iform = Qnil; /* Not an interactive-form after all. */
+ }
+ if (NILP (cdr))
+ cdr = Fcons (Qnil, Qnil); /* Make sure the body is never empty! */
+
+ if (NILP (Vinternal_interpreter_environment)
+ || NILP (Vinternal_make_interpreted_closure_function))
+ return Fmake_interpreted_closure
+ (args, cdr, Vinternal_interpreter_environment, docstring, iform);
else
- return call2 (Vinternal_make_interpreted_closure_function,
- Fcons (Qlambda, cdr),
- Vinternal_interpreter_environment);
+ return call5 (Vinternal_make_interpreted_closure_function,
+ args, cdr, Vinternal_interpreter_environment,
+ docstring, iform);
}
else
/* Simply quote the argument. */
@@ -626,12 +690,17 @@ signal a `cyclic-variable-indirection' error. */)
else if (!NILP (Fboundp (new_alias))
&& !EQ (find_symbol_value (new_alias),
find_symbol_value (base_variable)))
- call2 (intern ("display-warning"),
- list3 (Qdefvaralias, intern ("losing-value"), new_alias),
- CALLN (Fformat_message,
- build_string
- ("Overwriting value of `%s' by aliasing to `%s'"),
- new_alias, base_variable));
+ {
+ Lisp_Object message, formatted;
+
+ message = build_string ("Overwriting value of `%s' by aliasing"
+ " to `%s'");
+ formatted = CALLN (Fformat_message, message,
+ new_alias, base_variable);
+ call2 (Qdisplay_warning,
+ list3 (Qdefvaralias, Qlosing_value, new_alias),
+ formatted);
+ }
{
union specbinding *p;
@@ -955,8 +1024,9 @@ usage: (let* VARLIST BODY...) */)
val = eval_sub (Fcar (XCDR (elt)));
}
- if (!NILP (lexenv) && SYMBOLP (var)
- && !XSYMBOL (var)->u.s.declared_special
+ var = maybe_remove_pos_from_symbol (var);
+ if (!NILP (lexenv) && BARE_SYMBOL_P (var)
+ && !XBARE_SYMBOL (var)->u.s.declared_special
&& NILP (Fmemq (var, Vinternal_interpreter_environment)))
/* Lexically bind VAR by adding it to the interpreter's binding
alist. */
@@ -1023,11 +1093,10 @@ usage: (let VARLIST BODY...) */)
varlist = XCAR (args);
for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++)
{
- Lisp_Object var;
-
elt = XCAR (varlist);
varlist = XCDR (varlist);
- var = SYMBOLP (elt) ? elt : Fcar (elt);
+ Lisp_Object var = maybe_remove_pos_from_symbol (SYMBOLP (elt) ? elt
+ : Fcar (elt));
tem = temps[argnum];
if (!NILP (lexenv) && SYMBOLP (var)
@@ -1195,6 +1264,12 @@ usage: (catch TAG BODY...) */)
return internal_catch (tag, Fprogn, XCDR (args));
}
+/* Work around GCC bug 61118
+ <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=61118>. */
+#if GNUC_PREREQ (4, 9, 0)
+# pragma GCC diagnostic ignored "-Wclobbered"
+#endif
+
/* Assert that E is true, but do not evaluate E. Use this instead of
eassert (E) when E contains variables that might be clobbered by a
longjmp. */
@@ -1423,6 +1498,7 @@ internal_lisp_condition_case (Lisp_Object var,
Lisp_Object bodyform,
struct handler *oldhandlerlist = handlerlist;
ptrdiff_t CACHEABLE clausenb = 0;
+ var = maybe_remove_pos_from_symbol (var);
CHECK_SYMBOL (var);
Lisp_Object success_handler = Qnil;
@@ -2157,15 +2233,15 @@ then strings and vectors are not accepted. */)
return Qt;
}
/* Bytecode objects are interactive if they are long enough to
- have an element whose index is COMPILED_INTERACTIVE, which is
+ have an element whose index is CLOSURE_INTERACTIVE, which is
where the interactive spec is stored. */
- else if (COMPILEDP (fun))
+ else if (CLOSUREP (fun))
{
- if (PVSIZE (fun) > COMPILED_INTERACTIVE)
+ if (PVSIZE (fun) > CLOSURE_INTERACTIVE)
return Qt;
- else if (PVSIZE (fun) > COMPILED_DOC_STRING)
+ else if (PVSIZE (fun) > CLOSURE_DOC_STRING)
{
- Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING);
+ Lisp_Object doc = AREF (fun, CLOSURE_DOC_STRING);
/* An invalid "docstring" is a sign that we have an OClosure. */
genfun = !(NILP (doc) || VALID_DOCSTRING_P (doc));
}
@@ -2199,15 +2275,12 @@ then strings and vectors are not accepted. */)
else
{
Lisp_Object body = CDR_SAFE (XCDR (fun));
- if (EQ (funcar, Qclosure))
- body = CDR_SAFE (body);
- else if (!EQ (funcar, Qlambda))
+ if (!EQ (funcar, Qlambda))
return Qnil;
if (!NILP (Fassq (Qinteractive, body)))
return Qt;
- else if (VALID_DOCSTRING_P (CAR_SAFE (body)))
- /* A "docstring" is a sign that we may have an OClosure. */
- genfun = true;
+ else
+ return Qnil;
}
}
@@ -2576,7 +2649,7 @@ eval_sub (Lisp_Object form)
}
}
}
- else if (COMPILEDP (fun)
+ else if (CLOSUREP (fun)
|| SUBR_NATIVE_COMPILED_DYNP (fun)
|| MODULE_FUNCTIONP (fun))
return apply_lambda (fun, original_args, count);
@@ -2620,8 +2693,7 @@ eval_sub (Lisp_Object form)
exp = unbind_to (count1, exp);
val = eval_sub (exp);
}
- else if (EQ (funcar, Qlambda)
- || EQ (funcar, Qclosure))
+ else if (EQ (funcar, Qlambda))
return apply_lambda (fun, original_args, count);
else
xsignal1 (Qinvalid_function, original_fun);
@@ -2954,12 +3026,12 @@ FUNCTIONP (Lisp_Object object)
if (SUBRP (object))
return XSUBR (object)->max_args != UNEVALLED;
- else if (COMPILEDP (object) || MODULE_FUNCTIONP (object))
+ else if (CLOSUREP (object) || MODULE_FUNCTIONP (object))
return true;
else if (CONSP (object))
{
Lisp_Object car = XCAR (object);
- return EQ (car, Qlambda) || EQ (car, Qclosure);
+ return EQ (car, Qlambda);
}
else
return false;
@@ -2976,7 +3048,7 @@ funcall_general (Lisp_Object fun, ptrdiff_t numargs,
Lisp_Object *args)
if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun))
return funcall_subr (XSUBR (fun), numargs, args);
- else if (COMPILEDP (fun)
+ else if (CLOSUREP (fun)
|| SUBR_NATIVE_COMPILED_DYNP (fun)
|| MODULE_FUNCTIONP (fun))
return funcall_lambda (fun, numargs, args);
@@ -2989,8 +3061,7 @@ funcall_general (Lisp_Object fun, ptrdiff_t numargs,
Lisp_Object *args)
Lisp_Object funcar = XCAR (fun);
if (!SYMBOLP (funcar))
xsignal1 (Qinvalid_function, original_fun);
- if (EQ (funcar, Qlambda)
- || EQ (funcar, Qclosure))
+ if (EQ (funcar, Qlambda))
return funcall_lambda (fun, numargs, args);
else if (EQ (funcar, Qautoload))
{
@@ -3174,34 +3245,27 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
Lisp_Object *arg_vector)
if (CONSP (fun))
{
- if (EQ (XCAR (fun), Qclosure))
- {
- Lisp_Object cdr = XCDR (fun); /* Drop `closure'. */
- if (! CONSP (cdr))
- xsignal1 (Qinvalid_function, fun);
- fun = cdr;
- lexenv = XCAR (fun);
- }
- else
- lexenv = Qnil;
+ lexenv = Qnil;
syms_left = XCDR (fun);
if (CONSP (syms_left))
syms_left = XCAR (syms_left);
else
xsignal1 (Qinvalid_function, fun);
}
- else if (COMPILEDP (fun))
+ else if (CLOSUREP (fun))
{
- syms_left = AREF (fun, COMPILED_ARGLIST);
+ syms_left = AREF (fun, CLOSURE_ARGLIST);
/* Bytecode objects using lexical binding have an integral
ARGLIST slot value: pass the arguments to the byte-code
engine directly. */
if (FIXNUMP (syms_left))
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. */
- lexenv = Qnil;
+ /* Otherwise the closure either is interpreted
+ or uses dynamic binding and the ARGLIST slot contains a standard
+ formal argument list whose variables are bound dynamically below. */
+ lexenv = CONSP (AREF (fun, CLOSURE_CODE))
+ ? AREF (fun, CLOSURE_CONSTANTS)
+ : Qnil;
}
#ifdef HAVE_MODULES
else if (MODULE_FUNCTIONP (fun))
@@ -3264,7 +3328,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
Lisp_Object *arg_vector)
lexenv = Fcons (Fcons (next, arg), lexenv);
else
/* Dynamically bind NEXT. */
- specbind (next, arg);
+ specbind (maybe_remove_pos_from_symbol (next), arg);
previous_rest = false;
}
}
@@ -3289,7 +3353,14 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
Lisp_Object *arg_vector)
val = XSUBR (fun)->function.a0 ();
}
else
- val = exec_byte_code (fun, 0, 0, NULL);
+ {
+ eassert (CLOSUREP (fun));
+ val = CONSP (AREF (fun, CLOSURE_CODE))
+ /* Interpreted function. */
+ ? Fprogn (AREF (fun, CLOSURE_CODE))
+ /* Dynbound bytecode. */
+ : exec_byte_code (fun, 0, 0, NULL);
+ }
return unbind_to (count, val);
}
@@ -3324,7 +3395,7 @@ function with `&rest' args, or `unevalled' for a special
form. */)
if (SUBRP (function))
result = Fsubr_arity (function);
- else if (COMPILEDP (function))
+ else if (CLOSUREP (function))
result = lambda_arity (function);
#ifdef HAVE_MODULES
else if (MODULE_FUNCTIONP (function))
@@ -3339,8 +3410,7 @@ function with `&rest' args, or `unevalled' for a special
form. */)
funcar = XCAR (function);
if (!SYMBOLP (funcar))
xsignal1 (Qinvalid_function, original);
- if (EQ (funcar, Qlambda)
- || EQ (funcar, Qclosure))
+ if (EQ (funcar, Qlambda))
result = lambda_arity (function);
else if (EQ (funcar, Qautoload))
{
@@ -3361,20 +3431,15 @@ lambda_arity (Lisp_Object fun)
if (CONSP (fun))
{
- if (EQ (XCAR (fun), Qclosure))
- {
- fun = XCDR (fun); /* Drop `closure'. */
- CHECK_CONS (fun);
- }
syms_left = XCDR (fun);
if (CONSP (syms_left))
syms_left = XCAR (syms_left);
else
xsignal1 (Qinvalid_function, fun);
}
- else if (COMPILEDP (fun))
+ else if (CLOSUREP (fun))
{
- syms_left = AREF (fun, COMPILED_ARGLIST);
+ syms_left = AREF (fun, CLOSURE_ARGLIST);
if (FIXNUMP (syms_left))
return get_byte_code_arity (syms_left);
}
@@ -3448,7 +3513,8 @@ do_specbind (struct Lisp_Symbol *sym, union specbinding
*bind,
if (BUFFER_OBJFWDP (SYMBOL_FWD (sym))
&& specpdl_kind (bind) == SPECPDL_LET_DEFAULT)
{
- set_default_internal (specpdl_symbol (bind), value, bindflag);
+ set_default_internal (specpdl_symbol (bind), value, bindflag,
+ NULL);
return;
}
FALLTHROUGH;
@@ -3476,10 +3542,8 @@ do_specbind (struct Lisp_Symbol *sym, union specbinding
*bind,
void
specbind (Lisp_Object symbol, Lisp_Object value)
{
- struct Lisp_Symbol *sym;
-
- CHECK_SYMBOL (symbol);
- sym = XSYMBOL (symbol);
+ /* The caller must ensure that the SYMBOL argument is a bare symbol. */
+ struct Lisp_Symbol *sym = XBARE_SYMBOL (symbol);
start:
switch (sym->u.s.redirect)
@@ -3492,6 +3556,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
specpdl_ptr->let.kind = SPECPDL_LET;
specpdl_ptr->let.symbol = symbol;
specpdl_ptr->let.old_value = SYMBOL_VAL (sym);
+ specpdl_ptr->let.where.kbd = NULL;
break;
case SYMBOL_LOCALIZED:
case SYMBOL_FORWARDED:
@@ -3500,7 +3565,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
specpdl_ptr->let.kind = SPECPDL_LET_LOCAL;
specpdl_ptr->let.symbol = symbol;
specpdl_ptr->let.old_value = ovalue;
- specpdl_ptr->let.where = Fcurrent_buffer ();
+ specpdl_ptr->let.where.buf = Fcurrent_buffer ();
eassert (sym->u.s.redirect != SYMBOL_LOCALIZED
|| (BASE_EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ())));
@@ -3520,6 +3585,11 @@ specbind (Lisp_Object symbol, Lisp_Object value)
if (NILP (Flocal_variable_p (symbol, Qnil)))
specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
}
+ else if (KBOARD_OBJFWDP (SYMBOL_FWD (sym)))
+ {
+ specpdl_ptr->let.where.kbd = kboard_for_bindings ();
+ specpdl_ptr->let.kind = SPECPDL_LET;
+ }
else
specpdl_ptr->let.kind = SPECPDL_LET;
@@ -3623,6 +3693,8 @@ static void
do_one_unbind (union specbinding *this_binding, bool unwinding,
enum Set_Internal_Bind bindflag)
{
+ KBOARD *kbdwhere = NULL;
+
eassert (unwinding || this_binding->kind >= SPECPDL_LET);
switch (this_binding->kind)
{
@@ -3675,12 +3747,13 @@ do_one_unbind (union specbinding *this_binding, bool
unwinding,
}
}
/* Come here only if make_local_foo was used for the first time
- on this var within this let. */
+ on this var within this let or the symbol is not a plainval. */
+ kbdwhere = specpdl_kboard (this_binding);
FALLTHROUGH;
case SPECPDL_LET_DEFAULT:
set_default_internal (specpdl_symbol (this_binding),
specpdl_old_value (this_binding),
- bindflag);
+ bindflag, kbdwhere);
break;
case SPECPDL_LET_LOCAL:
{
@@ -3948,6 +4021,8 @@ specpdl_unrewind (union specbinding *pdl, int distance,
bool vars_only)
{
union specbinding *tmp = pdl;
int step = -1;
+ KBOARD *kbdwhere;
+
if (distance < 0)
{ /* It's a rewind rather than unwind. */
tmp += distance - 1;
@@ -3958,6 +4033,8 @@ specpdl_unrewind (union specbinding *pdl, int distance,
bool vars_only)
for (; distance > 0; distance--)
{
tmp += step;
+ kbdwhere = NULL;
+
switch (tmp->kind)
{
/* FIXME: Ideally we'd like to "temporarily unwind" (some of) those
@@ -3998,14 +4075,16 @@ specpdl_unrewind (union specbinding *pdl, int distance,
bool vars_only)
}
}
/* Come here only if make_local_foo was used for the first
- time on this var within this let. */
+ time on this var within this let or the symbol is forwarded. */
+ kbdwhere = specpdl_kboard (tmp);
FALLTHROUGH;
case SPECPDL_LET_DEFAULT:
{
Lisp_Object sym = specpdl_symbol (tmp);
Lisp_Object old_value = specpdl_old_value (tmp);
set_specpdl_old_value (tmp, default_value (sym));
- set_default_internal (sym, old_value, SET_INTERNAL_THREAD_SWITCH);
+ set_default_internal (sym, old_value, SET_INTERNAL_THREAD_SWITCH,
+ kbdwhere);
}
break;
case SPECPDL_LET_LOCAL:
@@ -4279,11 +4358,13 @@ before making `inhibit-quit' nil. */);
DEFSYM (Qcommandp, "commandp");
DEFSYM (Qand_rest, "&rest");
DEFSYM (Qand_optional, "&optional");
- DEFSYM (Qclosure, "closure");
DEFSYM (QCdocumentation, ":documentation");
DEFSYM (Qdebug, "debug");
DEFSYM (Qdebug_early, "debug-early");
DEFSYM (Qdebug_early__handler, "debug-early--handler");
+ DEFSYM (Qdebugger_may_continue, "debugger-may-continue");
+ DEFSYM (Qdisplay_warning, "display-warning");
+ DEFSYM (Qlosing_value, "losing-value");
DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger,
doc: /* Non-nil means never enter the debugger.
@@ -4437,6 +4518,7 @@ alist of active lexical bindings. */);
defsubr (&Ssetq);
defsubr (&Squote);
defsubr (&Sfunction);
+ defsubr (&Smake_interpreted_closure);
defsubr (&Sdefault_toplevel_value);
defsubr (&Sset_default_toplevel_value);
defsubr (&Sdefvar);
diff --git a/src/fileio.c b/src/fileio.c
index 12da7a9ed3a..960a3b21dc0 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -2205,7 +2205,7 @@ barf_or_query_if_file_exists (Lisp_Object absname, bool
known_to_exist,
AUTO_STRING (format, "File %s already exists; %s anyway? ");
tem = CALLN (Fformat, format, absname, build_string (querystring));
if (quick)
- tem = call1 (intern ("y-or-n-p"), tem);
+ tem = call1 (Qy_or_n_p, tem);
else
tem = do_yes_or_no_p (tem);
if (NILP (tem))
@@ -4550,7 +4550,7 @@ by calling `format-decode', which see. */)
current_buffer->modtime earlier, but we could still end up calling
ask-user-about-supersession-threat if the file is modified while
we read it, so we bind buffer-file-name instead. */
- specbind (intern ("buffer-file-name"), Qnil);
+ specbind (Qbuffer_file_name, Qnil);
del_range_byte (same_at_start, same_at_end);
/* Insert from the file at the proper position. */
temp = BYTE_TO_CHAR (same_at_start);
@@ -4660,7 +4660,7 @@ by calling `format-decode', which see. */)
if (same_at_start != same_at_end)
{
/* See previous specbind for the reason behind this. */
- specbind (intern ("buffer-file-name"), Qnil);
+ specbind (Qbuffer_file_name, Qnil);
del_range_byte (same_at_start, same_at_end);
}
inserted = 0;
@@ -4710,7 +4710,7 @@ by calling `format-decode', which see. */)
inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
/* See previous specbind for the reason behind this. */
- specbind (intern ("buffer-file-name"), Qnil);
+ specbind (Qbuffer_file_name, Qnil);
if (same_at_end != same_at_start)
{
del_range_byte (same_at_start, same_at_end);
@@ -6107,8 +6107,8 @@ auto_save_error (Lisp_Object error_val)
AUTO_STRING (format, "Auto-saving %s: %s");
Lisp_Object msg = CALLN (Fformat, format, BVAR (current_buffer, name),
Ferror_message_string (error_val));
- call3 (intern ("display-warning"),
- intern ("auto-save"), msg, intern (":error"));
+ call3 (Qdisplay_warning,
+ Qauto_save, msg, QCerror);
return Qnil;
}
@@ -6223,7 +6223,7 @@ A non-nil CURRENT-ONLY argument means save only current
buffer. */)
oquit = Vquit_flag;
Vquit_flag = Qnil;
- hook = intern ("auto-save-hook");
+ hook = Qauto_save_hook;
safe_run_hooks (hook);
if (STRINGP (Vauto_save_list_file_name))
@@ -6914,4 +6914,8 @@ This includes interactive calls to `delete-file' and
#endif /* HAVE_SYNC */
DEFSYM (Qif_regular, "if-regular");
+ DEFSYM (Qbuffer_file_name, "buffer-file-name");
+ DEFSYM (Qauto_save, "auto-save");
+ DEFSYM (QCerror, ":error");
+ DEFSYM (Qauto_save_hook, "auto-save-hook");
}
diff --git a/src/filelock.c b/src/filelock.c
index 01d35c46726..050cac565c9 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -274,7 +274,7 @@ lock_file_1 (Lisp_Object lfname, bool force)
/* Protect against the extremely unlikely case of the host name
containing an @ character. */
if (!NILP (lhost_name) && strchr (SSDATA (lhost_name), '@'))
- lhost_name = CALLN (Ffuncall, intern ("string-replace"),
+ lhost_name = CALLN (Ffuncall, Qstring_replace,
build_string ("@"), build_string ("-"),
lhost_name);
@@ -419,7 +419,9 @@ current_lock_owner (lock_info_type *owner, Lisp_Object
lfname)
boot += 2;
FALLTHROUGH;
case ':':
- if (! c_isdigit (boot[0]))
+ if (!(c_isdigit (boot[0])
+ /* A negative number. */
+ || (boot[0] == '-' && c_isdigit (boot[1]))))
return EINVAL;
boot_time = strtoimax (boot, &lfinfo_end, 10);
break;
@@ -789,6 +791,7 @@ Info node `(emacs)Interlocking'. */);
DEFSYM (Qunlock_file, "unlock-file");
DEFSYM (Qfile_locked_p, "file-locked-p");
DEFSYM (Qmake_lock_file_name, "make-lock-file-name");
+ DEFSYM (Qstring_replace, "string-replace");
defsubr (&Slock_file);
defsubr (&Sunlock_file);
diff --git a/src/fns.c b/src/fns.c
index 8f818694bef..ebcce63e0c0 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -155,7 +155,7 @@ efficient. */)
val = MAX_CHAR;
else if (BOOL_VECTOR_P (sequence))
val = bool_vector_size (sequence);
- else if (COMPILEDP (sequence) || RECORDP (sequence))
+ else if (CLOSUREP (sequence) || RECORDP (sequence))
val = PVSIZE (sequence);
else
wrong_type_argument (Qsequencep, sequence);
@@ -484,7 +484,7 @@ string_cmp (Lisp_Object string1, Lisp_Object string2)
int d = memcmp (SSDATA (string1), SSDATA (string2), n);
if (d)
return d;
- return n < SCHARS (string2) ? -1 : n > SCHARS (string2);
+ return n < SCHARS (string2) ? -1 : n < SCHARS (string1);
}
else if (STRING_MULTIBYTE (string1) && STRING_MULTIBYTE (string2))
{
@@ -518,7 +518,7 @@ string_cmp (Lisp_Object string1, Lisp_Object string2)
if (b >= nb)
/* One string is a prefix of the other. */
- return b < nb2 ? -1 : b > nb2;
+ return b < nb2 ? -1 : b < nb1;
/* Now back up to the start of the differing characters:
it's the last byte not having the bit pattern 10xxxxxx. */
@@ -543,7 +543,7 @@ string_cmp (Lisp_Object string1, Lisp_Object string2)
if (c1 != c2)
return c1 < c2 ? -1 : 1;
}
- return i1 < SCHARS (string2) ? -1 : i1 > SCHARS (string2);
+ return i1 < SCHARS (string2) ? -1 : i1 < SCHARS (string1);
}
else
{
@@ -556,7 +556,7 @@ string_cmp (Lisp_Object string1, Lisp_Object string2)
if (c1 != c2)
return c1 < c2 ? -1 : 1;
}
- return i1 < SCHARS (string2) ? -1 : i1 > SCHARS (string2);
+ return i1 < SCHARS (string2) ? -1 : i1 < SCHARS (string1);
}
}
@@ -1057,7 +1057,7 @@ concat_to_list (ptrdiff_t nargs, Lisp_Object *args,
Lisp_Object last_tail)
else if (NILP (arg))
;
else if (VECTORP (arg) || STRINGP (arg)
- || BOOL_VECTOR_P (arg) || COMPILEDP (arg))
+ || BOOL_VECTOR_P (arg) || CLOSUREP (arg))
{
ptrdiff_t arglen = XFIXNUM (Flength (arg));
ptrdiff_t argindex_byte = 0;
@@ -1117,7 +1117,7 @@ concat_to_vector (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object arg = args[i];
if (!(VECTORP (arg) || CONSP (arg) || NILP (arg) || STRINGP (arg)
- || BOOL_VECTOR_P (arg) || COMPILEDP (arg)))
+ || BOOL_VECTOR_P (arg) || CLOSUREP (arg)))
wrong_type_argument (Qsequencep, arg);
EMACS_INT len = XFIXNAT (Flength (arg));
result_len += len;
@@ -1173,7 +1173,7 @@ concat_to_vector (ptrdiff_t nargs, Lisp_Object *args)
}
else
{
- eassert (COMPILEDP (arg));
+ eassert (CLOSUREP (arg));
ptrdiff_t size = PVSIZE (arg);
memcpy (dst, XVECTOR (arg)->contents, size * sizeof *dst);
dst += size;
@@ -2009,11 +2009,12 @@ TESTFN is called with 2 arguments: a car of an alist
element and KEY. */)
FOR_EACH_TAIL (tail)
{
Lisp_Object car = XCAR (tail);
- if (CONSP (car)
- && (NILP (testfn)
- ? (EQ (XCAR (car), key) || !NILP (Fequal
- (XCAR (car), key)))
- : !NILP (call2 (testfn, XCAR (car), key))))
+ if (!CONSP (car))
+ continue;
+ if ((NILP (testfn)
+ ? (EQ (XCAR (car), key) || !NILP (Fequal
+ (XCAR (car), key)))
+ : !NILP (call2 (testfn, XCAR (car), key))))
return car;
}
CHECK_LIST_END (tail, alist);
@@ -2952,7 +2953,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum
equal_kind equal_kind,
if (size & PSEUDOVECTOR_FLAG)
{
if (((size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
- < PVEC_COMPILED)
+ < PVEC_CLOSURE)
return false;
size &= PSEUDOVECTOR_SIZE_MASK;
}
@@ -3127,10 +3128,12 @@ value_cmp (Lisp_Object a, Lisp_Object b, int maxdepth)
return pa < pb ? -1 : pa > pb;
}
+#ifdef subprocesses
case PVEC_PROCESS:
a = Fprocess_name (a);
b = Fprocess_name (b);
goto tail_recurse;
+#endif /* subprocesses */
case PVEC_BUFFER:
{
@@ -3349,7 +3352,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object
fn, Lisp_Object seq)
tail = XCDR (tail);
}
}
- else if (VECTORP (seq) || COMPILEDP (seq))
+ else if (VECTORP (seq) || CLOSUREP (seq))
{
for (ptrdiff_t i = 0; i < leni; i++)
{
@@ -5547,7 +5550,7 @@ sxhash_obj (Lisp_Object obj, int depth)
case Lisp_Vectorlike:
{
enum pvec_type pvec_type = PSEUDOVECTOR_TYPE (XVECTOR (obj));
- if (! (PVEC_NORMAL_VECTOR < pvec_type && pvec_type < PVEC_COMPILED))
+ if (! (PVEC_NORMAL_VECTOR < pvec_type && pvec_type < PVEC_CLOSURE))
{
/* According to the CL HyperSpec, two arrays are equal only if
they are 'eq', except for strings and bit-vectors. In
diff --git a/src/fontset.c b/src/fontset.c
index d27fa22015e..9e914abc1ff 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1366,10 +1366,11 @@ free_realized_fontsets (Lisp_Object base)
if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base))
{
Fclear_face_cache (Qt);
- /* This is in case some Lisp calls this function and then
- proceeds with calling some other function, like font-at,
- which needs the basic faces. */
- recompute_basic_faces (XFRAME (FONTSET_FRAME (this)));
+ if (FRAME_LIVE_P (XFRAME (FONTSET_FRAME (this))))
+ /* This is in case some Lisp calls this function and then
+ proceeds with calling some other function, like font-at,
+ which needs the basic faces. */
+ recompute_basic_faces (XFRAME (FONTSET_FRAME (this)));
break;
}
}
@@ -1500,7 +1501,8 @@ CHARACTERS may be a script symbol. In that case, use
FONT-SPEC for
all the characters that belong to the script. See the variable
`script-representative-chars' for the list of known scripts, and
see the variable `char-script-table' for the script of any specific
-character.
+character. Note: for the `symbol' script only, whether the FONTSET
+is actually used depends on the value of `use-default-font-for-symbols'.
CHARACTERS may be a charset symbol. In that case, use FONT-SPEC for
all the characters in the charset. See `list-character-sets' and
@@ -1526,7 +1528,16 @@ Optional 5th argument ADD, if non-nil, specifies how to
add FONT-SPEC
to the previously set font specifications for CHARACTERS. If it is
`prepend', FONT-SPEC is prepended to the existing font specifications.
If it is `append', FONT-SPEC is appended. By default, FONT-SPEC
-overwrites the previous settings. */)
+overwrites the previous settings.
+
+For reliable results, this function should be called before any
+of CHARACTERS were displayed in the current Emacs session. In
+particular, if some of CHARACTERS are displayed using character
+compositions, those compositions will be cached after they are first
+produced, and the cached values include the font used for displaying
+the composed characters -- calling this function will not affect the
+font recorded in the cache of compositions, thus they will continue
+to be shown using the fonts from before the call. */)
(Lisp_Object fontset, Lisp_Object characters, Lisp_Object font_spec,
Lisp_Object frame, Lisp_Object add)
{
@@ -1822,7 +1833,7 @@ fontset_from_font (Lisp_Object font_object)
if (CONSP (val))
return XFIXNUM (FONTSET_ID (XCDR (val)));
if (num_auto_fontsets++ == 0)
- alias = intern ("fontset-startup");
+ alias = Qfontset_startup;
else
{
char temp[sizeof "fontset-auto" + INT_STRLEN_BOUND (ptrdiff_t)];
@@ -2173,6 +2184,7 @@ syms_of_fontset (void)
Fput (Qfontset, Qchar_table_extra_slots, make_fixnum (8));
DEFSYM (Qfontset_info, "fontset-info");
Fput (Qfontset_info, Qchar_table_extra_slots, make_fixnum (1));
+ DEFSYM (Qfontset_startup, "fontset-startup");
DEFSYM (Qappend, "append");
DEFSYM (Qlatin, "latin");
diff --git a/src/frame.c b/src/frame.c
index a2e78d27c75..bf16e7d7cdc 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -1002,6 +1002,7 @@ make_frame (bool mini_p)
f->conversion.compose_region_start = Qnil;
f->conversion.compose_region_end = Qnil;
f->conversion.compose_region_overlay = Qnil;
+ f->conversion.field = Qnil;
f->conversion.batch_edit_count = 0;
f->conversion.batch_edit_flags = 0;
f->conversion.actions = NULL;
@@ -1114,12 +1115,12 @@ make_frame_without_minibuffer (Lisp_Object mini_window,
KBOARD *kb,
if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
|| ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))
{
- Lisp_Object frame_dummy;
+ Lisp_Object initial_frame;
- XSETFRAME (frame_dummy, f);
/* If there's no minibuffer frame to use, create one. */
- kset_default_minibuffer_frame
- (kb, call1 (intern ("make-initial-minibuffer-frame"), display));
+ initial_frame = call1 (Qmake_initial_minibuffer_frame,
+ display);
+ kset_default_minibuffer_frame (kb, initial_frame);
}
mini_window
@@ -6276,6 +6277,7 @@ syms_of_frame (void)
DEFSYM (Qframe_windows_min_size, "frame-windows-min-size");
DEFSYM (Qframe_monitor_attributes, "frame-monitor-attributes");
DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total");
+ DEFSYM (Qmake_initial_minibuffer_frame, "make-initial-minibuffer-frame");
DEFSYM (Qexplicit_name, "explicit-name");
DEFSYM (Qheight, "height");
DEFSYM (Qicon, "icon");
diff --git a/src/frame.h b/src/frame.h
index e03362361a7..63bcce259af 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -126,6 +126,10 @@ struct text_conversion_state
/* Overlay representing the composing region. */
Lisp_Object compose_region_overlay;
+ /* Cons of (START END . WINDOW) holding the field to which text
+ conversion should be confined, or nil if no such field exists. */
+ Lisp_Object field;
+
/* The number of ongoing ``batch edits'' that are causing point
reporting to be delayed. */
int batch_edit_count;
diff --git a/src/ftfont.c b/src/ftfont.c
index 0d10de5408f..214d7532d6f 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -149,7 +149,8 @@ static Lisp_Object
get_adstyle_property (FcPattern *p)
{
FcChar8 *fcstr;
- char *str, *end;
+ char *str, *end, *tmp;
+ size_t i;
Lisp_Object adstyle;
#ifdef FC_FONTFORMAT
@@ -168,7 +169,18 @@ get_adstyle_property (FcPattern *p)
|| matching_prefix (str, end - str, "Oblique")
|| matching_prefix (str, end - str, "Italic"))
return Qnil;
- adstyle = font_intern_prop (str, end - str, 1);
+ /* The characters `-', `?', `*', and `"' are not representable in XLFDs
+ and therefore must be replaced by substitutes. (bug#70989) */
+ USE_SAFE_ALLOCA;
+ tmp = SAFE_ALLOCA (end - str);
+ for (i = 0; i < end - str; ++i)
+ tmp[i] = ((end[i] != '?'
+ && end[i] != '*'
+ && end[i] != '"'
+ && end[i] != '-')
+ ? end[i] : ' ');
+ adstyle = font_intern_prop (tmp, end - str, 1);
+ SAFE_FREE ();
if (font_style_to_value (FONT_WIDTH_INDEX, adstyle, 0) >= 0)
return Qnil;
return adstyle;
@@ -2030,7 +2042,6 @@ ftfont_drive_otf (MFLTFont *font,
int i, j, gidx;
OTF_Glyph *otfg;
char script[5], *langsys = NULL;
- char *gsub_features = NULL, *gpos_features = NULL;
OTF_Feature *features;
if (len == 0)
@@ -2044,6 +2055,7 @@ ftfont_drive_otf (MFLTFont *font,
OTF_tag_name (spec->langsys, langsys);
}
+ char *gfeatures[2] = {NULL, NULL};
USE_SAFE_ALLOCA;
for (i = 0; i < 2; i++)
{
@@ -2052,11 +2064,10 @@ ftfont_drive_otf (MFLTFont *font,
if (spec->features[i] && spec->features[i][1] != 0xFFFFFFFF)
{
for (j = 0; spec->features[i][j]; j++);
+ if (j == 0)
+ continue;
SAFE_NALLOCA (p, 6, j);
- if (i == 0)
- gsub_features = p;
- else
- gpos_features = p;
+ gfeatures[i] = p;
for (j = 0; spec->features[i][j]; j++)
{
if (spec->features[i][j] == 0xFFFFFFFF)
@@ -2071,6 +2082,7 @@ ftfont_drive_otf (MFLTFont *font,
*--p = '\0';
}
}
+ char *gsub_features = gfeatures[0], *gpos_features = gfeatures[1];
setup_otf_gstring (len);
for (i = 0; i < len; i++)
diff --git a/src/gmalloc.c b/src/gmalloc.c
index 2b29f5c6c81..1faf6506167 100644
--- a/src/gmalloc.c
+++ b/src/gmalloc.c
@@ -47,11 +47,15 @@ License along with this library. If not, see
<https://www.gnu.org/licenses/>.
#ifndef __MALLOC_HOOK_VOLATILE
# define __MALLOC_HOOK_VOLATILE volatile
#endif
-#ifndef HAVE_MALLOC_H
+#if !defined HAVE_MALLOC_H \
+ || (__GLIBC__ > 2 || __GLIBC_MINOR__ >= 34)
extern void (*__MALLOC_HOOK_VOLATILE __after_morecore_hook) (void);
-extern void (*__MALLOC_HOOK_VOLATILE __malloc_initialize_hook) (void);
extern void *(*__morecore) (ptrdiff_t);
-#endif
+#endif /* !defined HAVE_MALLOC_H || glibc >= 2.34 */
+#if !defined HAVE_MALLOC_H \
+ || (__GLIBC__ > 2 || __GLIBC_MINOR__ >= 24)
+extern void (*__MALLOC_HOOK_VOLATILE __malloc_initialize_hook) (void);
+#endif /* !defined HAVE_MALLOC_H || glibc >= 2.24 */
/* If HYBRID_MALLOC is defined, then temacs will use malloc,
realloc... as defined in this file (and renamed gmalloc,
diff --git a/src/gnutls.c b/src/gnutls.c
index 54b7eb4c90e..3ff7f21d5a5 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -1142,7 +1142,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
int version = gnutls_x509_crt_get_version (cert);
check_memory_full (version);
if (version >= GNUTLS_E_SUCCESS)
- res = nconc2 (res, list2 (intern (":version"),
+ res = nconc2 (res, list2 (QCversion,
make_fixnum (version)));
}
@@ -1156,7 +1156,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
err = gnutls_x509_crt_get_serial (cert, serial, &buf_size);
check_memory_full (err);
if (err >= GNUTLS_E_SUCCESS)
- res = nconc2 (res, list2 (intern (":serial-number"),
+ res = nconc2 (res, list2 (QCserial_number,
gnutls_hex_string (serial, buf_size, "")));
xfree (serial);
}
@@ -1171,7 +1171,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
err = gnutls_x509_crt_get_issuer_dn (cert, dn, &buf_size);
check_memory_full (err);
if (err >= GNUTLS_E_SUCCESS)
- res = nconc2 (res, list2 (intern (":issuer"),
+ res = nconc2 (res, list2 (QCissuer,
make_string (dn, buf_size)));
xfree (dn);
}
@@ -1185,11 +1185,11 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t
cert)
time_t tim = gnutls_x509_crt_get_activation_time (cert);
if (gmtime_r (&tim, &t) && strftime (buf, sizeof buf, "%Y-%m-%d", &t))
- res = nconc2 (res, list2 (intern (":valid-from"), build_string (buf)));
+ res = nconc2 (res, list2 (QCvalid_from, build_string (buf)));
tim = gnutls_x509_crt_get_expiration_time (cert);
if (gmtime_r (&tim, &t) && strftime (buf, sizeof buf, "%Y-%m-%d", &t))
- res = nconc2 (res, list2 (intern (":valid-to"), build_string (buf)));
+ res = nconc2 (res, list2 (QCvalid_to, build_string (buf)));
}
/* Subject. */
@@ -1202,7 +1202,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
err = gnutls_x509_crt_get_dn (cert, dn, &buf_size);
check_memory_full (err);
if (err >= GNUTLS_E_SUCCESS)
- res = nconc2 (res, list2 (intern (":subject"),
+ res = nconc2 (res, list2 (QCsubject,
make_string (dn, buf_size)));
xfree (dn);
}
@@ -1217,12 +1217,12 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t
cert)
{
const char *name = gnutls_pk_algorithm_get_name (err);
if (name)
- res = nconc2 (res, list2 (intern (":public-key-algorithm"),
+ res = nconc2 (res, list2 (QCpublic_key_algorithm,
build_string (name)));
name = gnutls_sec_param_get_name (gnutls_pk_bits_to_sec_param
(err, bits));
- res = nconc2 (res, list2 (intern (":certificate-security-level"),
+ res = nconc2 (res, list2 (QCcertificate_security_level,
build_string (name)));
}
}
@@ -1237,7 +1237,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
err = gnutls_x509_crt_get_issuer_unique_id (cert, buf, &buf_size);
check_memory_full (err);
if (err >= GNUTLS_E_SUCCESS)
- res = nconc2 (res, list2 (intern (":issuer-unique-id"),
+ res = nconc2 (res, list2 (QCissuer_unique_id,
make_string (buf, buf_size)));
xfree (buf);
}
@@ -1251,7 +1251,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
err = gnutls_x509_crt_get_subject_unique_id (cert, buf, &buf_size);
check_memory_full (err);
if (err >= GNUTLS_E_SUCCESS)
- res = nconc2 (res, list2 (intern (":subject-unique-id"),
+ res = nconc2 (res, list2 (QCsubject_unique_id,
make_string (buf, buf_size)));
xfree (buf);
}
@@ -1263,7 +1263,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
{
const char *name = gnutls_sign_get_name (err);
if (name)
- res = nconc2 (res, list2 (intern (":signature-algorithm"),
+ res = nconc2 (res, list2 (QCsignature_algorithm,
build_string (name)));
}
@@ -1277,7 +1277,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
err = gnutls_x509_crt_get_key_id (cert, 0, buf, &buf_size);
check_memory_full (err);
if (err >= GNUTLS_E_SUCCESS)
- res = nconc2 (res, list2 (intern (":public-key-id"),
+ res = nconc2 (res, list2 (QCpublic_key_id,
gnutls_hex_string (buf, buf_size, "sha1:")));
xfree (buf);
}
@@ -1293,7 +1293,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
err = gnutls_x509_crt_get_key_id (cert, GNUTLS_KEYID_USE_SHA256, buf,
&buf_size);
check_memory_full (err);
if (err >= GNUTLS_E_SUCCESS)
- res = nconc2 (res, list2 (intern (":public-key-id-sha256"),
+ res = nconc2 (res, list2 (QCpublic_key_id_sha256,
gnutls_hex_string (buf, buf_size,
"sha256:")));
xfree (buf);
}
@@ -1311,13 +1311,13 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t
cert)
buf, &buf_size);
check_memory_full (err);
if (err >= GNUTLS_E_SUCCESS)
- res = nconc2 (res, list2 (intern (":certificate-id"),
+ res = nconc2 (res, list2 (QCcertificate_id,
gnutls_hex_string (buf, buf_size, "sha1:")));
xfree (buf);
}
/* PEM */
- res = nconc2 (res, list2 (intern (":pem"),
+ res = nconc2 (res, list2 (QCpem,
emacs_gnutls_certificate_export_pem(cert)));
return res;
@@ -1329,55 +1329,55 @@ DEFUN ("gnutls-peer-status-warning-describe",
Fgnutls_peer_status_warning_descri
{
CHECK_SYMBOL (status_symbol);
- if (EQ (status_symbol, intern (":invalid")))
+ if (EQ (status_symbol, QCinvalid))
return build_string ("certificate could not be verified");
- if (EQ (status_symbol, intern (":revoked")))
+ if (EQ (status_symbol, QCrevoked))
return build_string ("certificate was revoked (CRL)");
- if (EQ (status_symbol, intern (":self-signed")))
+ if (EQ (status_symbol, QCself_signed))
return build_string ("certificate signer was not found (self-signed)");
- if (EQ (status_symbol, intern (":unknown-ca")))
+ if (EQ (status_symbol, QCunknown_ca))
return build_string ("the certificate was signed by an unknown "
"and therefore untrusted authority");
- if (EQ (status_symbol, intern (":not-ca")))
+ if (EQ (status_symbol, QCnot_ca))
return build_string ("certificate signer is not a CA");
- if (EQ (status_symbol, intern (":insecure")))
+ if (EQ (status_symbol, QCinsecure))
return build_string ("certificate was signed with an insecure algorithm");
- if (EQ (status_symbol, intern (":not-activated")))
+ if (EQ (status_symbol, QCnot_activated))
return build_string ("certificate is not yet activated");
- if (EQ (status_symbol, intern (":expired")))
+ if (EQ (status_symbol, QCexpired))
return build_string ("certificate has expired");
- if (EQ (status_symbol, intern (":no-host-match")))
+ if (EQ (status_symbol, QCno_host_match))
return build_string ("certificate host does not match hostname");
- if (EQ (status_symbol, intern (":signature-failure")))
+ if (EQ (status_symbol, QCsignature_failure))
return build_string ("certificate signature could not be verified");
- if (EQ (status_symbol, intern (":revocation-data-superseded")))
+ if (EQ (status_symbol, QCrevocation_data_superseded))
return build_string ("certificate revocation data are old and have been "
"superseded");
- if (EQ (status_symbol, intern (":revocation-data-issued-in-future")))
+ if (EQ (status_symbol, QCrevocation_data_issued_in_future))
return build_string ("certificate revocation data have a future issue
date");
- if (EQ (status_symbol, intern (":signer-constraints-failure")))
+ if (EQ (status_symbol, QCsigner_constraints_failure))
return build_string ("certificate signer constraints were violated");
- if (EQ (status_symbol, intern (":purpose-mismatch")))
+ if (EQ (status_symbol, QCpurpose_mismatch))
return build_string ("certificate does not match the intended purpose");
- if (EQ (status_symbol, intern (":missing-ocsp-status")))
+ if (EQ (status_symbol, QCmissing_ocsp_status))
return build_string ("certificate requires the server to send a OCSP "
"certificate status, but no status was received");
- if (EQ (status_symbol, intern (":invalid-ocsp-status")))
+ if (EQ (status_symbol, QCinvalid_ocsp_status))
return build_string ("the received OCSP certificate status is invalid");
return Qnil;
@@ -1411,50 +1411,50 @@ returned as the :certificate entry. */)
verification = XPROCESS (proc)->gnutls_peer_verification;
if (verification & GNUTLS_CERT_INVALID)
- warnings = Fcons (intern (":invalid"), warnings);
+ warnings = Fcons (QCinvalid, warnings);
if (verification & GNUTLS_CERT_REVOKED)
- warnings = Fcons (intern (":revoked"), warnings);
+ warnings = Fcons (QCrevoked, warnings);
if (verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
- warnings = Fcons (intern (":unknown-ca"), warnings);
+ warnings = Fcons (QCunknown_ca, warnings);
if (verification & GNUTLS_CERT_SIGNER_NOT_CA)
- warnings = Fcons (intern (":not-ca"), warnings);
+ warnings = Fcons (QCnot_ca, warnings);
if (verification & GNUTLS_CERT_INSECURE_ALGORITHM)
- warnings = Fcons (intern (":insecure"), warnings);
+ warnings = Fcons (QCinsecure, warnings);
if (verification & GNUTLS_CERT_NOT_ACTIVATED)
- warnings = Fcons (intern (":not-activated"), warnings);
+ warnings = Fcons (QCnot_activated, warnings);
if (verification & GNUTLS_CERT_EXPIRED)
- warnings = Fcons (intern (":expired"), warnings);
+ warnings = Fcons (QCexpired, warnings);
# if GNUTLS_VERSION_NUMBER >= 0x030100
if (verification & GNUTLS_CERT_SIGNATURE_FAILURE)
- warnings = Fcons (intern (":signature-failure"), warnings);
+ warnings = Fcons (QCsignature_failure, warnings);
# if GNUTLS_VERSION_NUMBER >= 0x030114
if (verification & GNUTLS_CERT_REVOCATION_DATA_SUPERSEDED)
- warnings = Fcons (intern (":revocation-data-superseded"), warnings);
+ warnings = Fcons (QCrevocation_data_superseded, warnings);
if (verification & GNUTLS_CERT_REVOCATION_DATA_ISSUED_IN_FUTURE)
- warnings = Fcons (intern (":revocation-data-issued-in-future"), warnings);
+ warnings = Fcons (QCrevocation_data_issued_in_future, warnings);
if (verification & GNUTLS_CERT_SIGNER_CONSTRAINTS_FAILURE)
- warnings = Fcons (intern (":signer-constraints-failure"), warnings);
+ warnings = Fcons (QCsigner_constraints_failure, warnings);
# if GNUTLS_VERSION_NUMBER >= 0x030400
if (verification & GNUTLS_CERT_PURPOSE_MISMATCH)
- warnings = Fcons (intern (":purpose-mismatch"), warnings);
+ warnings = Fcons (QCpurpose_mismatch, warnings);
# if GNUTLS_VERSION_NUMBER >= 0x030501
if (verification & GNUTLS_CERT_MISSING_OCSP_STATUS)
- warnings = Fcons (intern (":missing-ocsp-status"), warnings);
+ warnings = Fcons (QCmissing_ocsp_status, warnings);
if (verification & GNUTLS_CERT_INVALID_OCSP_STATUS)
- warnings = Fcons (intern (":invalid-ocsp-status"), warnings);
+ warnings = Fcons (QCinvalid_ocsp_status, warnings);
# endif
# endif
# endif
@@ -1462,17 +1462,17 @@ returned as the :certificate entry. */)
if (XPROCESS (proc)->gnutls_extra_peer_verification &
CERTIFICATE_NOT_MATCHING)
- warnings = Fcons (intern (":no-host-match"), warnings);
+ warnings = Fcons (QCno_host_match, warnings);
/* This could get called in the INIT stage, when the certificate is
not yet set. */
if (XPROCESS (proc)->gnutls_certificates != NULL &&
gnutls_x509_crt_check_issuer(XPROCESS (proc)->gnutls_certificates[0],
XPROCESS (proc)->gnutls_certificates[0]))
- warnings = Fcons (intern (":self-signed"), warnings);
+ warnings = Fcons (QCself_signed, warnings);
if (!NILP (warnings))
- result = list2 (intern (":warnings"), warnings);
+ result = list2 (QCwarnings, warnings);
/* This could get called in the INIT stage, when the certificate is
not yet set. */
@@ -1485,11 +1485,11 @@ returned as the :certificate entry. */)
certs = nconc2 (certs, list1 (emacs_gnutls_certificate_details
(XPROCESS
(proc)->gnutls_certificates[i])));
- result = nconc2 (result, list2 (intern (":certificates"), certs));
+ result = nconc2 (result, list2 (QCcertificates, certs));
/* Return the host certificate in its own element for
compatibility reasons. */
- result = nconc2 (result, list2 (intern (":certificate"), Fcar (certs)));
+ result = nconc2 (result, list2 (QCcertificate, Fcar (certs)));
}
state = XPROCESS (proc)->gnutls_state;
@@ -1499,38 +1499,38 @@ returned as the :certificate entry. */)
int bits = gnutls_dh_get_prime_bits (state);
check_memory_full (bits);
if (bits > 0)
- result = nconc2 (result, list2 (intern (":diffie-hellman-prime-bits"),
+ result = nconc2 (result, list2 (QCdiffie_hellman_prime_bits,
make_fixnum (bits)));
}
/* Key exchange. */
result = nconc2
- (result, list2 (intern (":key-exchange"),
+ (result, list2 (QCkey_exchange,
build_string (gnutls_kx_get_name
(gnutls_kx_get (state)))));
/* Protocol name. */
gnutls_protocol_t proto = gnutls_protocol_get_version (state);
result = nconc2
- (result, list2 (intern (":protocol"),
+ (result, list2 (QCprotocol,
build_string (gnutls_protocol_get_name (proto))));
/* Cipher name. */
result = nconc2
- (result, list2 (intern (":cipher"),
+ (result, list2 (QCcipher,
build_string (gnutls_cipher_get_name
(gnutls_cipher_get (state)))));
/* MAC name. */
result = nconc2
- (result, list2 (intern (":mac"),
+ (result, list2 (QCmac,
build_string (gnutls_mac_get_name
(gnutls_mac_get (state)))));
/* Compression name. */
# ifdef HAVE_GNUTLS_COMPRESSION_GET
result = nconc2
- (result, list2 (intern (":compression"),
+ (result, list2 (QCcompression,
build_string (gnutls_compression_get_name
(gnutls_compression_get (state)))));
# endif
@@ -1538,14 +1538,14 @@ returned as the :certificate entry. */)
/* Encrypt-then-MAC. */
# ifdef HAVE_GNUTLS_ETM_STATUS
result = nconc2
- (result, list2 (intern (":encrypt-then-mac"),
+ (result, list2 (QCencrypt_then_mac,
gnutls_session_etm_status (state) ? Qt : Qnil));
# endif
/* Renegotiation Indication */
if (proto <= GNUTLS_TLS1_2)
result = nconc2
- (result, list2 (intern (":safe-renegotiation"),
+ (result, list2 (QCsafe_renegotiation,
gnutls_safe_renegotiation_status (state) ? Qt : Qnil));
return result;
@@ -1701,7 +1701,7 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object
proplist)
p->gnutls_peer_verification = peer_verification;
- warnings = plist_get (Fgnutls_peer_status (proc), intern (":warnings"));
+ warnings = plist_get (Fgnutls_peer_status (proc), QCwarnings);
if (!NILP (warnings))
{
for (Lisp_Object tail = warnings; CONSP (tail); tail = XCDR (tail))
@@ -2953,22 +2953,22 @@ Any GnuTLS extension with ID up to 100
return Qnil;
# endif /* WINDOWSNT */
- capabilities = Fcons (intern("gnutls"), capabilities);
+ capabilities = Fcons (Qgnutls, capabilities);
# ifdef HAVE_GNUTLS_EXT__DUMBFW
- capabilities = Fcons (intern("ClientHello Padding"), capabilities);
+ capabilities = Fcons (QClientHello_Padding, capabilities);
# endif
# ifdef HAVE_GNUTLS3
- capabilities = Fcons (intern("gnutls3"), capabilities);
- capabilities = Fcons (intern("digests"), capabilities);
- capabilities = Fcons (intern("ciphers"), capabilities);
+ capabilities = Fcons (Qgnutls3, capabilities);
+ capabilities = Fcons (Qdigests, capabilities);
+ capabilities = Fcons (Qciphers, capabilities);
# ifdef HAVE_GNUTLS_AEAD
- capabilities = Fcons (intern("AEAD-ciphers"), capabilities);
+ capabilities = Fcons (QAEAD_ciphers, capabilities);
# endif
- capabilities = Fcons (intern("macs"), capabilities);
+ capabilities = Fcons (Qmacs, capabilities);
# ifdef HAVE_GNUTLS_EXT_GET_NAME
for (unsigned int ext=0; ext < 100; ext++)
@@ -3119,4 +3119,55 @@ are as per the GnuTLS logging conventions. */);
#endif /* HAVE_GNUTLS */
defsubr (&Sgnutls_available_p);
+
+ DEFSYM (QAEAD_ciphers, "AEAD-ciphers");
+ DEFSYM (QCcertificate, ":certificate");
+ DEFSYM (QCcertificate_id, ":certificate-id");
+ DEFSYM (QCcertificate_security_level, ":certificate-security-level");
+ DEFSYM (QCcertificates, ":certificates");
+ DEFSYM (QCcipher, ":cipher");
+ DEFSYM (QCcompression, ":compression");
+ DEFSYM (QCdiffie_hellman_prime_bits, ":diffie-hellman-prime-bits");
+ DEFSYM (QCencrypt_then_mac, ":encrypt-then-mac");
+ DEFSYM (QCexpired, ":expired");
+ DEFSYM (QCinsecure, ":insecure");
+ DEFSYM (QCinvalid, ":invalid");
+ DEFSYM (QCinvalid_ocsp_status, ":invalid-ocsp-status");
+ DEFSYM (QCissuer, ":issuer");
+ DEFSYM (QCissuer_unique_id, ":issuer-unique-id");
+ DEFSYM (QCkey_exchange, ":key-exchange");
+ DEFSYM (QClientHello_Padding, "ClientHello Padding");
+ DEFSYM (QCmac, ":mac");
+ DEFSYM (QCmissing_ocsp_status, ":missing-ocsp-status");
+ DEFSYM (QCno_host_match, ":no-host-match");
+ DEFSYM (QCnot_activated, ":not-activated");
+ DEFSYM (QCnot_ca, ":not-ca");
+ DEFSYM (QCpem, ":pem");
+ DEFSYM (QCprotocol, ":protocol");
+ DEFSYM (QCpublic_key_algorithm, ":public-key-algorithm");
+ DEFSYM (QCpublic_key_id, ":public-key-id");
+ DEFSYM (QCpublic_key_id_sha256, ":public-key-id-sha256");
+ DEFSYM (QCpurpose_mismatch, ":purpose-mismatch");
+ DEFSYM (QCrevocation_data_issued_in_future,
+ ":revocation-data-issued-in-future");
+ DEFSYM (QCrevocation_data_superseded, ":revocation-data-superseded");
+ DEFSYM (QCrevoked, ":revoked");
+ DEFSYM (QCsafe_renegotiation, ":safe-renegotiation");
+ DEFSYM (QCself_signed, ":self-signed");
+ DEFSYM (QCserial_number, ":serial-number");
+ DEFSYM (QCsignature_algorithm, ":signature-algorithm");
+ DEFSYM (QCsignature_failure, ":signature-failure");
+ DEFSYM (QCsigner_constraints_failure, ":signer-constraints-failure");
+ DEFSYM (QCsubject, ":subject");
+ DEFSYM (QCsubject_unique_id, ":subject-unique-id");
+ DEFSYM (QCunknown_ca, ":unknown-ca");
+ DEFSYM (QCvalid_from, ":valid-from");
+ DEFSYM (QCvalid_to, ":valid-to");
+ DEFSYM (QCversion, ":version");
+ DEFSYM (QCwarnings, ":warnings");
+ DEFSYM (Qciphers, "ciphers");
+ DEFSYM (Qdigests, "digests");
+ DEFSYM (Qgnutls, "gnutls");
+ DEFSYM (Qgnutls3, "gnutls3");
+ DEFSYM (Qmacs, "macs");
}
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 31e0b915000..226c850baf6 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -1474,8 +1474,7 @@ style_changed_cb (GObject *go,
EVENT_INIT (event);
event.kind = CONFIG_CHANGED_EVENT;
event.frame_or_window = build_string (display_name);
- /* Theme doesn't change often, so intern is called seldom. */
- event.arg = intern ("theme-name");
+ event.arg = Qtheme_name;
kbd_buffer_store_event (&event);
update_theme_scrollbar_width ();
@@ -5546,8 +5545,8 @@ find_rtl_image (struct frame *f, Lisp_Object image,
Lisp_Object rtl)
Lisp_Object rtl_image = PROP (TOOL_BAR_ITEM_IMAGES);
if (!NILP (file = file_for_image (rtl_image)))
{
- file = call1 (intern ("file-name-sans-extension"),
- Ffile_name_nondirectory (file));
+ file = call1 (Qfile_name_sans_extension,
+ Ffile_name_nondirectory (file));
if (! NILP (Fequal (file, rtl_name)))
{
image = rtl_image;
diff --git a/src/haikuterm.c b/src/haikuterm.c
index 135f99dbdcb..c194a348df3 100644
--- a/src/haikuterm.c
+++ b/src/haikuterm.c
@@ -804,6 +804,86 @@ haiku_draw_underwave (struct glyph_string *s, int width,
int x)
BView_EndClip (view);
}
+/* Draw a dashed underline of thickness THICKNESS and width WIDTH onto F
+ at a vertical offset of OFFSET from the position of the glyph string
+ S, with each segment SEGMENT pixels in length. */
+
+static void
+haiku_draw_dash (struct frame *f, struct glyph_string *s, int width,
+ int segment, int offset, int thickness)
+{
+ int y_center, which, length, x, doffset;
+ void *view;
+
+ /* Configure the thickness of the view's strokes. */
+ view = FRAME_HAIKU_VIEW (s->f);
+ BView_SetPenSize (view, thickness);
+
+ /* Offset the origin of the line by half the line width. */
+ y_center = s->ybase + offset + thickness / 2;
+
+ /* Remove redundant portions of OFFSET. */
+ doffset = s->x % (segment * 2);
+
+ /* Set which to the phase of the first dash that ought to be drawn and
+ length to its length. */
+ which = doffset < segment;
+ length = segment - (s->x % segment);
+
+ /* Begin drawing this dash. */
+ for (x = s->x; x < s->x + width; x += length, length = segment)
+ {
+ if (which)
+ BView_StrokeLine (view, x, y_center,
+ min (x + length - 1,
+ s->x + width - 1),
+ y_center);
+
+ which = !which;
+ }
+}
+
+/* Draw an underline of STYLE onto F at an offset of POSITION from the
+ baseline of the glyph string S, S->WIDTH in length, and THICKNESS in
+ height. */
+
+static void
+haiku_fill_underline (struct frame *f, struct glyph_string *s,
+ enum face_underline_type style, int position,
+ int thickness)
+{
+ int segment;
+ void *view;
+
+ segment = thickness * 3;
+ view = FRAME_HAIKU_VIEW (f);
+
+ switch (style)
+ {
+ /* FACE_UNDERLINE_DOUBLE_LINE is treated identically to SINGLE, as
+ the second line will be filled by another invocation of this
+ function. */
+ case FACE_UNDERLINE_SINGLE:
+ case FACE_UNDERLINE_DOUBLE_LINE:
+ BView_FillRectangle (view, s->x, s->ybase + position,
+ s->width, thickness);
+ break;
+
+ case FACE_UNDERLINE_DOTS:
+ segment = thickness;
+ FALLTHROUGH;
+
+ case FACE_UNDERLINE_DASHES:
+ haiku_draw_dash (f, s, s->width, segment, position, thickness);
+ break;
+
+ case FACE_NO_UNDERLINE:
+ case FACE_UNDERLINE_WAVE:
+ default:
+ emacs_abort ();
+ }
+}
+
static void
haiku_draw_text_decoration (struct glyph_string *s, struct face *face,
int width, int x)
@@ -827,15 +907,15 @@ haiku_draw_text_decoration (struct glyph_string *s,
struct face *face,
else
BView_SetHighColor (view, face->foreground);
- if (face->underline == FACE_UNDER_WAVE)
+ if (face->underline == FACE_UNDERLINE_WAVE)
haiku_draw_underwave (s, width, x);
- else if (face->underline == FACE_UNDER_LINE)
+ else if (face->underline >= FACE_UNDERLINE_SINGLE)
{
unsigned long thickness, position;
- int y;
if (s->prev
- && s->prev->face->underline == FACE_UNDER_LINE
+ && (s->prev->face->underline != FACE_UNDERLINE_WAVE
+ && s->prev->face->underline >= FACE_UNDERLINE_SINGLE)
&& (s->prev->face->underline_at_descent_line_p
== s->face->underline_at_descent_line_p)
&& (s->prev->face->underline_pixels_above_descent_line
@@ -908,9 +988,20 @@ haiku_draw_text_decoration (struct glyph_string *s, struct
face *face,
thickness = (s->y + s->height) - (s->ybase + position);
s->underline_thickness = thickness;
s->underline_position = position;
- y = s->ybase + position;
- BView_FillRectangle (view, s->x, y, s->width, thickness);
+ haiku_fill_underline (s->f, s, s->face->underline,
+ position, thickness);
+
+ /* Place a second underline above the first if this was
+ requested in the face specification. */
+
+ if (s->face->underline == FACE_UNDERLINE_DOUBLE_LINE)
+ {
+ /* Compute the position of the second underline. */
+ position = position - thickness - 1;
+ haiku_fill_underline (s->f, s, s->face->underline,
+ position, thickness);
+ }
}
}
diff --git a/src/hbfont.c b/src/hbfont.c
index 40bb44c7d04..37ed4132492 100644
--- a/src/hbfont.c
+++ b/src/hbfont.c
@@ -552,6 +552,8 @@ hbfont_shape (Lisp_Object lgstring, Lisp_Object direction)
cluster_offset = to - from;
}
+ eassume (0 <= from);
+
/* All the glyphs in a cluster have the same values of FROM and TO. */
LGLYPH_SET_FROM (lglyph, from);
/* This heuristic is for when the Lisp shape-gstring function
diff --git a/src/image.c b/src/image.c
index 7fcc0e4d9b2..12326b67158 100644
--- a/src/image.c
+++ b/src/image.c
@@ -199,6 +199,9 @@ typedef android_pixmap Pixmap;
#define GREEN16_FROM_ULONG(color) (GREEN_FROM_ULONG (color) * 0x101)
#define BLUE16_FROM_ULONG(color) (BLUE_FROM_ULONG (color) * 0x101)
+/* DPYINFO->n_planes is unsuitable for this file, because it accepts
+ values that may not be supported for pixmap creation. */
+#define n_planes n_image_planes
#endif
static void image_disable_image (struct frame *, struct image *);
@@ -420,7 +423,7 @@ x_bitmap_stipple (struct frame *f, Pixmap pixmap)
#endif /* USE_CAIRO */
#endif
-#if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI)
+#if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (HAVE_ANDROID)
ptrdiff_t
image_bitmap_pixmap (struct frame *f, ptrdiff_t id)
{
@@ -764,7 +767,6 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object
file)
ptrdiff_t id, size;
int fd, width, height, rc;
char *contents, *data;
- void *bitmap;
if (!STRINGP (image_find_image_fd (file, &fd)))
return -1;
@@ -955,10 +957,17 @@ image_create_bitmap_from_file (struct frame *f,
Lisp_Object file)
}
}
- /* Search bitmap-file-path for the file, if appropriate. */
- if (openp (Vx_bitmap_file_path, file, Qnil, &found,
- make_fixnum (R_OK), false, false, NULL)
- < 0)
+ /* Search bitmap-file-path for the file, if appropriate. If no file
+ extension or directory is specified and no file by this name
+ exists, append the extension ".xbm" and retry. */
+ if ((openp (Vx_bitmap_file_path, file, Qnil, &found,
+ make_fixnum (R_OK), false, false, NULL) < 0)
+ && (NILP (Fequal (Ffile_name_nondirectory (file), file))
+ || strrchr (SSDATA (file), '.')
+ || (openp (Vx_bitmap_file_path,
+ CALLN (Fconcat, file, build_string (".xbm")),
+ Qnil, &found, make_fixnum (R_OK), false, false,
+ NULL) < 0)))
return -1;
if (!STRINGP (image_find_image_fd (file, &fd))
@@ -6260,6 +6269,8 @@ xpm_load_image (struct frame *f,
expect (',');
XSETFRAME (frame, f);
+
+#ifndef HAVE_ANDROID
if (!NILP (Fxw_display_color_p (frame)))
best_key = XPM_COLOR_KEY_C;
else if (!NILP (Fx_display_grayscale_p (frame)))
@@ -6267,6 +6278,14 @@ xpm_load_image (struct frame *f,
? XPM_COLOR_KEY_G : XPM_COLOR_KEY_G4);
else
best_key = XPM_COLOR_KEY_M;
+#else /* HAVE_ANDROID */
+ /* The color-loading loop has not been taught to progressively settle
+ for less optimal color keys if no colors are defined for best_key,
+ and since libXpm is not available on Android, there is no better
+ option than delegating the task of mapping whatever color values
+ are provided to B/W or grayscale to the display driver. */
+ best_key = XPM_COLOR_KEY_C;
+#endif /* !HAVE_ANDROID */
color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
if (chars_per_pixel == 1)
@@ -10735,14 +10754,14 @@ imagemagick_error (MagickWand *wand)
static char *
imagemagick_filename_hint (Lisp_Object spec, char hint_buffer[MaxTextExtent])
{
- Lisp_Object symbol = intern ("image-format-suffixes");
+ Lisp_Object symbol = Qimage_format_suffixes;
Lisp_Object val = find_symbol_value (symbol);
Lisp_Object format;
if (! CONSP (val))
return NULL;
- format = image_spec_value (spec, intern (":format"), NULL);
+ format = image_spec_value (spec, QCformat, NULL);
val = Fcar_safe (Fcdr_safe (Fassq (format, val)));
if (! STRINGP (val))
return NULL;
@@ -12491,7 +12510,7 @@ gs_load (struct frame *f, struct image *img)
XSETFRAME (frame, f);
loader = image_spec_value (img->spec, QCloader, NULL);
if (NILP (loader))
- loader = intern ("gs-load-image");
+ loader = Qgs_load_image;
img->lisp_data = call6 (loader, frame, img->spec,
make_fixnum (img->width),
@@ -12758,7 +12777,7 @@ static struct image_type const image_types[] =
};
#if HAVE_NATIVE_IMAGE_API
-struct image_type native_image_type =
+static struct image_type native_image_type =
{ SYMBOL_INDEX (Qnative_image), native_image_p, native_image_load,
image_clear_image };
#endif
@@ -12867,6 +12886,7 @@ non-numeric, there is no explicit limit on the size of
images. */);
DEFSYM (QCloader, ":loader");
DEFSYM (QCpt_width, ":pt-width");
DEFSYM (QCpt_height, ":pt-height");
+ DEFSYM (Qgs_load_image, "gs-load-image");
#endif /* HAVE_GHOSTSCRIPT */
#ifdef HAVE_NTGUI
@@ -13046,5 +13066,8 @@ The options are:
*/);
/* MagickExportImagePixels is in 6.4.6-9, but not 6.4.4-10. */
imagemagick_render_type = 0;
-#endif
+
+ DEFSYM (Qimage_format_suffixes, "image-format-suffixes");
+ DEFSYM (QCformat, ":format");
+#endif /* HAVE_IMAGEMAGICK */
}
diff --git a/src/intervals.c b/src/intervals.c
index 2ab19c2cc56..c7a1f81e4ee 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -2388,17 +2388,18 @@ set_intervals_multibyte_1 (INTERVAL i, bool multi_flag,
to this interval. */
if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
{
- if ((i)->left)
+ if (i->left)
{
set_interval_plist (i, i->left->plist);
- (i)->left->total_length = 0;
+ i->left->total_length = 0;
delete_interval ((i)->left);
}
else
{
+ eassume (i->right);
set_interval_plist (i, i->right->plist);
- (i)->right->total_length = 0;
- delete_interval ((i)->right);
+ i->right->total_length = 0;
+ delete_interval (i->right);
}
}
}
diff --git a/src/intervals.h b/src/intervals.h
index 610c803cc77..5718874543a 100644
--- a/src/intervals.h
+++ b/src/intervals.h
@@ -204,14 +204,21 @@ set_interval_plist (INTERVAL i, Lisp_Object plist)
#define INTERVAL_VISIBLE_P(i) \
(i && NILP (textget ((i)->plist, Qinvisible)))
-/* Is this interval writable? Replace later with cache access. */
-#define INTERVAL_WRITABLE_P(i) \
- (NILP (textget ((i)->plist, Qread_only)) \
- || !NILP (textget ((i)->plist, Qinhibit_read_only)) \
- || ((CONSP (Vinhibit_read_only) \
- ? !NILP (Fmemq (textget ((i)->plist, Qread_only), \
- Vinhibit_read_only)) \
- : !NILP (Vinhibit_read_only))))
+/* Is this interval writable by virtue of not being marked read-only
+ by the 'read-only' property (passed via RO), or due to the general
+ value of Vinhibit_read_only? Replace later with cache access. */
+#define INTERVAL_GENERALLY_WRITABLE_P(i, ro) \
+ (NILP (ro) || (!NILP (Vinhibit_read_only) \
+ && !CONSP (Vinhibit_read_only)))
+
+/* Is this interval writable by virtue of its explicit
+ 'inhibit-read-only' property, or due to the presence of its
+ 'read-only' property (passed via RO) in Vinhibit_read_only list? */
+#define INTERVAL_EXPRESSLY_WRITABLE_P(i, ro) \
+ (!NILP (textget ((i)->plist, Qinhibit_read_only)) \
+ || (!NILP (ro) \
+ && CONSP (Vinhibit_read_only) \
+ && !NILP (Fmemq ((ro), Vinhibit_read_only))))
/* Macros to tell whether insertions before or after this interval
should stick to it. Now we have Vtext_property_default_nonsticky,
diff --git a/src/keyboard.c b/src/keyboard.c
index 80ecb204cf4..21c4bbd7b2f 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -99,6 +99,7 @@ char const DEV_TTY[] = "CONOUT$";
#else
char const DEV_TTY[] = "/dev/tty";
#endif
+char *dev_tty; /* set by init_keyboard */
/* Variables for blockinput.h: */
@@ -1646,7 +1647,7 @@ command_loop_1 (void)
}
if (current_buffer != prev_buffer || MODIFF != prev_modiff)
- run_hook (intern ("activate-mark-hook"));
+ run_hook (Qactivate_mark_hook);
}
Vsaved_region_selection = Qnil;
@@ -3077,7 +3078,7 @@ read_char (int commandflag, Lisp_Object map,
#ifdef HAVE_NS
if (CONSP (c)
- && (EQ (XCAR (c), intern ("ns-unput-working-text"))))
+ && (EQ (XCAR (c), Qns_unput_working_text)))
input_was_pending = input_pending;
#endif
@@ -3650,6 +3651,7 @@ readable_events (int flags)
}
/* Set this for debugging, to have a way to get out */
+extern int stop_character;
int stop_character EXTERNALLY_VISIBLE;
static KBOARD *
@@ -4603,7 +4605,7 @@ timer_start_idle (void)
timer_last_idleness_start_time = timer_idleness_start_time;
/* Mark all idle-time timers as once again candidates for running. */
- call0 (intern ("internal-timer-start-idle"));
+ call0 (Qinternal_timer_start_idle);
}
/* Record that Emacs is no longer idle, so stop running idle-time timers. */
@@ -5025,7 +5027,7 @@ static const char *const lispy_accent_keys[] =
merely abstruse terminology for the ``select'' key frequently
located in certain physical keyboards. */
-const char *const lispy_function_keys[] =
+static const char *const lispy_function_keys[] =
{
/* All elements in this array default to 0, except for the few
function keys that Emacs recognizes. */
@@ -5399,6 +5401,10 @@ static const char *const lispy_kana_keys[] =
/* You'll notice that this table is arranged to be conveniently
indexed by X Windows keysym values. */
+#ifdef HAVE_NS
+/* FIXME: Why are we using X11 keysym values for NS? */
+static
+#endif
const char *const lispy_function_keys[] =
{
/* X Keysym value */
@@ -10133,7 +10139,7 @@ read_char_minibuf_menu_prompt (int commandflag,
}
/* Prompt with that and read response. */
- message3_nolog (apply1 (intern ("concat"), Fnreverse (menu_strings)));
+ message3_nolog (apply1 (Qconcat, Fnreverse (menu_strings)));
/* Make believe it's not a keyboard macro in case the help char
is pressed. Help characters are not recorded because menu prompting
@@ -11910,7 +11916,7 @@ On such systems, Emacs starts a subshell instead of
suspending. */)
if (!NILP (stuffstring))
CHECK_STRING (stuffstring);
- run_hook (intern ("suspend-hook"));
+ run_hook (Qsuspend_hook);
get_tty_size (fileno (CURTTY ()->input), &old_width, &old_height);
reset_all_sys_modes ();
@@ -11931,7 +11937,7 @@ On such systems, Emacs starts a subshell instead of
suspending. */)
if (width != old_width || height != old_height)
change_frame_size (SELECTED_FRAME (), width, height, false, false, false);
- run_hook (intern ("suspend-resume-hook"));
+ run_hook (Qsuspend_resume_hook);
return Qnil;
}
@@ -12008,7 +12014,7 @@ static void
handle_interrupt_signal (int sig)
{
/* See if we have an active terminal on our controlling tty. */
- struct terminal *terminal = get_named_terminal (DEV_TTY);
+ struct terminal *terminal = get_named_terminal (dev_tty);
if (!terminal)
{
/* If there are no frames there, let's pretend that we are a
@@ -12077,7 +12083,7 @@ handle_interrupt (bool in_signal_handler)
cancel_echoing ();
/* XXX This code needs to be revised for multi-tty support. */
- if (!NILP (Vquit_flag) && get_named_terminal (DEV_TTY))
+ if (!NILP (Vquit_flag) && get_named_terminal (dev_tty))
{
if (! in_signal_handler)
{
@@ -12370,7 +12376,7 @@ process.
See also `current-input-mode'. */)
(Lisp_Object quit)
{
- struct terminal *t = get_named_terminal (DEV_TTY);
+ struct terminal *t = get_named_terminal (dev_tty);
struct tty_display_info *tty;
if (!t)
@@ -12619,6 +12625,7 @@ void
delete_kboard (KBOARD *kb)
{
KBOARD **kbp;
+ struct thread_state *thread;
for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
if (*kbp == NULL)
@@ -12636,6 +12643,21 @@ delete_kboard (KBOARD *kb)
emacs_abort ();
}
+ /* Clean thread specpdls of references to this KBOARD. */
+ for (thread = all_threads; thread; thread = thread->next_thread)
+ {
+ union specbinding *p;
+
+ for (p = thread->m_specpdl_ptr; p > thread->m_specpdl;)
+ {
+ p -= 1;
+
+ if (p->kind == SPECPDL_LET
+ && p->let.where.kbd == kb)
+ p->let.where.kbd = NULL;
+ }
+ }
+
wipe_kboard (kb);
#ifdef HAVE_MPS
igc_xfree (kb);
@@ -13721,7 +13743,7 @@ you could say something like:
Also see `set-message-function' (which controls how non-error messages
are displayed). */);
- Vcommand_error_function = intern ("command-error-default-function");
+ Vcommand_error_function = Qcommand_error_default_function;
DEFVAR_LISP ("enable-disabled-menus-and-buttons",
Venable_disabled_menus_and_buttons,
@@ -13771,7 +13793,7 @@ of processing the event normally through
`special-event-map'.
Currently, the only supported values for this
variable are `sigusr1' and `sigusr2'. */);
- Vdebug_on_event = intern_c_string ("sigusr2");
+ Vdebug_on_event = Qsigusr2;
DEFVAR_BOOL ("attempt-stack-overflow-recovery",
attempt_stack_overflow_recovery,
@@ -13873,6 +13895,15 @@ function is called to remap that sequence. */);
DEFSYM (Qcurrent_key_remap_sequence, "current-key-remap-sequence");
pdumper_do_now_and_after_load (syms_of_keyboard_for_pdumper);
+
+ DEFSYM (Qactivate_mark_hook, "activate-mark-hook");
+ DEFSYM (Qns_unput_working_text, "ns-unput-working-text");
+ DEFSYM (Qinternal_timer_start_idle, "internal-timer-start-idle");
+ DEFSYM (Qconcat, "concat");
+ DEFSYM (Qsuspend_hook, "suspend-hook");
+ DEFSYM (Qsuspend_resume_hook, "suspend-resume-hook");
+ DEFSYM (Qcommand_error_default_function, "command-error-default-function");
+ DEFSYM (Qsigusr2, "sigusr2");
}
static void
diff --git a/src/keyboard.h b/src/keyboard.h
index 2ce003fd444..c7ae1f7f0fa 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -78,7 +78,6 @@ INLINE_HEADER_BEGIN
When Emacs goes back to the any-kboard state, it looks at all the KBOARDs
to find those; and it tries processing their input right away. */
-typedef struct kboard KBOARD;
struct kboard
{
KBOARD *next_kboard;
@@ -521,6 +520,9 @@ extern void mark_kboards (void);
extern const char *const lispy_function_keys[];
#endif
+/* Terminal device used by Emacs for terminal I/O. */
+extern char *dev_tty;
+/* Initial value for dev_tty. */
extern char const DEV_TTY[];
INLINE_HEADER_END
diff --git a/src/keymap.c b/src/keymap.c
index 10378767c65..0f50d804dff 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -642,7 +642,7 @@ usage: (map-keymap FUNCTION KEYMAP) */)
(Lisp_Object function, Lisp_Object keymap, Lisp_Object sort_first)
{
if (! NILP (sort_first))
- return call2 (intern ("map-keymap-sorted"), function, keymap);
+ return call2 (Qmap_keymap_sorted, function, keymap);
map_keymap (keymap, map_keymap_call, function, NULL, 1);
return Qnil;
@@ -1334,7 +1334,7 @@ recognize the default bindings, just as
`read-key-sequence' does. */)
/* Initialize the unicode case table, if it wasn't already. */
if (NILP (unicode_case_table))
{
- unicode_case_table = uniprop_table (intern ("lowercase"));
+ unicode_case_table = uniprop_table (Qlowercase);
/* uni-lowercase.el might be unavailable during bootstrap. */
if (NILP (unicode_case_table))
return found;
@@ -2125,7 +2125,7 @@ For an approximate inverse of this, see `kbd'. */)
if (STRINGP (list))
{
int c = fetch_string_char_advance (list, &i, &i_byte);
- if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
+ if (!STRING_MULTIBYTE (list) && (c & 0200))
c ^= 0200 | meta_modifier;
key = make_fixnum (c);
}
@@ -3053,7 +3053,7 @@ DESCRIBER is the output function used; nil means use
`princ'. */)
{
specpdl_ref count = SPECPDL_INDEX ();
if (NILP (describer))
- describer = intern ("princ");
+ describer = Qprinc;
specbind (Qstandard_output, Fcurrent_buffer ());
CHECK_VECTOR_OR_CHAR_TABLE (vector);
describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
@@ -3169,7 +3169,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix,
Lisp_Object args,
Lisp_Object kludge = make_nil_vector (1);
if (partial)
- suppress = intern ("suppress-keymap");
+ suppress = Qsuppress_keymap;
/* STOP is a boundary between normal characters (-#x3FFF7F) and
8-bit characters (#x3FFF80-), used below when VECTOR is a
@@ -3342,6 +3342,7 @@ syms_of_keymap (void)
{
DEFSYM (Qkeymap, "keymap");
DEFSYM (Qhelp__describe_map_tree, "help--describe-map-tree");
+ DEFSYM (Qmap_keymap_sorted, "map-keymap-sorted");
DEFSYM (Qkeymap_canonicalize, "keymap-canonicalize");
@@ -3485,6 +3486,7 @@ that describe key bindings. That is why the default is
nil. */);
DEFSYM (Qkey_parse, "key-parse");
DEFSYM (Qkey_valid_p, "key-valid-p");
-
DEFSYM (Qnon_key_event, "non-key-event");
+ DEFSYM (Qprinc, "princ");
+ DEFSYM (Qsuppress_keymap, "suppress-keymap");
}
diff --git a/src/lisp.h b/src/lisp.h
index d0e20a0bcb1..810bc41a120 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -23,6 +23,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <alloca.h>
#include <setjmp.h>
#include <stdarg.h>
+#include <stdbit.h>
#include <stdckdint.h>
#include <stddef.h>
#include <string.h>
@@ -37,7 +38,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <attribute.h>
#include <byteswap.h>
-#include <count-leading-zeros.h>
#include <intprops.h>
#include <verify.h>
@@ -59,7 +59,8 @@ void igc_check_fwd (void *);
#define DECLARE_GDB_SYM(type, id) type const id EXTERNALLY_VISIBLE
#ifdef MAIN_PROGRAM
-# define DEFINE_GDB_SYMBOL_BEGIN(type, id) DECLARE_GDB_SYM (type, id)
+# define DEFINE_GDB_SYMBOL_BEGIN(type, id) \
+ extern DECLARE_GDB_SYM (type, id); DECLARE_GDB_SYM (type, id)
# define DEFINE_GDB_SYMBOL_END(id) = id;
#else
# define DEFINE_GDB_SYMBOL_BEGIN(type, id) extern DECLARE_GDB_SYM (type, id)
@@ -1055,7 +1056,7 @@ enum pvec_type
PVEC_WEAK_REF,
/* These should be last, for internal_equal and sxhash_obj. */
- PVEC_COMPILED,
+ PVEC_CLOSURE,
PVEC_CHAR_TABLE,
PVEC_SUB_CHAR_TABLE,
PVEC_RECORD,
@@ -2574,7 +2575,7 @@ struct hash_impl;
/* 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 unsigned int hash_hash_t;
typedef enum {
Test_eql,
@@ -2863,10 +2864,14 @@ 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);
+ (avoiding a 64-bit multiply on typical platforms). */
+ unsigned int h = hash;
+ unsigned int alpha = 2654435769; /* 2**32/phi */
+ /* Multiply with unsigned int, ANDing in case UINT_WIDTH exceeds 32. */
+ unsigned int product = (h * alpha) & 0xffffffffu;
+ /* Convert to a wider type, so that the shift works when BITS == 0. */
+ unsigned long long int wide_product = product;
+ return wide_product >> (32 - bits);
}
@@ -3234,6 +3239,13 @@ XBUFFER_OBJFWD (lispfwd a)
eassert (BUFFER_OBJFWDP (a));
return a.fwdptr;
}
+
+INLINE bool
+KBOARD_OBJFWDP (lispfwd a)
+{
+ return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj;
+}
+
/* Lisp floating point type. */
struct Lisp_Float
@@ -3283,16 +3295,16 @@ XFLOAT_DATA (Lisp_Object f)
#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
&& FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
-/* Meanings of slots in a Lisp_Compiled: */
+/* Meanings of slots in a Lisp_Closure: */
-enum Lisp_Compiled
+enum Lisp_Closure
{
- COMPILED_ARGLIST = 0,
- COMPILED_BYTECODE = 1,
- COMPILED_CONSTANTS = 2,
- COMPILED_STACK_DEPTH = 3,
- COMPILED_DOC_STRING = 4,
- COMPILED_INTERACTIVE = 5
+ CLOSURE_ARGLIST = 0,
+ CLOSURE_CODE = 1,
+ CLOSURE_CONSTANTS = 2,
+ CLOSURE_STACK_DEPTH = 3,
+ CLOSURE_DOC_STRING = 4,
+ CLOSURE_INTERACTIVE = 5
};
/* Flag bits in a character. These also get used in termhooks.h.
@@ -3367,9 +3379,9 @@ WINDOW_CONFIGURATIONP (Lisp_Object a)
}
INLINE bool
-COMPILEDP (Lisp_Object a)
+CLOSUREP (Lisp_Object a)
{
- return PSEUDOVECTORP (a, PVEC_COMPILED);
+ return PSEUDOVECTORP (a, PVEC_CLOSURE);
}
INLINE bool
@@ -3653,13 +3665,16 @@ enum specbind_tag
#ifdef HAVE_MODULES
SPECPDL_MODULE_RUNTIME, /* A live module runtime. */
SPECPDL_MODULE_ENVIRONMENT, /* A live module environment. */
-#endif
+#endif /* !HAVE_MODULES */
SPECPDL_LET, /* A plain and simple dynamic let-binding. */
/* Tags greater than SPECPDL_LET must be "subkinds" of LET. */
SPECPDL_LET_LOCAL, /* A buffer-local let-binding. */
SPECPDL_LET_DEFAULT /* A global binding for a localized var. */
};
+/* struct kboard is defined in keyboard.h. */
+typedef struct kboard KBOARD;
+
union specbinding
{
/* Aligning similar members consistently might help efficiency slightly
@@ -3702,8 +3717,17 @@ union specbinding
} unwind_void;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
- /* `where' is not used in the case of SPECPDL_LET. */
- Lisp_Object symbol, old_value, where;
+ /* `where' is not used in the case of SPECPDL_LET,
+ unless the symbol is forwarded to a KBOARD. */
+ Lisp_Object symbol, old_value;
+ union {
+ /* KBOARD object to which SYMBOL forwards, in the case of
+ SPECPDL_LET. */
+ KBOARD *kbd;
+
+ /* Buffer otherwise. */
+ Lisp_Object buf;
+ } where;
} let;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
@@ -4208,11 +4232,12 @@ integer_to_uintmax (Lisp_Object num, uintmax_t *n)
}
}
-/* Return floor (log2 (N)) as an int, where 0 < N <= ULLONG_MAX. */
+/* Return floor (log2 (N)) as an int. If N is zero, return -1. */
INLINE int
elogb (unsigned long long int n)
{
- return ULLONG_WIDTH - 1 - count_leading_zeros_ll (n);
+ int width = stdc_bit_width (n);
+ return width - 1;
}
/* A modification count. These are wide enough, and incremented
@@ -4271,17 +4296,19 @@ extern uintmax_t cons_to_unsigned (Lisp_Object,
uintmax_t);
extern AVOID args_out_of_range (Lisp_Object, Lisp_Object);
extern AVOID circular_list (Lisp_Object);
+extern KBOARD *kboard_for_bindings (void);
extern Lisp_Object do_symval_forwarding (lispfwd);
-enum Set_Internal_Bind {
- SET_INTERNAL_SET,
- SET_INTERNAL_BIND,
- SET_INTERNAL_UNBIND,
- SET_INTERNAL_THREAD_SWITCH
-};
+enum Set_Internal_Bind
+ {
+ SET_INTERNAL_SET,
+ SET_INTERNAL_BIND,
+ SET_INTERNAL_UNBIND,
+ SET_INTERNAL_THREAD_SWITCH,
+ };
extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object,
enum Set_Internal_Bind);
extern void set_default_internal (Lisp_Object, Lisp_Object,
- enum Set_Internal_Bind bindflag);
+ enum Set_Internal_Bind, KBOARD *);
extern Lisp_Object expt_integer (Lisp_Object, Lisp_Object);
extern void syms_of_data (void);
extern void swap_in_global_binding (struct Lisp_Symbol *);
@@ -4362,7 +4389,8 @@ extern void mark_fns (void);
/* Defined in sort.c */
extern void tim_sort (Lisp_Object, Lisp_Object, Lisp_Object *, const ptrdiff_t,
- bool);
+ bool)
+ ARG_NONNULL ((3));
/* Defined in floatfns.c. */
verify (FLT_RADIX == 2 || FLT_RADIX == 16);
@@ -4498,6 +4526,7 @@ extern void parse_str_as_multibyte (const unsigned char
*, ptrdiff_t,
extern ptrdiff_t pure_bytes_used_lisp;
struct Lisp_Vector *allocate_vectorlike (ptrdiff_t len, bool clearit);
extern void run_finalizer_function (Lisp_Object function);
+extern intptr_t garbage_collection_inhibited;
extern void *my_heap_start (void);
extern void check_pure_size (void);
unsigned char *resize_string_data (Lisp_Object, ptrdiff_t, int, int);
@@ -4540,6 +4569,12 @@ flush_stack_call_func (void (*func) (void *arg), void
*arg)
{
__builtin_unwind_init ();
flush_stack_call_func1 (func, arg);
+ /* Work around GCC sibling call optimization making
+ '__builtin_unwind_init' ineffective (bug#65727).
+ See <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=115132>. */
+#if defined __GNUC__ && !defined __clang__
+ asm ("");
+#endif
}
extern void garbage_collect (void);
@@ -5070,6 +5105,8 @@ extern void unmark_main_thread (void);
/* Defined in editfns.c. */
extern void insert1 (Lisp_Object);
+extern void find_field (Lisp_Object, Lisp_Object, Lisp_Object,
+ ptrdiff_t *, Lisp_Object, ptrdiff_t *);
extern void save_excursion_save (union specbinding *);
extern void save_excursion_restore (Lisp_Object, Lisp_Object);
extern Lisp_Object save_restriction_save (void);
@@ -5636,6 +5673,7 @@ extern char *emacs_root_dir (void);
#ifdef HAVE_TEXT_CONVERSION
/* Defined in textconv.c. */
extern void reset_frame_state (struct frame *);
+extern void reset_frame_conversion (struct frame *);
extern void report_selected_window_change (struct frame *);
extern void report_point_change (struct frame *, struct window *,
struct buffer *);
@@ -5837,7 +5875,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) && !GNUC_PREREQ (14, 0, 0)
+#if __GNUC__ == 13 && __GNUC_MINOR__ < 3
# pragma GCC diagnostic ignored "-Wanalyzer-allocation-size"
#endif
diff --git a/src/lread.c b/src/lread.c
index 271e6633ebf..f66c3d34c67 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1054,13 +1054,19 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char,
0, 0, 0,
-/* Return true if the lisp code read using READCHARFUN defines a non-nil
- `lexical-binding' file variable. After returning, the stream is
- positioned following the first line, if it is a comment or #! line,
- otherwise nothing is read. */
-
-static bool
-lisp_file_lexically_bound_p (Lisp_Object readcharfun)
+typedef enum {
+ Cookie_None, /* no cookie */
+ Cookie_Dyn, /* explicit dynamic binding */
+ Cookie_Lex /* explicit lexical binding */
+} lexical_cookie_t;
+
+/* Determine if the lisp code read using READCHARFUN defines a
+ `lexical-binding' file variable return its value.
+ After returning, the stream is positioned following the first line,
+ if it is a comment or #! line, otherwise nothing is read. */
+
+static lexical_cookie_t
+lisp_file_lexical_cookie (Lisp_Object readcharfun)
{
int ch = READCHAR;
@@ -1071,7 +1077,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
{
UNREAD (ch);
UNREAD ('#');
- return 0;
+ return Cookie_None;
}
while (ch != '\n' && ch != EOF)
ch = READCHAR;
@@ -1084,12 +1090,12 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
/* The first line isn't a comment, just give up. */
{
UNREAD (ch);
- return 0;
+ return Cookie_None;
}
else
/* Look for an appropriate file-variable in the first line. */
{
- bool rv = 0;
+ lexical_cookie_t rv = Cookie_None;
enum {
NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX
} beg_end_state = NOMINAL;
@@ -1171,7 +1177,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
if (strcmp (var, "lexical-binding") == 0)
/* This is it... */
{
- rv = (strcmp (val, "nil") != 0);
+ rv = strcmp (val, "nil") != 0 ? Cookie_Lex : Cookie_Dyn;
break;
}
}
@@ -1786,7 +1792,7 @@ Return t if the file exists and loads successfully. */)
}
else
{
- if (lisp_file_lexically_bound_p (Qget_file_char))
+ if (lisp_file_lexical_cookie (Qget_file_char) == Cookie_Lex)
Fset (Qlexical_binding, Qt);
if (! version || version >= 22)
@@ -2644,7 +2650,8 @@ settings in the buffer, and if there is no such setting,
the buffer
will be evaluated without lexical binding.
This function preserves the position of point. */)
- (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename,
Lisp_Object unibyte, Lisp_Object do_allow_print)
+ (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename,
+ Lisp_Object unibyte, Lisp_Object do_allow_print)
{
specpdl_ref count = SPECPDL_INDEX ();
Lisp_Object tem, buf;
@@ -2668,7 +2675,8 @@ This function preserves the position of point. */)
specbind (Qstandard_output, tem);
record_unwind_protect_excursion ();
BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
- specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil);
+ specbind (Qlexical_binding,
+ lisp_file_lexical_cookie (buf) == Cookie_Lex ? Qt : Qnil);
BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
readevalloop (buf, 0, filename,
!NILP (printflag), unibyte, Qnil, Qnil, Qnil);
@@ -2734,7 +2742,7 @@ STREAM or the value of `standard-input' may be:
minibuffer without a stream, as in (read). But is this feature
ever used, and if so, why? IOW, will anything break if this
feature is removed !? */
- return call1 (intern ("read-minibuffer"),
+ return call1 (Qread_minibuffer,
build_string ("Lisp expression: "));
return read_internal_start (stream, Qnil, Qnil, false);
@@ -2762,7 +2770,7 @@ STREAM or the value of `standard-input' may be:
stream = Qread_char;
if (EQ (stream, Qread_char))
/* FIXME: ?! When is this used !? */
- return call1 (intern ("read-minibuffer"),
+ return call1 (Qread_minibuffer,
build_string ("Lisp expression: "));
return read_internal_start (stream, Qnil, Qnil, true);
@@ -3501,54 +3509,62 @@ 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)
+ if (infile && size >= CLOSURE_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]);
+ if (CONSP (vec[CLOSURE_CODE])
+ && FIXNUMP (XCDR (vec[CLOSURE_CODE])))
+ vec[CLOSURE_CODE] = get_lazy_string (vec[CLOSURE_CODE]);
/* 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]))
+ if (NILP (vec[CLOSURE_CONSTANTS]) && STRINGP (vec[CLOSURE_CODE]))
{
- Lisp_Object enc = vec[COMPILED_BYTECODE];
+ Lisp_Object enc = vec[CLOSURE_CODE];
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);
+ vec[CLOSURE_CODE] = XCAR (pair);
+ vec[CLOSURE_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])))
+ if (!(size >= CLOSURE_STACK_DEPTH && size <= CLOSURE_INTERACTIVE + 1
+ && (FIXNUMP (vec[CLOSURE_ARGLIST])
+ || CONSP (vec[CLOSURE_ARGLIST])
+ || NILP (vec[CLOSURE_ARGLIST]))
+ && ((STRINGP (vec[CLOSURE_CODE]) /* Byte-code function. */
+ && VECTORP (vec[CLOSURE_CONSTANTS])
+ && size > CLOSURE_STACK_DEPTH
+ && (FIXNATP (vec[CLOSURE_STACK_DEPTH])))
+ || (CONSP (vec[CLOSURE_CODE]) /* Interpreted function. */
+ && (CONSP (vec[CLOSURE_CONSTANTS])
+ || NILP (vec[CLOSURE_CONSTANTS]))))))
invalid_syntax ("Invalid byte-code object", readcharfun);
- 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[CLOSURE_CODE]))
+ {
+ if (STRING_MULTIBYTE (vec[CLOSURE_CODE]))
+ /* 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[CLOSURE_CODE] = Fstring_as_unibyte (vec[CLOSURE_CODE]);
#ifndef HAVE_MPS
/* Bytecode must be immovable. */
- pin_string (vec[COMPILED_BYTECODE]);
+ pin_string (vec[CLOSURE_CODE]);
#endif
+ /* Bytecode must be immovable. */
+ }
- XSETPVECTYPE (XVECTOR (obj), PVEC_COMPILED);
+ XSETPVECTYPE (XVECTOR (obj), PVEC_CLOSURE);
return obj;
}
@@ -3902,6 +3918,27 @@ read_stack_reset (intmax_t sp)
rdstack.sp = sp;
}
+#define READ_AND_BUFFER(c) \
+ c = READCHAR; \
+ if (multibyte) \
+ p += CHAR_STRING (c, (unsigned char *) p); \
+ else \
+ *p++ = c; \
+ if (end - p < MAX_MULTIBYTE_LENGTH + 1) \
+ { \
+ offset = p - read_buffer; \
+ read_buffer = grow_read_buffer (read_buffer, offset, \
+ &heapbuf, &read_buffer_size, count); \
+ p = read_buffer + offset; \
+ end = read_buffer + read_buffer_size; \
+ }
+
+#define INVALID_SYNTAX_WITH_BUFFER() \
+ { \
+ *p = 0; \
+ invalid_syntax (read_buffer, readcharfun); \
+ }
+
/* Read a Lisp object.
If LOCATE_SYMS is true, symbols are read with position. */
static Lisp_Object
@@ -3910,6 +3947,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
char stackbuf[64];
char *read_buffer = stackbuf;
ptrdiff_t read_buffer_size = sizeof stackbuf;
+ ptrdiff_t offset;
char *heapbuf = NULL;
specpdl_ref base_pdl = SPECPDL_INDEX ();
@@ -4011,7 +4049,13 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
case '#':
{
- int ch = READCHAR;
+ char *p = read_buffer;
+ char *end = read_buffer + read_buffer_size;
+
+ *p++ = '#';
+ int ch;
+ READ_AND_BUFFER (ch);
+
switch (ch)
{
case '\'':
@@ -4029,11 +4073,11 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
case 's':
/* #s(...) -- a record or hash-table */
- ch = READCHAR;
+ READ_AND_BUFFER (ch);
if (ch != '(')
{
UNREAD (ch);
- invalid_syntax ("#s", readcharfun);
+ INVALID_SYNTAX_WITH_BUFFER ();
}
read_stack_push ((struct read_stack_entry) {
.type = RE_record,
@@ -4046,7 +4090,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
case '^':
/* #^[...] -- char-table
#^^[...] -- sub-char-table */
- ch = READCHAR;
+ READ_AND_BUFFER (ch);
if (ch == '^')
{
ch = READCHAR;
@@ -4063,7 +4107,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
else
{
UNREAD (ch);
- invalid_syntax ("#^^", readcharfun);
+ INVALID_SYNTAX_WITH_BUFFER ();
}
}
else if (ch == '[')
@@ -4079,7 +4123,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
else
{
UNREAD (ch);
- invalid_syntax ("#^", readcharfun);
+ INVALID_SYNTAX_WITH_BUFFER ();
}
case '(':
@@ -4189,12 +4233,12 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
int c;
for (;;)
{
- c = READCHAR;
+ READ_AND_BUFFER (c);
if (c < '0' || c > '9')
break;
if (ckd_mul (&n, n, 10)
|| ckd_add (&n, n, c - '0'))
- invalid_syntax ("#", readcharfun);
+ INVALID_SYNTAX_WITH_BUFFER ();
}
if (c == 'r' || c == 'R')
{
@@ -4235,18 +4279,18 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
= XHASH_TABLE (read_objects_map);
ptrdiff_t i = hash_lookup (h, make_fixnum (n));
if (i < 0)
- invalid_syntax ("#", readcharfun);
+ INVALID_SYNTAX_WITH_BUFFER ();
obj = HASH_VALUE (h, i);
break;
}
else
- invalid_syntax ("#", readcharfun);
+ INVALID_SYNTAX_WITH_BUFFER ();
}
else
- invalid_syntax ("#", readcharfun);
+ INVALID_SYNTAX_WITH_BUFFER ();
}
else
- invalid_syntax ("#", readcharfun);
+ INVALID_SYNTAX_WITH_BUFFER ();
}
break;
}
@@ -4626,7 +4670,7 @@ substitute_object_recurse (struct subst *subst,
Lisp_Object subtree)
if (BOOL_VECTOR_P (subtree))
return subtree; /* No sub-objects anyway. */
else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
- || COMPILEDP (subtree) || HASH_TABLE_P (subtree)
+ || CLOSUREP (subtree) || HASH_TABLE_P (subtree)
|| RECORDP (subtree))
length = PVSIZE (subtree);
else if (VECTORP (subtree))
@@ -6139,4 +6183,5 @@ Only valid during macro-expansion. Internal use only.
*/);
DEFSYM (Qinternal_macroexpand_for_load,
"internal-macroexpand-for-load");
+ DEFSYM (Qread_minibuffer, "read-minibuffer");
}
diff --git a/src/marker.c b/src/marker.c
index 2abc951fc76..f016bf9c088 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -21,7 +21,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <config.h>
/* Work around GCC bug 113253. */
-#if __GNUC__ == 13
+#if __GNUC__ == 13 && __GNUC_MINOR__ < 3
# pragma GCC diagnostic ignored "-Wanalyzer-deref-before-check"
#endif
diff --git a/src/minibuf.c b/src/minibuf.c
index 51816133fb2..9c1c86680d4 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -494,12 +494,11 @@ confirm the aborting of the current minibuffer and all
contained ones. */)
to abort any extra non-minibuffer recursive edits. Thus,
the number of recursive edits we have to abort equals the
number of minibuffers we have to abort. */
- CALLN (Ffuncall, intern ("minibuffer-quit-recursive-edit"),
- array[1]);
+ call1 (Qminibuffer_quit_recursive_edit, array[1]);
}
}
else
- CALLN (Ffuncall, intern ("minibuffer-quit-recursive-edit"));
+ call0 (Qminibuffer_quit_recursive_edit);
return Qnil;
}
@@ -1367,6 +1366,20 @@ and some related functions, which use zero-indexing for
POSITION. */)
if (NILP (histpos))
XSETFASTINT (histpos, 0);
+#ifdef HAVE_TEXT_CONVERSION
+ /* If overriding-text-conversion-style is set, assume that it was
+ changed prior to this call and force text conversion to be reset,
+ since redisplay might conclude that the value was retained
+ unmodified from a previous call to Fread_from_minibuffer as the
+ selected window will not have changed. */
+ if (!EQ (Voverriding_text_conversion_style, Qlambda)
+ /* Separate minibuffer frames are not material here, since they
+ will already be selected if the situation that this is meant to
+ prevent is possible. */
+ && FRAME_WINDOW_P (SELECTED_FRAME ()))
+ reset_frame_conversion (SELECTED_FRAME ());
+#endif /* HAVE_TEXT_CONVERSION */
+
val = read_minibuf (keymap, initial_contents, prompt,
!NILP (read),
histvar, histpos, default_value,
@@ -1525,12 +1538,12 @@ function, instead of the usual behavior. */)
STRING_MULTIBYTE (prompt));
}
- prompt = CALLN (Ffuncall, intern("format-prompt"),
+ prompt = CALLN (Ffuncall, Qformat_prompt,
prompt,
CONSP (def) ? XCAR (def) : def);
}
- result = Fcompleting_read (prompt, intern ("internal-complete-buffer"),
+ result = Fcompleting_read (prompt, Qinternal_complete_buffer,
predicate, require_match, Qnil,
Qbuffer_name_history, def, Qnil);
}
@@ -2018,7 +2031,7 @@ See also `completing-read-function'. */)
(Lisp_Object prompt, Lisp_Object collection, Lisp_Object predicate,
Lisp_Object require_match, Lisp_Object initial_input, Lisp_Object hist,
Lisp_Object def, Lisp_Object inherit_input_method)
{
return CALLN (Ffuncall,
- Fsymbol_value (intern ("completing-read-function")),
+ Fsymbol_value (Qcompleting_read_function),
prompt, collection, predicate, require_match, initial_input,
hist, def, inherit_input_method);
}
@@ -2517,4 +2530,8 @@ showing the *Completions* buffer, if any. */);
defsubr (&Stest_completion);
defsubr (&Sassoc_string);
defsubr (&Scompleting_read);
+ DEFSYM (Qminibuffer_quit_recursive_edit, "minibuffer-quit-recursive-edit");
+ DEFSYM (Qinternal_complete_buffer, "internal-complete-buffer");
+ DEFSYM (Qcompleting_read_function, "completing-read-function");
+ DEFSYM (Qformat_prompt, "format-prompt");
}
diff --git a/src/msdos.c b/src/msdos.c
index 7e78c35027e..e9faa48fa70 100644
--- a/src/msdos.c
+++ b/src/msdos.c
@@ -3070,12 +3070,12 @@ XMenuActivate (Display *foo, XMenu *menu, int *pane,
int *selidx,
state = alloca (menu->panecount * sizeof (struct IT_menu_state));
screensize = screen_size * 2;
faces[0]
- = lookup_derived_face (NULL, sf, intern ("msdos-menu-passive-face"),
+ = lookup_derived_face (NULL, sf, Qmsdos_menu_passive_face,
DEFAULT_FACE_ID, 1);
faces[1]
- = lookup_derived_face (NULL, sf, intern ("msdos-menu-active-face"),
+ = lookup_derived_face (NULL, sf, Qmsdos_menu_active_face,
DEFAULT_FACE_ID, 1);
- selectface = intern ("msdos-menu-select-face");
+ selectface = Qmsdos_menu_select_face;
faces[2] = lookup_derived_face (NULL, sf, selectface,
faces[0], 1);
faces[3] = lookup_derived_face (NULL, sf, selectface,
@@ -3740,7 +3740,7 @@ run_msdos_command (char **argv, const char *working_dir,
*pl = '\0';
cmd = Ffile_name_nondirectory (build_string (lowcase_argv0));
- msshell = !NILP (Fmember (cmd, Fsymbol_value (intern ("msdos-shells"))))
+ msshell = !NILP (Fmember (cmd, Fsymbol_value (Qmsdos_shells)))
&& !strcmp ("-c", argv[1]);
if (msshell)
{
@@ -4324,6 +4324,11 @@ This variable is used only by MS-DOS terminals. */);
defsubr (&Smsdos_downcase_filename);
defsubr (&Smsdos_remember_default_colors);
defsubr (&Smsdos_set_mouse_buttons);
+
+ DEFSYM (Qmsdos_menu_passive_face, "msdos-menu-passive-face");
+ DEFSYM (Qmsdos_menu_active_face, "msdos-menu-active-face");
+ DEFSYM (Qmsdos_menu_select_face, "msdos-menu-select-face");
+ DEFSYM (Qmsdos_shells, "msdos-shells");
}
#endif /* MSDOS */
diff --git a/src/nsfns.m b/src/nsfns.m
index c521140bd68..b08d053610f 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -2046,12 +2046,12 @@ DEFUN ("x-display-backing-store",
Fx_display_backing_store,
switch ([ns_get_window (terminal) backingType])
{
case NSBackingStoreBuffered:
- return intern ("buffered");
+ return Qbuffered;
#if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MIN_REQUIRED < 101300
case NSBackingStoreRetained:
- return intern ("retained");
+ return Qretained;
case NSBackingStoreNonretained:
- return intern ("non-retained");
+ return Qnon_retained;
#endif
default:
error ("Strange value for backingType parameter of frame");
@@ -2071,19 +2071,19 @@ DEFUN ("x-display-visual-class",
Fx_display_visual_class,
depth = [[[NSScreen screens] objectAtIndex:0] depth];
if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
- return intern ("static-gray");
+ return Qstatic_gray;
else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
- return intern ("gray-scale");
+ return Qgray_scale;
else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
- return intern ("pseudo-color");
+ return Qpseudo_color;
else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
- return intern ("true-color");
+ return Qtrue_color;
else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
- return intern ("direct-color");
+ return Qdirect_color;
else
/* Color management as far as we do it is really handled by
Nextstep itself anyway. */
- return intern ("direct-color");
+ return Qdirect_color;
}
@@ -2183,13 +2183,13 @@ is layered in front of the windows of other
applications. */)
(Lisp_Object on)
{
check_window_system (NULL);
- if (EQ (on, intern ("activate")))
+ if (EQ (on, Qactivate))
{
[NSApp unhide: NSApp];
[NSApp activateIgnoringOtherApps: YES];
}
#if GNUSTEP_GUI_MAJOR_VERSION > 0 || GNUSTEP_GUI_MINOR_VERSION >= 27
- else if (EQ (on, intern ("activate-front")))
+ else if (EQ (on, Qactivate_front))
{
[NSApp unhide: NSApp];
[[NSRunningApplication currentApplication]
@@ -2530,7 +2530,7 @@ DEFUN ("system-move-file-to-trash",
Fsystem_move_file_to_trash,
if (!NILP (Ffile_directory_p (filename))
&& NILP (Ffile_symlink_p (filename)))
{
- operation = intern ("delete-directory");
+ operation = Qdelete_directory;
filename = Fdirectory_file_name (filename);
}
@@ -3149,7 +3149,7 @@ ns_create_tip_frame (struct ns_display_info *dpyinfo,
Lisp_Object parms)
/* Set the `display-type' frame parameter before setting up faces. */
{
- Lisp_Object disptype = intern ("color");
+ Lisp_Object disptype = Qcolor;
if (NILP (Fframe_parameter (frame, Qdisplay_type)))
{
@@ -3208,7 +3208,7 @@ x_hide_tip (bool delete)
{
if (!NILP (tip_timer))
{
- call1 (intern ("cancel-timer"), tip_timer);
+ call1 (Qcancel_timer, tip_timer);
tip_timer = Qnil;
}
@@ -3359,7 +3359,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
tip_f = XFRAME (tip_frame);
if (!NILP (tip_timer))
{
- call1 (intern ("cancel-timer"), tip_timer);
+ call1 (Qcancel_timer, tip_timer);
tip_timer = Qnil;
}
@@ -3406,12 +3406,12 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
break;
}
else
- tip_last_parms =
- call2 (intern ("assq-delete-all"), parm,
tip_last_parms);
+ tip_last_parms
+ = call2 (Qassq_delete_all, parm, tip_last_parms);
}
else
- tip_last_parms =
- call2 (intern ("assq-delete-all"), parm, tip_last_parms);
+ tip_last_parms
+ = call2 (Qassq_delete_all, parm, tip_last_parms);
}
/* Now check if every parameter in what is left of
@@ -3573,8 +3573,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
start_timer:
/* Let the tip disappear after timeout seconds. */
- tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
- intern ("x-hide-tip"));
+ tip_timer = call3 (Qrun_at_time, timeout, Qnil,
+ Qx_hide_tip);
}
return unbind_to (count, Qnil);
@@ -4076,4 +4076,20 @@ The default value is t. */);
as_script = Qnil;
staticpro (&as_script);
as_result = 0;
+
+ DEFSYM (Qbuffered, "buffered");
+ DEFSYM (Qretained, "retained");
+ DEFSYM (Qnon_retained, "non-retained");
+ DEFSYM (Qstatic_gray, "static-gray");
+ DEFSYM (Qgray_scale, "gray-scale");
+ DEFSYM (Qpseudo_color, "pseudo-color");
+ DEFSYM (Qtrue_color, "true-color");
+ DEFSYM (Qdirect_color, "direct-color");
+ DEFSYM (Qactivate, "activate");
+ DEFSYM (Qactivate_front, "activate-front");
+ DEFSYM (Qcolor, "color");
+ DEFSYM (Qcancel_timer, "cancel-timer");
+ DEFSYM (Qassq_delete_all, "assq-delete-all");
+ DEFSYM (Qrun_at_time, "run-at-time");
+ DEFSYM (Qx_hide_tip, "x-hide-tip");
}
diff --git a/src/nsfont.m b/src/nsfont.m
index 4e1d85a5c4a..ddbaea11967 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -337,8 +337,8 @@ ns_spec_to_descriptor (Lisp_Object font_spec)
if (EQ (tem, Qitalic) || EQ (tem, Qoblique))
[tdict setObject: [NSNumber numberWithFloat: 1.0]
forKey: NSFontSlantTrait];
- else if (EQ (tem, intern ("reverse-italic"))
- || EQ (tem, intern ("reverse-oblique")))
+ else if (EQ (tem, Qreverse_italic)
+ || EQ (tem, Qreverse_oblique))
[tdict setObject: [NSNumber numberWithFloat: -1.0]
forKey: NSFontSlantTrait];
else
@@ -451,7 +451,7 @@ ns_descriptor_to_entity (NSFontDescriptor *desc,
FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX,
data.slant == GS_FONT_SLANT_ITALIC
? Qitalic : (data.slant == GS_FONT_SLANT_REVERSE_ITALIC
- ? intern ("reverse-italic") : Qnormal));
+ ? Qreverse_italic : Qnormal));
}
else
FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, Qnormal);
@@ -461,7 +461,7 @@ ns_descriptor_to_entity (NSFontDescriptor *desc,
FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX,
data.width == GS_FONT_WIDTH_CONDENSED
? Qcondensed : (data.width == GS_FONT_WIDTH_EXPANDED
- ? intern ("expanded") : Qnormal));
+ ? Qexpanded : Qnormal));
}
else
FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, Qnormal);
@@ -1180,21 +1180,12 @@ nsfont_draw (struct glyph_string *s, int from, int to,
int x, int y,
{
NSRect br = NSMakeRect (x, y - FONT_BASE (s->font),
s->width, FONT_HEIGHT (s->font));
-
- if (!s->face->stipple)
- {
- if (s->hl != DRAW_CURSOR)
- [(NS_FACE_BACKGROUND (face) != 0
- ? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)]
- : FRAME_BACKGROUND_COLOR (s->f)) set];
- else
- [FRAME_CURSOR_COLOR (s->f) set];
- }
+ if (s->hl != DRAW_CURSOR)
+ [(NS_FACE_BACKGROUND (face) != 0
+ ? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)]
+ : FRAME_BACKGROUND_COLOR (s->f)) set];
else
- {
- struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f);
- [[dpyinfo->bitmaps[face->stipple-1].img stippleMask] set];
- }
+ [FRAME_CURSOR_COLOR (s->f) set];
NSRectFill (br);
}
@@ -1753,7 +1744,6 @@ void
syms_of_nsfont (void)
{
DEFSYM (Qcondensed, "condensed");
- DEFSYM (Qexpanded, "expanded");
DEFSYM (Qmedium, "medium");
DEFVAR_LISP ("ns-reg-to-script", Vns_reg_to_script,
@@ -1761,6 +1751,11 @@ syms_of_nsfont (void)
Vns_reg_to_script = Qnil;
pdumper_do_now_and_after_load (syms_of_nsfont_for_pdumper);
+
+ /* Font slant styles. */
+ DEFSYM (Qreverse_italic, "reverse-italic");
+ DEFSYM (Qreverse_oblique, "reverse-oblique");
+ DEFSYM (Qexpanded, "expanded");
}
static void
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 0d21f7d03d3..46ee9e1c3fc 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -47,7 +47,6 @@ Carbon version by Yamamoto Mitsuharu. */
#endif
-extern long context_menu_value;
EmacsMenu *svcsMenu;
/* Nonzero means a menu is currently active. */
static int popup_activated_flag;
diff --git a/src/nsterm.h b/src/nsterm.h
index 84778727bbb..959eb070e69 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -922,6 +922,8 @@ struct ns_display_info
/* This is a chain of structures for all the NS displays currently in use. */
extern struct ns_display_info *x_display_list;
+extern long context_menu_value;
+
struct ns_output
{
#ifdef __OBJC__
@@ -1270,6 +1272,8 @@ extern void ns_finish_events (void);
extern double ns_frame_scale_factor (struct frame *);
+extern frame_parm_handler ns_frame_parm_handlers[];
+
#ifdef NS_IMPL_GNUSTEP
extern char gnustep_base_version[]; /* version tracking */
#endif
diff --git a/src/nsterm.m b/src/nsterm.m
index 9814758cce3..ee09378b831 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -3310,7 +3310,66 @@ ns_draw_underwave (struct glyph_string *s, EmacsCGFloat
width, EmacsCGFloat x)
[[NSGraphicsContext currentContext] restoreGraphicsState];
}
+/* Draw a dashed underline of thickness THICKNESS and width WIDTH onto
+ the focused frame at a vertical offset of OFFSET from the position of
+ the glyph string S, with each segment SEGMENT pixels in length. */
+static void
+ns_draw_dash (struct glyph_string *s, int width, int segment,
+ int offset, int thickness)
+{
+ CGFloat pattern[2], y_center = s->ybase + offset + thickness / 2.0;
+ NSBezierPath *path = [[NSBezierPath alloc] init];
+
+ pattern[0] = segment;
+ pattern[1] = segment;
+
+ [path setLineDash: pattern count: 2 phase: (CGFloat) s->x];
+ [path setLineWidth: thickness];
+ [path moveToPoint: NSMakePoint (s->x, y_center)];
+ [path lineToPoint: NSMakePoint (s->x + width, y_center)];
+ [path stroke];
+ [path release];
+}
+
+/* Draw an underline of STYLE onto the focused frame at an offset of
+ POSITION from the baseline of the glyph string S, S->WIDTH in length,
+ and THICKNESS in height. */
+
+static void
+ns_fill_underline (struct glyph_string *s, enum face_underline_type style,
+ int position, int thickness)
+{
+ int segment;
+ NSRect rect;
+
+ segment = thickness * 3;
+
+ switch (style)
+ {
+ /* FACE_UNDERLINE_DOUBLE_LINE is treated identically to SINGLE, as
+ the second line will be filled by another invocation of this
+ function. */
+ case FACE_UNDERLINE_SINGLE:
+ case FACE_UNDERLINE_DOUBLE_LINE:
+ rect = NSMakeRect (s->x, s->ybase + position, s->width, thickness);
+ NSRectFill (rect);
+ break;
+
+ case FACE_UNDERLINE_DOTS:
+ segment = thickness;
+ FALLTHROUGH;
+
+ case FACE_UNDERLINE_DASHES:
+ ns_draw_dash (s, s->width, segment, position, thickness);
+ break;
+
+ case FACE_NO_UNDERLINE:
+ case FACE_UNDERLINE_WAVE:
+ default:
+ emacs_abort ();
+ }
+}
static void
ns_draw_text_decoration (struct glyph_string *s, struct face *face,
@@ -3330,22 +3389,21 @@ ns_draw_text_decoration (struct glyph_string *s, struct
face *face,
/* Do underline. */
if (face->underline)
{
- if (s->face->underline == FACE_UNDER_WAVE)
+ if (s->face->underline == FACE_UNDERLINE_WAVE)
{
if (!face->underline_defaulted_p)
[[NSColor colorWithUnsignedLong:face->underline_color] set];
ns_draw_underwave (s, width, x);
}
- else if (s->face->underline == FACE_UNDER_LINE)
+ else if (face->underline >= FACE_UNDERLINE_SINGLE)
{
-
- NSRect r;
unsigned long thickness, position;
/* If the prev was underlined, match its appearance. */
if (s->prev
- && s->prev->face->underline == FACE_UNDER_LINE
+ && (s->prev->face->underline != FACE_UNDERLINE_WAVE
+ && s->prev->face->underline >= FACE_UNDERLINE_SINGLE)
&& s->prev->underline_thickness > 0
&& (s->prev->face->underline_at_descent_line_p
== s->face->underline_at_descent_line_p)
@@ -3411,12 +3469,22 @@ ns_draw_text_decoration (struct glyph_string *s, struct
face *face,
s->underline_thickness = thickness;
s->underline_position = position;
- r = NSMakeRect (x, s->ybase + position, width, thickness);
-
if (!face->underline_defaulted_p)
[[NSColor colorWithUnsignedLong:face->underline_color] set];
- NSRectFill (r);
+ ns_fill_underline (s, s->face->underline, position,
+ thickness);
+
+ /* Place a second underline above the first if this was
+ requested in the face specification. */
+
+ if (s->face->underline == FACE_UNDERLINE_DOUBLE_LINE)
+ {
+ /* Compute the position of the second underline. */
+ position = position - thickness - 1;
+ ns_fill_underline (s, s->face->underline, position,
+ thickness);
+ }
}
}
/* Do overline. We follow other terms in using a thickness of 1
@@ -3740,7 +3808,6 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s)
}
}
-
static void
ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p)
/* --------------------------------------------------------------------------
@@ -3748,45 +3815,47 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s,
char force_p)
certain cases. Others are left to the text rendering routine.
--------------------------------------------------------------------------
*/
{
+ struct face *face = s->face;
+ NSRect r;
+
NSTRACE ("ns_maybe_dumpglyphs_background");
- if (!s->background_filled_p/* || s->hl == DRAW_MOUSE_FACE*/)
+ if (!s->background_filled_p)
{
int box_line_width = max (s->face->box_horizontal_line_width, 0);
- if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width
- /* When xdisp.c ignores FONT_HEIGHT, we cannot trust font
- dimensions, since the actual glyphs might be much
- smaller. So in that case we always clear the rectangle
- with background color. */
- || FONT_TOO_HIGH (s->font)
- || s->font_not_found_p || s->extends_to_end_of_line_p || force_p)
+ if (s->stippled_p)
{
- struct face *face = s->face;
- if (!face->stipple)
- {
- if (s->hl != DRAW_CURSOR)
- [(NS_FACE_BACKGROUND (face) != 0
- ? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)]
- : FRAME_BACKGROUND_COLOR (s->f)) set];
- else if (face && (NS_FACE_BACKGROUND (face)
- == [(NSColor *) FRAME_CURSOR_COLOR (s->f)
- unsignedLong]))
- [[NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (face)]
set];
- else
- [FRAME_CURSOR_COLOR (s->f) set];
- }
- else
- {
- struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f);
- [[dpyinfo->bitmaps[face->stipple-1].img stippleMask] set];
- }
+ struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f);
+ [[dpyinfo->bitmaps[face->stipple-1].img stippleMask] set];
+ goto fill;
+ }
+ else if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width
+ /* When xdisp.c ignores FONT_HEIGHT, we cannot trust font
+ dimensions, since the actual glyphs might be much
+ smaller. So in that case we always clear the
+ rectangle with background color. */
+ || FONT_TOO_HIGH (s->font)
+ || s->font_not_found_p
+ || s->extends_to_end_of_line_p
+ || force_p)
+ {
+ if (s->hl != DRAW_CURSOR)
+ [(NS_FACE_BACKGROUND (face) != 0
+ ? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)]
+ : FRAME_BACKGROUND_COLOR (s->f)) set];
+ else if (face && (NS_FACE_BACKGROUND (face)
+ == [(NSColor *) FRAME_CURSOR_COLOR (s->f)
+ unsignedLong]))
+ [[NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (face)] set];
+ else
+ [FRAME_CURSOR_COLOR (s->f) set];
- NSRect r = NSMakeRect (s->x, s->y + box_line_width,
- s->background_width,
- s->height - 2 * box_line_width);
+ fill:
+ r = NSMakeRect (s->x, s->y + box_line_width,
+ s->background_width,
+ s->height - 2 * box_line_width);
NSRectFill (r);
-
s->background_filled_p = 1;
}
}
@@ -4015,8 +4084,7 @@ ns_draw_stretch_glyph_string (struct glyph_string *s)
struct face *face;
NSColor *fg_color;
- if (s->hl == DRAW_CURSOR
- && !x_stretch_cursor_p)
+ if (s->hl == DRAW_CURSOR && !x_stretch_cursor_p)
{
/* If `x-stretch-cursor' is nil, don't draw a block cursor as
wide as the stretch glyph. */
@@ -4102,8 +4170,13 @@ ns_draw_stretch_glyph_string (struct glyph_string *s)
if (background_width > 0)
{
+ struct ns_display_info *dpyinfo;
+
+ dpyinfo = FRAME_DISPLAY_INFO (s->f);
if (s->hl == DRAW_CURSOR)
[FRAME_CURSOR_COLOR (s->f) set];
+ else if (s->stippled_p)
+ [[dpyinfo->bitmaps[s->face->stipple - 1].img stippleMask] set];
else
[[NSColor colorWithUnsignedLong: s->face->background] set];
@@ -4321,6 +4394,45 @@ ns_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
s->char2b = NULL;
}
+/* Transfer glyph string parameters from S's face to S itself.
+ Set S->stipple_p as appropriate, taking the draw type into
+ account. */
+
+static void
+ns_set_glyph_string_gc (struct glyph_string *s)
+{
+ prepare_face_for_display (s->f, s->face);
+
+ if (s->hl == DRAW_NORMAL_TEXT)
+ {
+ /* s->gc = s->face->gc; */
+ s->stippled_p = s->face->stipple != 0;
+ }
+ else if (s->hl == DRAW_INVERSE_VIDEO)
+ {
+ /* x_set_mode_line_face_gc (s); */
+ s->stippled_p = s->face->stipple != 0;
+ }
+ else if (s->hl == DRAW_CURSOR)
+ {
+ /* x_set_cursor_gc (s); */
+ s->stippled_p = false;
+ }
+ else if (s->hl == DRAW_MOUSE_FACE)
+ {
+ /* x_set_mouse_face_gc (s); */
+ s->stippled_p = s->face->stipple != 0;
+ }
+ else if (s->hl == DRAW_IMAGE_RAISED
+ || s->hl == DRAW_IMAGE_SUNKEN)
+ {
+ /* s->gc = s->face->gc; */
+ s->stippled_p = s->face->stipple != 0;
+ }
+ else
+ emacs_abort ();
+}
+
static void
ns_draw_glyph_string (struct glyph_string *s)
/* --------------------------------------------------------------------------
@@ -4346,6 +4458,7 @@ ns_draw_glyph_string (struct glyph_string *s)
width += next->width, next = next->next)
if (next->first_glyph->type != IMAGE_GLYPH)
{
+ ns_set_glyph_string_gc (next);
n = ns_get_glyph_string_clip_rect (s->next, r);
ns_focus (s->f, r, n);
if (next->first_glyph->type != STRETCH_GLYPH)
@@ -4357,6 +4470,8 @@ ns_draw_glyph_string (struct glyph_string *s)
}
}
+ ns_set_glyph_string_gc (s);
+
if (!s->for_overlaps && s->face->box != FACE_NO_BOX
&& (s->first_glyph->type == CHAR_GLYPH
|| s->first_glyph->type == COMPOSITE_GLYPH))
@@ -5323,7 +5438,6 @@ ns_flush_display (struct frame *f)
redisplay interface. In addition, many of the ns_ methods have
code that is shared with all terms, indicating need for further
refactoring. */
-extern frame_parm_handler ns_frame_parm_handlers[];
static struct redisplay_interface ns_redisplay_interface =
{
ns_frame_parm_handlers,
diff --git a/src/pdumper.c b/src/pdumper.c
index b039e375c1f..48a564e7b9a 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -3174,7 +3174,7 @@ dump_vectorlike (struct dump_context *ctx,
error_unsupported_dump_object(ctx, lv, "font");
FALLTHROUGH;
case PVEC_NORMAL_VECTOR:
- case PVEC_COMPILED:
+ case PVEC_CLOSURE:
case PVEC_CHAR_TABLE:
case PVEC_SUB_CHAR_TABLE:
case PVEC_RECORD:
@@ -4298,7 +4298,7 @@ types. */)
/* Bind `command-line-processed' to nil before dumping,
so that the dumped Emacs will process its command line
and set up to work with X windows if appropriate. */
- Lisp_Object symbol = intern ("command-line-processed");
+ Lisp_Object symbol = Qcommand_line_processed;
specbind (symbol, Qnil);
CHECK_STRING (filename);
diff --git a/src/pgtkfns.c b/src/pgtkfns.c
index f43eed6ad23..6a8efb6d0bf 100644
--- a/src/pgtkfns.c
+++ b/src/pgtkfns.c
@@ -2148,7 +2148,7 @@ If omitted or nil, that stands for the selected frame's
display.
On PGTK, always return true-color. */)
(Lisp_Object terminal)
{
- return intern ("true-color");
+ return Qtrue_color;
}
@@ -2844,7 +2844,7 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo,
Lisp_Object parms, struct
{
Lisp_Object disptype;
- disptype = intern ("color");
+ disptype = Qcolor;
if (NILP (Fframe_parameter (frame, Qdisplay_type)))
{
@@ -3391,8 +3391,7 @@ Text larger than the specified size is clipped. */)
start_timer:
/* Let the tip disappear after timeout seconds. */
- tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
- intern ("x-hide-tip"));
+ tip_timer = call3 (Qrun_at_time, timeout, Qnil, Qx_hide_tip);
return unbind_to (count, Qnil);
}
@@ -3967,4 +3966,8 @@ syms_of_pgtkfns (void)
DEFSYM (Qlandscape, "landscape");
DEFSYM (Qreverse_portrait, "reverse-portrait");
DEFSYM (Qreverse_landscape, "reverse-landscape");
+ DEFSYM (Qtrue_color, "true-color");
+ DEFSYM (Qcolor, "color");
+ DEFSYM (Qrun_at_time, "run-at-time");
+ DEFSYM (Qx_hide_tip, "x-hide-tip");
}
diff --git a/src/pgtkselect.c b/src/pgtkselect.c
index b0ab15c6069..271411b87ca 100644
--- a/src/pgtkselect.c
+++ b/src/pgtkselect.c
@@ -353,7 +353,7 @@ struct pgtk_selection_request
/* Stack of selections currently being processed.
NULL if all requests have been fully processed. */
-struct pgtk_selection_request *selection_request_stack;
+static struct pgtk_selection_request *selection_request_stack;
static void
pgtk_push_current_selection_request (struct selection_input_event *se,
diff --git a/src/pgtkterm.c b/src/pgtkterm.c
index 1ec6bfcda4e..8d9a47b932f 100644
--- a/src/pgtkterm.c
+++ b/src/pgtkterm.c
@@ -53,7 +53,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "termhooks.h"
#include "termopts.h"
#include "termchar.h"
-#include "emacs-icon.h"
#include "menu.h"
#include "window.h"
#include "keyboard.h"
@@ -1239,7 +1238,7 @@ pgtk_set_glyph_string_gc (struct glyph_string *s)
line or menu if we don't have X toolkit support. */
static void
-pgtk_set_glyph_string_clipping (struct glyph_string *s, cairo_t * cr)
+pgtk_set_glyph_string_clipping (struct glyph_string *s, cairo_t *cr)
{
XRectangle r[2];
int n = get_glyph_string_clip_rects (s, r, 2);
@@ -1260,7 +1259,7 @@ pgtk_set_glyph_string_clipping (struct glyph_string *s,
cairo_t * cr)
static void
pgtk_set_glyph_string_clipping_exactly (struct glyph_string *src,
- struct glyph_string *dst, cairo_t * cr)
+ struct glyph_string *dst, cairo_t *cr)
{
dst->clip[0].x = src->x;
dst->clip[0].y = src->y;
@@ -2434,6 +2433,73 @@ pgtk_draw_stretch_glyph_string (struct glyph_string *s)
s->background_filled_p = true;
}
+
+/* Draw a dashed underline of thickness THICKNESS and width WIDTH onto F
+ at a vertical offset of OFFSET from the position of the glyph string
+ S, with each segment SEGMENT pixels in length. */
+
+static void
+pgtk_draw_dash (struct frame *f, struct glyph_string *s,
+ unsigned long foreground, int width,
+ char segment, int offset, int thickness)
+{
+ cairo_t *cr;
+ double cr_segment, y_center;
+
+ cr = pgtk_begin_cr_clip (s->f);
+ pgtk_set_cr_source_with_color (f, foreground, false);
+ cr_segment = (double) segment;
+ y_center = s->ybase + offset + (thickness / 2.0);
+
+ cairo_set_dash (cr, &cr_segment, 1, s->x);
+ cairo_set_line_width (cr, thickness);
+ cairo_move_to (cr, s->x, y_center);
+ cairo_line_to (cr, s->x + width, y_center);
+ cairo_stroke (cr);
+ pgtk_end_cr_clip (f);
+}
+
+/* Draw an underline of STYLE onto F at an offset of POSITION from the
+ baseline of the glyph string S in the color provided by FOREGROUND,
+ DECORATION_WIDTH in length, and THICKNESS in height. */
+
+static void
+pgtk_fill_underline (struct frame *f, struct glyph_string *s,
+ unsigned long foreground,
+ enum face_underline_type style, int position,
+ int decoration_width, int thickness)
+{
+ int segment;
+
+ segment = thickness * 3;
+
+ switch (style)
+ {
+ /* FACE_UNDERLINE_DOUBLE_LINE is treated identically to SINGLE, as
+ the second line will be filled by another invocation of this
+ function. */
+ case FACE_UNDERLINE_SINGLE:
+ case FACE_UNDERLINE_DOUBLE_LINE:
+ pgtk_fill_rectangle (f, foreground, s->x, s->ybase + position,
+ decoration_width, thickness, false);
+ break;
+
+ case FACE_UNDERLINE_DOTS:
+ segment = thickness;
+ FALLTHROUGH;
+
+ case FACE_UNDERLINE_DASHES:
+ pgtk_draw_dash (f, s, foreground, decoration_width, segment,
+ position, thickness);
+ break;
+
+ case FACE_NO_UNDERLINE:
+ case FACE_UNDERLINE_WAVE:
+ default:
+ emacs_abort ();
+ }
+}
+
static void
pgtk_draw_glyph_string (struct glyph_string *s)
{
@@ -2546,20 +2612,21 @@ pgtk_draw_glyph_string (struct glyph_string *s)
/* Draw underline. */
if (s->face->underline)
{
- if (s->face->underline == FACE_UNDER_WAVE)
+ if (s->face->underline == FACE_UNDERLINE_WAVE)
{
if (s->face->underline_defaulted_p)
pgtk_draw_underwave (s, s->xgcv.foreground);
else
pgtk_draw_underwave (s, s->face->underline_color);
}
- else if (s->face->underline == FACE_UNDER_LINE)
+ else if (s->face->underline >= FACE_UNDERLINE_SINGLE)
{
unsigned long thickness, position;
- int y;
+ unsigned long foreground;
if (s->prev
- && s->prev->face->underline == FACE_UNDER_LINE
+ && (s->prev->face->underline != FACE_UNDERLINE_WAVE
+ && s->prev->face->underline >= FACE_UNDERLINE_SINGLE)
&& (s->prev->face->underline_at_descent_line_p
== s->face->underline_at_descent_line_p)
&& (s->prev->face->underline_pixels_above_descent_line
@@ -2615,16 +2682,24 @@ pgtk_draw_glyph_string (struct glyph_string *s)
thickness = (s->y + s->height) - (s->ybase + position);
s->underline_thickness = thickness;
s->underline_position = position;
- y = s->ybase + position;
+
if (s->face->underline_defaulted_p)
- pgtk_fill_rectangle (s->f, s->xgcv.foreground,
- s->x, y, s->width, thickness,
- false);
+ foreground = s->xgcv.foreground;
else
+ foreground = s->face->underline_color;
+
+ pgtk_fill_underline (s->f, s, foreground, s->face->underline,
+ position, s->width, thickness);
+
+ /* Place a second underline above the first if this was
+ requested in the face specification. */
+
+ if (s->face->underline == FACE_UNDERLINE_DOUBLE_LINE)
{
- pgtk_fill_rectangle (s->f, s->face->underline_color,
- s->x, y, s->width, thickness,
- false);
+ /* Compute the position of the second underline. */
+ position = position - thickness - 1;
+ pgtk_fill_underline (s->f, s, foreground, s->face->underline,
+ position, s->width, thickness);
}
}
}
@@ -7107,6 +7182,9 @@ syms_of_pgtkterm (void)
DEFSYM (Qsuper, "super");
DEFSYM (Qcontrol, "control");
DEFSYM (QUTF8_STRING, "UTF8_STRING");
+ /* Referenced in gtkutil.c. */
+ DEFSYM (Qtheme_name, "theme-name");
+ DEFSYM (Qfile_name_sans_extension, "file-name-sans-extension");
DEFSYM (Qfile, "file");
DEFSYM (Qurl, "url");
@@ -7124,7 +7202,6 @@ syms_of_pgtkterm (void)
DEFSYM (Qlink, "link");
DEFSYM (Qprivate, "private");
-
Fput (Qalt, Qmodifier_value, make_fixnum (alt_modifier));
Fput (Qhyper, Qmodifier_value, make_fixnum (hyper_modifier));
Fput (Qmeta, Qmodifier_value, make_fixnum (meta_modifier));
@@ -7404,5 +7481,5 @@ pgtk_cr_export_frames (Lisp_Object frames,
cairo_surface_type_t surface_type)
unbind_to (count, Qnil);
- return CALLN (Fapply, intern ("concat"), Fnreverse (acc));
+ return CALLN (Fapply, Qconcat, Fnreverse (acc));
}
diff --git a/src/print.c b/src/print.c
index 7aee1679d32..f0351b7c028 100644
--- a/src/print.c
+++ b/src/print.c
@@ -91,6 +91,7 @@ static ptrdiff_t print_number_index;
static void print_interval (INTERVAL interval, void *pprintcharfun);
/* GDB resets this to zero on W32 to disable OutputDebugString calls. */
+extern bool print_output_debug_flag;
bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
@@ -1300,7 +1301,7 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool
escapeflag)
(STRINGP (obj) \
|| CONSP (obj) \
|| (VECTORLIKEP (obj) \
- && (VECTORP (obj) || COMPILEDP (obj) \
+ && (VECTORP (obj) || CLOSUREP (obj) \
|| CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \
|| HASH_TABLE_P (obj) || FONTP (obj) \
|| RECORDP (obj))) \
@@ -2167,7 +2168,7 @@ print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object
printcharfun,
/* Types handled earlier. */
case PVEC_NORMAL_VECTOR:
case PVEC_RECORD:
- case PVEC_COMPILED:
+ case PVEC_CLOSURE:
case PVEC_CHAR_TABLE:
case PVEC_SUB_CHAR_TABLE:
case PVEC_HASH_TABLE:
@@ -2676,7 +2677,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
print_stack_push_vector ("#s(", ")", obj, 0, PVSIZE (obj),
printcharfun);
goto next_obj;
- case PVEC_COMPILED:
+ case PVEC_CLOSURE:
print_stack_push_vector ("#[", "]", obj, 0, PVSIZE (obj),
printcharfun);
goto next_obj;
diff --git a/src/process.c b/src/process.c
index c6fe29691a9..2dfa31377eb 100644
--- a/src/process.c
+++ b/src/process.c
@@ -2115,7 +2115,7 @@ dissociate_controlling_tty (void)
child that has not execed.
I wonder: would just ioctl (fd, TIOCNOTTY, 0) work here, for
some fd that the caller already has? */
- int ttyfd = emacs_open (DEV_TTY, O_RDWR, 0);
+ int ttyfd = emacs_open (dev_tty, O_RDWR, 0);
if (0 <= ttyfd)
{
ioctl (ttyfd, TIOCNOTTY, 0);
@@ -4679,7 +4679,7 @@ network_lookup_address_info_1 (Lisp_Object host, const
char *service,
int ret;
if (STRING_MULTIBYTE (host) && SBYTES (host) != SCHARS (host))
- error ("Non-ASCII hostname %s detected, please use puny-encode-domain",
+ error ("Non-ASCII hostname %s detected, please use `puny-encode-domain'",
SSDATA (host));
#ifdef WINDOWSNT
diff --git a/src/profiler.c b/src/profiler.c
index 309116e3ee4..98d83bcf264 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -186,9 +186,7 @@ trace_hash (Lisp_Object *trace, int depth)
{
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));
+ = (CLOSUREP (f) ? XHASH (AREF (f, CLOSURE_CODE)) : XHASH (f));
hash = sxhash_combine (hash, hash1);
}
return hash;
@@ -691,12 +689,8 @@ the same lambda expression, or are really unrelated
function. */)
bool res;
if (EQ (f1, f2))
res = true;
- else if (COMPILEDP (f1) && COMPILEDP (f2))
- res = EQ (AREF (f1, COMPILED_BYTECODE), AREF (f2, COMPILED_BYTECODE));
- else if (CONSP (f1) && CONSP (f2) && CONSP (XCDR (f1)) && CONSP (XCDR (f2))
- && EQ (Qclosure, XCAR (f1))
- && EQ (Qclosure, XCAR (f2)))
- res = EQ (XCDR (XCDR (f1)), XCDR (XCDR (f2)));
+ else if (CLOSUREP (f1) && CLOSUREP (f2))
+ res = EQ (AREF (f1, CLOSURE_CODE), AREF (f2, CLOSURE_CODE));
else
res = false;
return res ? Qt : Qnil;
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 0ec0c6eb63f..92dbdbecbf1 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -341,7 +341,7 @@ typedef enum
/* Store NUMBER in two contiguous bytes starting at DESTINATION. */
static void
-STORE_NUMBER (unsigned char *destination, int16_t number)
+STORE_NUMBER (unsigned char *destination, int number)
{
(destination)[0] = (number) & 0377;
(destination)[1] = (number) >> 8;
diff --git a/src/sfnt.c b/src/sfnt.c
index d909fba7677..507f2d40e6f 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 <stdbit.h>
#include <stdckdint.h>
#include <stdint.h>
#include <stdio.h>
@@ -3678,45 +3679,6 @@ sfnt_multiply_divide_1 (unsigned int a, unsigned int b,
value->high = hi;
}
-/* Count the number of most significant zero bits in N. */
-
-static unsigned int
-sfnt_count_leading_zero_bits (unsigned int n)
-{
- int shift;
-
- shift = 0;
-
- if (n & 0xffff0000ul)
- {
- n >>= 16;
- shift += 16;
- }
-
- if (n & 0x0000ff00ul)
- {
- n >>= 8;
- shift += 8;
- }
-
- if (n & 0x000000f0ul)
- {
- n >>= 4;
- shift += 4;
- }
-
- if (n & 0x0000000cul)
- {
- n >>= 2;
- shift += 2;
- }
-
- if (n & 0x00000002ul)
- shift += 1;
-
- return shift;
-}
-
/* Calculate AB / C. Value is a 32 bit unsigned integer. */
static unsigned int
@@ -3730,7 +3692,7 @@ sfnt_multiply_divide_2 (struct sfnt_large_integer *ab,
hi = ab->high;
lo = ab->low;
- i = 31 - sfnt_count_leading_zero_bits (hi);
+ i = stdc_leading_zeros (hi);
r = (hi << i) | (lo >> (32 - i));
lo <<= i;
q = r / c;
@@ -14127,18 +14089,15 @@ sfnt_map_table (int fd, struct sfnt_offset_subtable
*subtable,
/* Find the table in the directory. */
- for (i = 0; i < subtable->num_tables; ++i)
+ for (i = 0; ; i++)
{
- if (subtable->subtables[i].tag == tag)
- {
- directory = &subtable->subtables[i];
- break;
- }
+ if (! (i < subtable->num_tables))
+ return 1;
+ directory = &subtable->subtables[i];
+ if (directory->tag == tag)
+ break;
}
- if (i == subtable->num_tables)
- return 1;
-
/* Now try to map the glyph data. Make sure offset is a multiple of
the page size. */
@@ -14194,18 +14153,15 @@ sfnt_read_table (int fd, struct sfnt_offset_subtable
*subtable,
/* Find the table in the directory. */
- for (i = 0; i < subtable->num_tables; ++i)
+ for (i = 0; ; i++)
{
- if (subtable->subtables[i].tag == tag)
- {
- directory = &subtable->subtables[i];
- break;
- }
+ if (! (i < subtable->num_tables))
+ return NULL;
+ directory = &subtable->subtables[i];
+ if (directory->tag == tag)
+ break;
}
- if (i == subtable->num_tables)
- return NULL;
-
/* Seek to the table. */
if (lseek (fd, directory->offset, SEEK_SET) != directory->offset)
@@ -15198,7 +15154,7 @@ sfnt_read_cvar_table (int fd, struct
sfnt_offset_subtable *subtable,
/* Copy in the shared point numbers instead. */
cvar->variation[i].num_points = npoints;
- if (npoints != UINT16_MAX)
+ if (points && npoints != UINT16_MAX)
{
if (cvar->variation[i].num_points > cvt->num_elements)
cvar->variation[i].num_points = cvt->num_elements;
diff --git a/src/sfntfont-android.c b/src/sfntfont-android.c
index 1ed394b9458..b90ca857dd4 100644
--- a/src/sfntfont-android.c
+++ b/src/sfntfont-android.c
@@ -503,6 +503,10 @@ sfntfont_android_put_glyphs (struct glyph_string *s, int
from,
if (with_background)
{
+ /* The background should have been filled in advance if a stipple
+ is enabled. */
+ eassert (s->gc->fill_style != ANDROID_FILL_OPAQUE_STIPPLED);
+
/* Fill the background. First, offset the background rectangle
to become relative from text_rectangle.x,
text_rectangle.y. */
diff --git a/src/sfntfont.c b/src/sfntfont.c
index fb3feaeaf79..79bc251abe4 100644
--- a/src/sfntfont.c
+++ b/src/sfntfont.c
@@ -454,8 +454,9 @@ static struct sfnt_style_desc sfnt_width_descriptions[] =
static void
sfnt_parse_style (Lisp_Object style_name, struct sfnt_font_desc *desc)
{
- char *style, *single, *saveptr;
+ char *style, *single, *saveptr, c;
int i;
+ ptrdiff_t x;
USE_SAFE_ALLOCA;
/* Fill in default values. slant seems to not be consistent with
@@ -555,7 +556,19 @@ sfnt_parse_style (Lisp_Object style_name, struct
sfnt_font_desc *desc)
/* The adstyle must be a symbol, so intern it if it is set. */
if (!NILP (desc->adstyle))
- desc->adstyle = Fintern (desc->adstyle, Qnil);
+ {
+ /* Characters that can't be represented in an XLFD must be
+ replaced. */
+
+ for (x = 0; x < SBYTES (desc->adstyle); ++x)
+ {
+ c = SREF (desc->adstyle, x);
+ if (c == '-' || c == '*' || c == '?' && c == '"')
+ SSET (desc->adstyle, x, ' ');
+ }
+
+ desc->adstyle = Fintern (desc->adstyle, Qnil);
+ }
SAFE_FREE ();
}
diff --git a/src/sort.c b/src/sort.c
index a44bc75a516..56f33f924e9 100644
--- a/src/sort.c
+++ b/src/sort.c
@@ -37,17 +37,16 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
/* Reverse a slice of a vector in place, from lo up to (exclusive) hi. */
static void
-reverse_slice(Lisp_Object *lo, Lisp_Object *hi)
+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;
+ --hi;
+ while (lo < hi)
+ {
+ Lisp_Object t = *lo;
+ *lo = *hi;
+ *hi = t;
+ ++lo;
+ --hi;
}
}
@@ -59,7 +58,8 @@ reverse_slice(Lisp_Object *lo, Lisp_Object *hi)
Several convenience routines are provided here, so that keys and
values are always moved in sync. */
-typedef struct {
+typedef struct
+{
Lisp_Object *keys;
Lisp_Object *values;
} sortslice;
@@ -1068,9 +1068,9 @@ merge_compute_minrun (ptrdiff_t n)
static void
reverse_sortslice (sortslice *s, const ptrdiff_t n)
{
- reverse_slice(s->keys, &s->keys[n]);
+ reverse_slice (s->keys, &s->keys[n]);
if (s->values != NULL)
- reverse_slice(s->values, &s->values[n]);
+ reverse_slice (s->values, &s->values[n]);
}
static Lisp_Object
@@ -1111,7 +1111,7 @@ tim_sort (Lisp_Object predicate, Lisp_Object keyfunc,
Lisp_Object *allocated_keys = NULL;
merge_state ms;
- if (reverse)
+ if (reverse && 0 < length)
reverse_slice (seq, seq + length); /* preserve stability */
if (NILP (keyfunc))
@@ -1181,7 +1181,7 @@ tim_sort (Lisp_Object predicate, Lisp_Object keyfunc,
ms.pending[ms.n].len = n;
++ms.n;
/* Advance to find the next run. */
- sortslice_advance(&lo, n);
+ sortslice_advance (&lo, n);
nremaining -= n;
} while (nremaining);
diff --git a/src/sysdep.c b/src/sysdep.c
index cf2985b4b89..07237885cb9 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -2037,10 +2037,10 @@ init_signals (void)
main_thread_id = pthread_self ();
#endif
- /* Don't alter signal handlers if dumping. On some machines,
- changing signal handlers sets static data that would make signals
- fail to work right when the dumped Emacs is run. */
- if (will_dump_p ())
+ /* Don't alter signal handlers if dumping with unexec. On some
+ machines, changing signal handlers sets static data that would make
+ signals fail to work right when the dumped Emacs is run. */
+ if (will_dump_with_unexec_p ())
return;
sigfillset (&process_fatal_action.sa_mask);
diff --git a/src/term.c b/src/term.c
index 3fa244be824..351b0a4310c 100644
--- a/src/term.c
+++ b/src/term.c
@@ -1416,9 +1416,9 @@ term_get_fkeys_1 (void)
/* Define f0 first, so that f10 takes precedence in case the
key sequences happens to be the same. */
Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0),
- make_vector (1, intern ("f0")), Qnil);
+ make_vector (1, Qf0), Qnil);
Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k_semi),
- make_vector (1, intern ("f10")), Qnil);
+ make_vector (1, Qf10), Qnil);
}
else if (k0)
Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0),
@@ -2014,8 +2014,19 @@ turn_on_face (struct frame *f, int face_id)
OUTPUT1 (tty, tty->TS_enter_dim_mode);
}
- if (face->tty_underline_p && MAY_USE_WITH_COLORS_P (tty, NC_UNDERLINE))
- OUTPUT1_IF (tty, tty->TS_enter_underline_mode);
+ if (face->underline && MAY_USE_WITH_COLORS_P (tty, NC_UNDERLINE))
+ {
+ if (face->underline == FACE_UNDERLINE_SINGLE
+ || !tty->TF_set_underline_style)
+ OUTPUT1_IF (tty, tty->TS_enter_underline_mode);
+ else if (tty->TF_set_underline_style)
+ {
+ char *p;
+ p = tparam (tty->TF_set_underline_style, NULL, 0, face->underline, 0,
0, 0);
+ OUTPUT (tty, p);
+ xfree (p);
+ }
+ }
if (face->tty_strike_through_p
&& MAY_USE_WITH_COLORS_P (tty, NC_STRIKE_THROUGH))
@@ -2041,6 +2052,14 @@ turn_on_face (struct frame *f, int face_id)
OUTPUT (tty, p);
xfree (p);
}
+
+ ts = tty->TF_set_underline_color;
+ if (ts && face->underline_color)
+ {
+ p = tparam (ts, NULL, 0, face->underline_color, 0, 0, 0);
+ OUTPUT (tty, p);
+ xfree (p);
+ }
}
}
@@ -2061,7 +2080,7 @@ turn_off_face (struct frame *f, int face_id)
if (face->tty_bold_p
|| face->tty_italic_p
|| face->tty_reverse_p
- || face->tty_underline_p
+ || face->underline
|| face->tty_strike_through_p)
{
OUTPUT1_IF (tty, tty->TS_exit_attribute_mode);
@@ -2073,7 +2092,7 @@ turn_off_face (struct frame *f, int face_id)
{
/* If we don't have "me" we can only have those appearances
that have exit sequences defined. */
- if (face->tty_underline_p)
+ if (face->underline)
OUTPUT_IF (tty, tty->TS_exit_underline_mode);
}
@@ -2104,6 +2123,9 @@ tty_capable_p (struct tty_display_info *tty, unsigned int
caps)
TTY_CAPABLE_P_TRY (tty,
TTY_CAP_UNDERLINE, tty->TS_enter_underline_mode,
NC_UNDERLINE);
+ TTY_CAPABLE_P_TRY (tty,
+ TTY_CAP_UNDERLINE_STYLED, tty->TF_set_underline_style,
+ NC_UNDERLINE);
TTY_CAPABLE_P_TRY (tty,
TTY_CAP_BOLD, tty->TS_enter_bold_mode, NC_BOLD);
TTY_CAPABLE_P_TRY (tty,
@@ -2253,7 +2275,7 @@ set_tty_color_mode (struct tty_display_info *tty, struct
frame *f)
tty->previous_color_mode = mode;
tty_setup_colors (tty , mode);
/* This recomputes all the faces given the new color definitions. */
- safe_calln (intern ("tty-set-up-initial-frame-faces"));
+ safe_calln (Qtty_set_up_initial_frame_faces);
}
}
@@ -2290,7 +2312,7 @@ TERMINAL is not on a tty device. */)
{
struct terminal *t = decode_tty_terminal (terminal);
- return (t && !strcmp (t->display_info.tty->name, DEV_TTY) ? Qt : Qnil);
+ return (t && !strcmp (t->display_info.tty->name, dev_tty) ? Qt : Qnil);
}
DEFUN ("tty-no-underline", Ftty_no_underline, Stty_no_underline, 0, 1, 0,
@@ -2365,7 +2387,7 @@ A suspended tty may be resumed by calling `resume-tty' on
it. */)
the tty state. */
Lisp_Object term;
XSETTERMINAL (term, t);
- CALLN (Frun_hook_with_args, intern ("suspend-tty-functions"), term);
+ CALLN (Frun_hook_with_args, Qsuspend_tty_functions, term);
reset_sys_modes (t->display_info.tty);
delete_keyboard_wait_descriptor (fileno (f));
@@ -2445,7 +2467,7 @@ frame's terminal). */)
open_errno);
}
- if (!O_IGNORE_CTTY && strcmp (t->display_info.tty->name, DEV_TTY) != 0)
+ if (!O_IGNORE_CTTY && strcmp (t->display_info.tty->name, dev_tty) != 0)
dissociate_if_controlling_tty (fd);
#endif /* MSDOS */
@@ -2472,7 +2494,7 @@ frame's terminal). */)
/* Run `resume-tty-functions'. */
Lisp_Object term;
XSETTERMINAL (term, t);
- CALLN (Frun_hook_with_args, intern ("resume-tty-functions"), term);
+ CALLN (Frun_hook_with_args, Qresume_tty_functions, term);
}
set_tty_hooks (t);
@@ -3255,10 +3277,10 @@ tty_menu_activate (tty_menu *menu, int *pane, int
*selidx,
SAFE_NALLOCA (state, 1, menu->panecount);
memset (state, 0, sizeof (*state));
faces[0]
- = lookup_derived_face (NULL, sf, intern ("tty-menu-disabled-face"),
+ = lookup_derived_face (NULL, sf, Qtty_menu_disabled_face,
DEFAULT_FACE_ID, 1);
faces[1]
- = lookup_derived_face (NULL, sf, intern ("tty-menu-enabled-face"),
+ = lookup_derived_face (NULL, sf, Qtty_menu_enabled_face,
DEFAULT_FACE_ID, 1);
selectface = intern ("tty-menu-selected-face");
faces[2] = lookup_derived_face (NULL, sf, selectface,
@@ -4053,7 +4075,7 @@ dissociate_if_controlling_tty (int fd)
/* Create a termcap display on the tty device with the given name and
type.
- If NAME is NULL, then use the controlling tty, i.e., DEV_TTY.
+ If NAME is NULL, then use the controlling tty, i.e., dev_tty.
Otherwise NAME should be a path to the tty device file,
e.g. "/dev/pts/7".
@@ -4092,9 +4114,9 @@ init_tty (const char *name, const char *terminal_type,
bool must_succeed)
"Unknown terminal type");
if (name == NULL)
- name = DEV_TTY;
+ name = dev_tty;
#ifndef DOS_NT
- if (!strcmp (name, DEV_TTY))
+ if (!strcmp (name, dev_tty))
ctty = 1;
#endif
@@ -4360,6 +4382,26 @@ use the Bourne shell command 'TERM=...; export TERM'
(C-shell:\n\
tty->TF_underscore = tgetflag ("ul");
tty->TF_teleray = tgetflag ("xt");
+ /* Styled underlines. Support for this is provided either by the
+ escape sequence in Smulx or the Su flag. The latter results in a
+ common default escape sequence and is not recommended. */
+#ifdef TERMINFO
+ tty->TF_set_underline_style = tigetstr ("Smulx");
+ if (tty->TF_set_underline_style == (char *) (intptr_t) -1)
+ tty->TF_set_underline_style = NULL;
+#else
+ tty->TF_set_underline_style = tgetstr ("Smulx", address);
+#endif
+ if (!tty->TF_set_underline_style && tgetflag ("Su"))
+ /* Default to the kitty escape sequence. See
+ https://sw.kovidgoyal.net/kitty/underlines/. */
+ tty->TF_set_underline_style = "\x1b[4:%p1%dm";
+
+ if (tty->TF_set_underline_style)
+ /* Standard escape sequence to set the underline color.
+ Requires a single parameter, the color index. */
+ tty->TF_set_underline_color =
"\x1b[58:2::%p1%{65536}%/%d:%p1%{256}%/%{255}%&%d:%p1%{255}%&%dm";
+
#else /* DOS_NT */
#ifdef WINDOWSNT
{
@@ -4756,4 +4798,12 @@ trigger redisplay. */);
DEFSYM (Qtty_menu_mouse_movement, "tty-menu-mouse-movement");
DEFSYM (Qtty_menu_navigation_map, "tty-menu-navigation-map");
#endif
+ DEFSYM (Qf0, "f0");
+ DEFSYM (Qf10, "f10");
+ DEFSYM (Qtty_set_up_initial_frame_faces,
+ "tty-set-up-initial-frame-faces");
+ DEFSYM (Qsuspend_tty_functions, "suspend-tty-functions");
+ DEFSYM (Qresume_tty_functions, "resume-tty-functions");
+ DEFSYM (Qtty_menu_disabled_face, "tty-menu-disabled-face");
+ DEFSYM (Qtty_menu_enabled_face, "tty-menu-enabled-face");
}
diff --git a/src/termchar.h b/src/termchar.h
index 2d845107e11..a1df5a19518 100644
--- a/src/termchar.h
+++ b/src/termchar.h
@@ -171,6 +171,13 @@ struct tty_display_info
non-blank position. Must clear before
writing _. */
int TF_teleray; /* termcap xt flag: many weird consequences.
For t1061. */
+ const char *TF_set_underline_style; /* termcap Smulx entry: Switches the
underline
+ style based on the parameter. Param
should
+ be one of: 0 (none), 1 (straight), 2
(double-line),
+ 3 (wave), 4 (dots), or 5 (dashes). */
+ const char *TF_set_underline_color; /* Enabled when TF_set_underline_style
is set:
+ Sets the color of the underline.
Accepts a
+ single parameter, the color index. */
int RPov; /* # chars to start a TS_repeat */
diff --git a/src/terminal.c b/src/terminal.c
index 33f8623c214..6ab9dc753b3 100644
--- a/src/terminal.c
+++ b/src/terminal.c
@@ -295,14 +295,12 @@ create_terminal (enum output_method type, struct
redisplay_interface *rif)
/* If default coding systems for the terminal and the keyboard are
already defined, use them in preference to the defaults. This is
needed when Emacs runs in daemon mode. */
- keyboard_coding =
- find_symbol_value (intern ("default-keyboard-coding-system"));
+ keyboard_coding = find_symbol_value (Qdefault_keyboard_coding_system);
if (NILP (keyboard_coding)
|| BASE_EQ (keyboard_coding, Qunbound)
|| NILP (Fcoding_system_p (keyboard_coding)))
keyboard_coding = Qno_conversion;
- terminal_coding =
- find_symbol_value (intern ("default-terminal-coding-system"));
+ terminal_coding = find_symbol_value (Qdefault_terminal_coding_system);
if (NILP (terminal_coding)
|| BASE_EQ (terminal_coding, Qunbound)
|| NILP (Fcoding_system_p (terminal_coding)))
@@ -662,7 +660,6 @@ delete_initial_terminal (struct terminal *terminal)
void
syms_of_terminal (void)
{
-
DEFVAR_LISP ("ring-bell-function", Vring_bell_function,
doc: /* Non-nil means call this function to ring the bell.
The function should accept no arguments. */);
@@ -689,4 +686,6 @@ or some time later. */);
defsubr (&Sset_terminal_parameter);
Fprovide (intern_c_string ("multi-tty"), Qnil);
+ DEFSYM (Qdefault_keyboard_coding_system, "default-keyboard-coding-system");
+ DEFSYM (Qdefault_terminal_coding_system, "default-terminal-coding-system");
}
diff --git a/src/textconv.c b/src/textconv.c
index 9625c884e16..06d9af335c5 100644
--- a/src/textconv.c
+++ b/src/textconv.c
@@ -141,6 +141,10 @@ select_window (Lisp_Object window, Lisp_Object norecord)
w = XWINDOW (window);
+ /* Work around GCC bug 114893
+ <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114893>. */
+ eassume (w);
+
if (MINI_WINDOW_P (w)
&& WINDOW_LIVE_P (window)
&& !EQ (window, Factive_minibuffer_window ()))
@@ -195,6 +199,15 @@ textconv_query (struct frame *f, struct
textconv_callback_struct *query,
: f->selected_window), Qt);
w = XWINDOW (selected_window);
+ /* Narrow to the field, if any. */
+ if (!NILP (f->conversion.field))
+ {
+ record_unwind_protect (save_restriction_restore,
+ save_restriction_save ());
+ Fnarrow_to_region (XCAR (f->conversion.field),
+ XCAR (XCDR (f->conversion.field)));
+ }
+
/* Now find the appropriate text bounds for QUERY. First, move
point QUERY->position steps forward or backwards. */
@@ -488,6 +501,17 @@ record_buffer_change (ptrdiff_t beg, ptrdiff_t end,
Vtext_conversion_edits);
}
+/* Reset text conversion state of frame F, and resume text conversion.
+ Delete any overlays or markers inside. */
+
+void
+reset_frame_conversion (struct frame *f)
+{
+ reset_frame_state (f);
+ if (text_interface && FRAME_WINDOW_P (f) && FRAME_VISIBLE_P (f))
+ text_interface->reset (f);
+}
+
/* Reset text conversion state of frame F. Delete any overlays or
markers inside. */
@@ -530,6 +554,15 @@ reset_frame_state (struct frame *f)
/* Clear batch edit state. */
f->conversion.batch_edit_count = 0;
f->conversion.batch_edit_flags = 0;
+
+ /* Clear active field. */
+ if (!NILP (f->conversion.field))
+ {
+ Fset_marker (XCAR (f->conversion.field), Qnil, Qnil);
+ Fset_marker (XCAR (XCDR (f->conversion.field)), Qnil,
+ Qnil);
+ }
+ f->conversion.field = Qnil;
}
/* Return whether or not there are pending edits from an input method
@@ -1012,6 +1045,15 @@ really_delete_surrounding_text (struct frame *f,
ptrdiff_t left,
redisplay. */
select_window (f->old_selected_window, Qt);
+ /* Narrow to the field, if any. */
+ if (!NILP (f->conversion.field))
+ {
+ record_unwind_protect (save_restriction_restore,
+ save_restriction_save ());
+ Fnarrow_to_region (XCAR (f->conversion.field),
+ XCAR (XCDR (f->conversion.field)));
+ }
+
/* Figure out where to start deleting from. */
a = get_mark ();
@@ -1078,6 +1120,115 @@ really_delete_surrounding_text (struct frame *f,
ptrdiff_t left,
unbind_to (count, Qnil);
}
+/* Save the confines of the field surrounding point in w into F's text
+ conversion state. If NOTIFY_COMPOSE, notify the input method of
+ changes to the composition region if they arise in this process. */
+
+static void
+locate_and_save_position_in_field (struct frame *f, struct window *w,
+ bool notify_compose)
+{
+ Lisp_Object pos, window, c1, c2;
+ specpdl_ref count;
+ ptrdiff_t beg, end, cstart, cend, newstart, newend;
+
+ /* Set the current buffer to W's. */
+ count = SPECPDL_INDEX ();
+ record_unwind_protect (restore_selected_window, selected_window);
+ XSETWINDOW (window, w);
+ select_window (window, Qt);
+
+ /* Search for a field around the current editing position; this should
+ also serve to confine text conversion to the visible region. */
+ XSETFASTINT (pos, min (max (w->ephemeral_last_point, BEGV), ZV));
+ find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
+
+ /* If beg is 1 and end is ZV, disable the active field entirely. */
+ if (beg == 1 && end == ZV)
+ {
+ f->conversion.field = Qnil;
+ goto exit;
+ }
+
+ /* Don't cons if a pair already exists. */
+ if (!NILP (f->conversion.field))
+ {
+ c1 = f->conversion.field;
+ c2 = XCDR (c1);
+ Fset_marker (XCAR (c1), make_fixed_natnum (beg), Qnil);
+ Fset_marker (XCAR (c2), make_fixed_natnum (end), Qnil);
+ XSETCDR (c2, window);
+ }
+ else
+ {
+ c1 = build_marker (current_buffer, beg, CHAR_TO_BYTE (beg));
+ c2 = build_marker (current_buffer, end, CHAR_TO_BYTE (end));
+ Fset_marker_insertion_type (c2, Qt);
+ f->conversion.field = Fcons (c1, Fcons (c2, window));
+ }
+
+ /* If the composition region is active and oversteps the active field,
+ restrict it to the same. */
+
+ if (!NILP (f->conversion.compose_region_start))
+ {
+ cstart = marker_position (f->conversion.compose_region_start);
+ cend = marker_position (f->conversion.compose_region_end);
+
+ if (cend < beg || cstart > end)
+ {
+ /* Remove the composition region in whole. */
+ /* Make the composition region markers point elsewhere. */
+
+ if (!NILP (f->conversion.compose_region_start))
+ {
+ Fset_marker (f->conversion.compose_region_start, Qnil, Qnil);
+ Fset_marker (f->conversion.compose_region_end, Qnil, Qnil);
+ f->conversion.compose_region_start = Qnil;
+ f->conversion.compose_region_end = Qnil;
+ }
+
+ /* Delete the composition region overlay. */
+
+ if (!NILP (f->conversion.compose_region_overlay))
+ Fdelete_overlay (f->conversion.compose_region_overlay);
+
+ TEXTCONV_DEBUG ("removing composing region outside active field");
+ }
+ else
+ {
+ newstart = max (beg, min (cstart, end));
+ newend = max (beg, min (cend, end));
+
+ if (newstart != cstart || newend != cend)
+ {
+ TEXTCONV_DEBUG ("confined composing region to %td, %td",
+ newstart, newend);
+ Fset_marker (f->conversion.compose_region_end,
+ make_fixed_natnum (newstart), Qnil);
+ Fset_marker (f->conversion.compose_region_end,
+ make_fixed_natnum (newend), Qnil);
+ }
+ else
+ notify_compose = false;
+ }
+ }
+ else
+ notify_compose = false;
+
+ if (notify_compose
+ && text_interface->compose_region_changed)
+ {
+ if (f->conversion.batch_edit_count > 0)
+ f->conversion.batch_edit_flags |= PENDING_COMPOSE_CHANGE;
+ else
+ text_interface->compose_region_changed (f);
+ }
+
+ exit:
+ unbind_to (count, Qnil);
+}
+
/* Update the interface with frame F's new point and mark. If a batch
edit is in progress, schedule the update for when it finishes
instead. */
@@ -1085,6 +1236,8 @@ really_delete_surrounding_text (struct frame *f,
ptrdiff_t left,
static void
really_request_point_update (struct frame *f)
{
+ struct window *w;
+
/* If F's old selected window is no longer live, fail. */
if (!WINDOW_LIVE_P (f->old_selected_window))
@@ -1093,9 +1246,11 @@ really_request_point_update (struct frame *f)
if (f->conversion.batch_edit_count > 0)
f->conversion.batch_edit_flags |= PENDING_POINT_CHANGE;
else if (text_interface && text_interface->point_changed)
- text_interface->point_changed (f,
- XWINDOW (f->old_selected_window),
- current_buffer);
+ {
+ w = XWINDOW (f->old_selected_window);
+ locate_and_save_position_in_field (f, w, false);
+ text_interface->point_changed (f, w, current_buffer);
+ }
}
/* Set point in frame F's selected window to POSITION. If MARK is not
@@ -1130,9 +1285,11 @@ really_set_point_and_mark (struct frame *f, ptrdiff_t
point,
if (f->conversion.batch_edit_count > 0)
f->conversion.batch_edit_flags |= PENDING_POINT_CHANGE;
else if (text_interface && text_interface->point_changed)
- text_interface->point_changed (f,
- XWINDOW (f->old_selected_window),
- current_buffer);
+ {
+ w = XWINDOW (f->old_selected_window);
+ locate_and_save_position_in_field (f, w, false);
+ text_interface->point_changed (f, w, current_buffer);
+ }
}
else
/* Set the point. */
@@ -1331,7 +1488,10 @@ complete_edit_check (void *ptr)
if (f->conversion.batch_edit_count > 0)
f->conversion.batch_edit_flags |= PENDING_POINT_CHANGE;
else
- text_interface->point_changed (f, context->w, NULL);
+ {
+ locate_and_save_position_in_field (f, context->w, false);
+ text_interface->point_changed (f, context->w, NULL);
+ }
}
}
}
@@ -1400,7 +1560,10 @@ handle_pending_conversion_events_1 (struct frame *f,
break;
if (f->conversion.batch_edit_flags & PENDING_POINT_CHANGE)
- text_interface->point_changed (f, w, buffer);
+ {
+ locate_and_save_position_in_field (f, w, false);
+ text_interface->point_changed (f, w, buffer);
+ }
if (f->conversion.batch_edit_flags & PENDING_COMPOSE_CHANGE)
text_interface->compose_region_changed (f);
@@ -1529,7 +1692,10 @@ handle_pending_conversion_events (void)
if (f->conversion.batch_edit_count > 0)
f->conversion.batch_edit_flags |= PENDING_POINT_CHANGE;
else
- text_interface->point_changed (f, NULL, NULL);
+ {
+ locate_and_save_position_in_field (f, w, false);
+ text_interface->point_changed (f, NULL, NULL);
+ }
}
last_point = w->ephemeral_last_point;
@@ -1564,6 +1730,39 @@ handle_pending_conversion_events (void)
unbind_to (count, Qnil);
}
+/* Return the confines of the field to which editing operations on frame
+ F should be constrained in *BEG and *END. Should no field be active,
+ set *END to MOST_POSITIVE_FIXNUM. */
+
+void
+get_conversion_field (struct frame *f, ptrdiff_t *beg, ptrdiff_t *end)
+{
+ Lisp_Object c1, c2;
+ struct window *w;
+
+ if (!NILP (f->conversion.field))
+ {
+ c1 = f->conversion.field;
+ c2 = XCDR (c1);
+
+ if (!EQ (XCDR (c2), f->old_selected_window))
+ {
+ /* Update this outdated field location. */
+ w = XWINDOW (f->old_selected_window);
+ locate_and_save_position_in_field (f, w, true);
+ get_conversion_field (f, beg, end);
+ return;
+ }
+
+ *beg = marker_position (XCAR (c1));
+ *end = marker_position (XCAR (c2));
+ return;
+ }
+
+ *beg = 1;
+ *end = MOST_POSITIVE_FIXNUM;
+}
+
/* Start a ``batch edit'' in frame F. During a batch edit,
point_changed will not be called until the batch edit ends.
@@ -1694,7 +1893,8 @@ set_composing_text (struct frame *f, Lisp_Object object,
}
/* Make the region between START and END the currently active
- ``composing region'' on frame F.
+ ``composing region'' on frame F. Which of START and END is the
+ larger value is not significant.
The ``composing region'' is a region of text in the buffer that is
about to undergo editing by the input method. */
@@ -1704,14 +1904,22 @@ set_composing_region (struct frame *f, ptrdiff_t start,
ptrdiff_t end, unsigned long counter)
{
struct text_conversion_action *action, **last;
+ ptrdiff_t field_start, field_end, temp;
+
+ if (start > end)
+ {
+ temp = end;
+ end = start;
+ start = temp;
+ }
- start = min (start, MOST_POSITIVE_FIXNUM);
- end = min (end, MOST_POSITIVE_FIXNUM);
+ get_conversion_field (f, &field_start, &field_end);
+ start = min (start + field_start - 1, MOST_POSITIVE_FIXNUM);
+ end = max (start, min (end + field_start - 1, field_end));
action = xmalloc (sizeof *action);
action->operation = TEXTCONV_SET_COMPOSING_REGION;
- action->data = Fcons (make_fixnum (start),
- make_fixnum (end));
+ action->data = Fcons (make_fixnum (start), make_fixnum (end));
action->next = NULL;
action->counter = counter;
for (last = &f->conversion.actions; *last; last = &(*last)->next)
@@ -1730,8 +1938,13 @@ textconv_set_point_and_mark (struct frame *f, ptrdiff_t
point,
ptrdiff_t mark, unsigned long counter)
{
struct text_conversion_action *action, **last;
+ ptrdiff_t field_start, field_end;
- point = min (point, MOST_POSITIVE_FIXNUM);
+ get_conversion_field (f, &field_start, &field_end);
+ point = min (max (point + field_start - 1, field_start),
+ field_end);
+ mark = min (max (mark + field_start - 1, field_start),
+ field_end);
action = xmalloc (sizeof *action);
action->operation = TEXTCONV_SET_POINT_AND_MARK;
@@ -1809,10 +2022,11 @@ textconv_barrier (struct frame *f, unsigned long
counter)
input_pending = true;
}
-/* Remove the composing region. Replace the text between START and
- END within F's selected window with TEXT; deactivate the mark if it
- is active. Subsequently, set point to POSITION relative to TEXT,
- much as `commit_text' would. */
+/* Remove the composing region. Replace the text between START and END
+ (whose order, as in `set_composing_region', is not significant)
+ within F's selected window with TEXT; deactivate the mark if it is
+ active. Subsequently, set point to POSITION relative to TEXT, as
+ `commit_text' would. */
void
replace_text (struct frame *f, ptrdiff_t start, ptrdiff_t end,
@@ -1820,6 +2034,18 @@ replace_text (struct frame *f, ptrdiff_t start,
ptrdiff_t end,
unsigned long counter)
{
struct text_conversion_action *action, **last;
+ ptrdiff_t field_start, field_end, temp;
+
+ if (start > end)
+ {
+ temp = end;
+ end = start;
+ start = temp;
+ }
+
+ get_conversion_field (f, &field_start, &field_end);
+ start = min (start + field_start - 1, MOST_POSITIVE_FIXNUM);
+ end = max (start, min (end + field_start - 1, field_end));
action = xmalloc (sizeof *action);
action->operation = TEXTCONV_REPLACE_TEXT;
@@ -1858,6 +2084,7 @@ get_extracted_text (struct frame *f, ptrdiff_t n,
specpdl_ref count;
ptrdiff_t start, end, start_byte, end_byte, mark;
char *buffer;
+ ptrdiff_t field_start, field_end;
if (!WINDOW_LIVE_P (f->old_selected_window))
return NULL;
@@ -1907,6 +2134,15 @@ get_extracted_text (struct frame *f, ptrdiff_t n,
goto finish;
}
+ /* Narrow to the field, if any. */
+ if (!NILP (f->conversion.field))
+ {
+ record_unwind_protect (save_restriction_restore,
+ save_restriction_save ());
+ Fnarrow_to_region (XCAR (f->conversion.field),
+ XCAR (XCDR (f->conversion.field)));
+ }
+
start = max (start, BEGV);
end = min (end, ZV);
@@ -1935,7 +2171,8 @@ get_extracted_text (struct frame *f, ptrdiff_t n,
}
/* Return the offsets. */
- *start_return = start;
+ get_conversion_field (f, &field_start, &field_end);
+ *start_return = max (1, start - field_start + 1);
*start_offset = min (mark - start, PT - start);
*end_offset = max (mark - start, PT - start);
*length = end - start;
@@ -1968,6 +2205,7 @@ get_surrounding_text (struct frame *f, ptrdiff_t left,
{
specpdl_ref count;
ptrdiff_t start, end, start_byte, end_byte, mark, temp;
+ ptrdiff_t field_start, field_end;
char *buffer;
if (!WINDOW_LIVE_P (f->old_selected_window))
@@ -2012,6 +2250,15 @@ get_surrounding_text (struct frame *f, ptrdiff_t left,
|| ckd_add (&end, end, right))
goto finish;
+ /* Narrow to the field, if any. */
+ if (!NILP (f->conversion.field))
+ {
+ record_unwind_protect (save_restriction_restore,
+ save_restriction_save ());
+ Fnarrow_to_region (XCAR (f->conversion.field),
+ XCAR (XCDR (f->conversion.field)));
+ }
+
start = max (start, BEGV);
end = min (end, ZV);
@@ -2038,7 +2285,8 @@ get_surrounding_text (struct frame *f, ptrdiff_t left,
/* Return the offsets. Unlike `get_extracted_text', this need not
sort mark and point. */
- *offset = start;
+ get_conversion_field (f, &field_start, &field_end);
+ *offset = max (1, start - field_start + 1);
*start_return = mark - start;
*end_return = PT - start;
*length = end - start;
@@ -2110,7 +2358,10 @@ report_point_change (struct frame *f, struct window
*window,
if (f->conversion.batch_edit_count > 0)
f->conversion.batch_edit_flags |= PENDING_POINT_CHANGE;
else
- text_interface->point_changed (f, window, buffer);
+ {
+ locate_and_save_position_in_field (f, window, false);
+ text_interface->point_changed (f, window, buffer);
+ }
}
/* Temporarily disable text conversion. Must be paired with a
@@ -2348,8 +2599,9 @@ as indenting or automatically filling text, should not
take place.
Otherwise, it is either a string containing text that was inserted,
text deleted before point, or nil if text was deleted after point.
-The list contents are ordered in the reverse order of editing, i.e.
-the latest edit first, so you must iterate through the list in reverse. */);
+The list contents are arranged in the reverse of the order of editing,
+i.e. latest edit first, so you must iterate through the list in
+reverse. */);
Vtext_conversion_edits = Qnil;
DEFVAR_LISP ("overriding-text-conversion-style",
diff --git a/src/textconv.h b/src/textconv.h
index 61f13ebcb43..e87ff5cd1f8 100644
--- a/src/textconv.h
+++ b/src/textconv.h
@@ -155,6 +155,7 @@ extern char *get_surrounding_text (struct frame *,
ptrdiff_t,
extern bool conversion_disabled_p (void);
extern void check_postponed_buffers (void);
+extern void get_conversion_field (struct frame *, ptrdiff_t *, ptrdiff_t *);
extern void register_textconv_interface (struct textconv_interface *);
#endif /* _TEXTCONV_H_ */
diff --git a/src/textprop.c b/src/textprop.c
index 7d9aae0d2c5..84d6b5f1545 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -2186,6 +2186,7 @@ verify_interval_modification (struct buffer *buf,
{
INTERVAL intervals = buffer_intervals (buf);
INTERVAL i;
+ ptrdiff_t p;
Lisp_Object hooks;
Lisp_Object prev_mod_hooks;
Lisp_Object mod_hooks;
@@ -2314,14 +2315,30 @@ verify_interval_modification (struct buffer *buf,
}
else
{
+ bool buffer_read_only;
+
/* Loop over intervals on or next to START...END,
collecting their hooks. */
+ /* Extent of last writable interval. */
i = find_interval (intervals, start);
+ p = 0;
+ buffer_read_only = (!NILP (BVAR (current_buffer, read_only))
+ && NILP (Vinhibit_read_only));
do
{
- if (! INTERVAL_WRITABLE_P (i))
- text_read_only (textget (i->plist, Qread_only));
+ bool implied, express;
+ Lisp_Object read_only;
+
+ read_only = textget ((i)->plist, Qread_only);
+ implied = INTERVAL_GENERALLY_WRITABLE_P (i, read_only);
+ express = INTERVAL_EXPRESSLY_WRITABLE_P (i, read_only);
+ if (!implied && !express)
+ text_read_only (read_only);
+ /* If this interval is only implicitly read only and the
+ buffer is read only as a whole, signal an error. */
+ else if (!express && buffer_read_only)
+ xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
if (!inhibit_modification_hooks)
{
@@ -2333,16 +2350,18 @@ verify_interval_modification (struct buffer *buf,
}
}
- if (i->position + LENGTH (i) < end
- && (!NILP (BVAR (current_buffer, read_only))
- && NILP (Vinhibit_read_only)))
- xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
-
+ p = i->position + LENGTH (i);
i = next_interval (i);
}
/* Keep going thru the interval containing the char before END. */
while (i && i->position < end);
+ /* Should the buffer be read only while the last interval with an
+ `inhibit-read-only' property does not enclose the entire change
+ under consideration, signal error. */
+ if (p < end && buffer_read_only)
+ xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
+
if (!inhibit_modification_hooks)
{
hooks = Fnreverse (hooks);
diff --git a/src/thread.c b/src/thread.c
index 6eeb516d568..192a4caa8ac 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -57,7 +57,7 @@ union aligned_thread_state main_thread
struct thread_state *current_thread = &main_thread.s;
-static struct thread_state *all_threads = &main_thread.s;
+struct thread_state *all_threads = &main_thread.s;
static sys_mutex_t global_lock;
diff --git a/src/thread.h b/src/thread.h
index 6a22de29478..fa350849146 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -323,6 +323,7 @@ XCONDVAR (Lisp_Object a)
}
extern struct thread_state *current_thread;
+extern struct thread_state *all_threads;
extern void finalize_one_thread (struct thread_state *state);
extern void finalize_one_mutex (struct Lisp_Mutex *);
diff --git a/src/treesit.c b/src/treesit.c
index d86ab501187..52d158b1bf8 100644
--- a/src/treesit.c
+++ b/src/treesit.c
@@ -1017,9 +1017,8 @@ treesit_check_buffer_size (struct buffer *buffer)
static Lisp_Object treesit_make_ranges (const TSRange *, uint32_t, struct
buffer *);
-static void
-treesit_call_after_change_functions (TSTree *old_tree, TSTree *new_tree,
- Lisp_Object parser)
+static Lisp_Object
+treesit_get_changed_ranges (TSTree *old_tree, TSTree *new_tree, Lisp_Object
parser)
{
/* If the old_tree is NULL, meaning this is the first parse, the
changed range is the whole buffer. */
@@ -1039,7 +1038,13 @@ treesit_call_after_change_functions (TSTree *old_tree,
TSTree *new_tree,
lisp_ranges = Fcons (Fcons (Fpoint_min (), Fpoint_max ()), Qnil);
set_buffer_internal (oldbuf);
}
+ return lisp_ranges;
+}
+static void
+treesit_call_after_change_functions (Lisp_Object lisp_ranges,
+ Lisp_Object parser)
+{
specpdl_ref count = SPECPDL_INDEX ();
/* let's trust the after change functions and not clone a new ranges
@@ -1091,13 +1096,17 @@ treesit_ensure_parsed (Lisp_Object parser)
XTS_PARSER (parser)->tree = new_tree;
XTS_PARSER (parser)->need_reparse = false;
+ Lisp_Object changed_ranges;
+ changed_ranges = treesit_get_changed_ranges (tree, new_tree, parser);
+ XTS_PARSER (parser)->last_changed_ranges = changed_ranges;
+
/* After-change functions should run at the very end, most crucially
after need_reparse is set to false, this way if the function
calls some tree-sitter function which invokes
treesit_ensure_parsed again, it returns early and do not
recursively call the after change functions again.
(ref:notifier-inside-ensure-parsed) */
- treesit_call_after_change_functions (tree, new_tree, parser);
+ treesit_call_after_change_functions (changed_ranges, parser);
ts_tree_delete (tree);
}
@@ -1171,6 +1180,7 @@ make_treesit_parser (Lisp_Object buffer, TSParser *parser,
lisp_parser->after_change_functions = Qnil;
lisp_parser->tag = tag;
lisp_parser->last_set_ranges = Qnil;
+ lisp_parser->last_changed_ranges = Qnil;
lisp_parser->buffer = buffer;
lisp_parser->parser = parser;
lisp_parser->tree = tree;
@@ -1818,6 +1828,32 @@ positions. PARSER is the parser issuing the
notification. */)
return Qnil;
}
+DEFUN ("treesit-parser-changed-ranges", Ftreesit_parser_changed_ranges,
+ Streesit_parser_changed_ranges,
+ 1, 2, 0,
+ doc: /* Return the buffer regions affected by the last reparse of
PARSER.
+
+Returns a list of cons cells (BEG . END), where each cons cell represents
+a region in which changes in buffer contents affected the last reparse.
+
+This function should almost always be called immediately after
+reparsing. If it's called when there are new buffer edits that hasn't
+been reparsed, Emacs signals the `treesit-unparsed-edits' error, unless
+optional argument QUIET is non-nil.
+
+Calling this function multiple times consecutively doesn't change its
+return value; it always returns the ranges affected by the last
+reparse. */)
+ (Lisp_Object parser, Lisp_Object quiet)
+{
+ treesit_check_parser (parser);
+
+ if (XTS_PARSER (parser)->need_reparse && NILP (quiet))
+ xsignal1 (Qtreesit_unparsed_edits, parser);
+
+ return XTS_PARSER (parser)->last_changed_ranges;
+}
+
/*** Node API */
@@ -4010,6 +4046,7 @@ syms_of_treesit (void)
DEFSYM (Qtreesit_query_error, "treesit-query-error");
DEFSYM (Qtreesit_parse_error, "treesit-parse-error");
DEFSYM (Qtreesit_range_invalid, "treesit-range-invalid");
+ DEFSYM (Qtreesit_unparsed_edits, "treesit-unparsed_edits");
DEFSYM (Qtreesit_buffer_too_large,
"treesit-buffer-too-large");
DEFSYM (Qtreesit_load_language_error,
@@ -4038,6 +4075,8 @@ syms_of_treesit (void)
define_error (Qtreesit_range_invalid,
"RANGES are invalid: they have to be ordered and should not
overlap",
Qtreesit_error);
+ define_error (Qtreesit_unparsed_edits, "There are unparsed edits in the
buffer",
+ Qtreesit_error);
define_error (Qtreesit_buffer_too_large, "Buffer too large (> 4GiB)",
Qtreesit_error);
define_error (Qtreesit_load_language_error,
@@ -4178,6 +4217,8 @@ the symbol of that THING. For example, (or sexp
sentence). */);
defsubr (&Streesit_parser_add_notifier);
defsubr (&Streesit_parser_remove_notifier);
+ defsubr (&Streesit_parser_changed_ranges);
+
defsubr (&Streesit_node_type);
defsubr (&Streesit_node_start);
defsubr (&Streesit_node_end);
diff --git a/src/treesit.h b/src/treesit.h
index bb81bf0e2b3..aa71933fe8d 100644
--- a/src/treesit.h
+++ b/src/treesit.h
@@ -49,6 +49,9 @@ struct Lisp_TS_Parser
ranges the users wants to set, and avoid reparse if the new
ranges is the same as the last set one. */
Lisp_Object last_set_ranges;
+ /* The range of buffer content that was affected by the last
+ re-parse. */
+ Lisp_Object last_changed_ranges;
/* The buffer associated with this parser. */
Lisp_Object buffer;
/* The pointer to the tree-sitter parser. Never NULL. */
diff --git a/src/unexelf.c b/src/unexelf.c
index feb26ffaeaf..a9a8f2d6ce9 100644
--- a/src/unexelf.c
+++ b/src/unexelf.c
@@ -306,6 +306,8 @@ unexec (const char *new_name, const char *old_name)
old_bss_seg = seg;
}
eassume (old_bss_seg);
+ if (!old_bss_seg)
+ emacs_abort ();
/* Note that old_bss_addr may be lower than the first bss section
address, since the section may need aligning. */
diff --git a/src/w32.c b/src/w32.c
index d34ab70f82d..a1b34e4103b 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -2572,7 +2572,7 @@ parse_root (const char * name, const char ** pPath)
name += 2;
do
{
- if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
+ if (!*name || (IS_DIRECTORY_SEP (*name) && --slashes == 0))
break;
name++;
}
diff --git a/src/w32fns.c b/src/w32fns.c
index ace8d1016a5..8b61b54bdc5 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -6539,7 +6539,7 @@ DEFUN ("x-display-backing-store",
Fx_display_backing_store,
doc: /* SKIP: real doc in xfns.c. */)
(Lisp_Object display)
{
- return intern ("not-useful");
+ return Qnot_useful;
}
DEFUN ("x-display-visual-class", Fx_display_visual_class,
@@ -6551,13 +6551,13 @@ DEFUN ("x-display-visual-class",
Fx_display_visual_class,
Lisp_Object result = Qnil;
if (dpyinfo->has_palette)
- result = intern ("pseudo-color");
+ result = Qpseudo_color;
else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
- result = intern ("static-gray");
+ result = Qstatic_gray;
else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
- result = intern ("static-color");
+ result = Qstatic_color;
else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
- result = intern ("true-color");
+ result = Qtrue_color;
return result;
}
@@ -6773,17 +6773,17 @@ SOUND is nil to use the normal beep. */)
if (NILP (sound))
sound_type = 0xFFFFFFFF;
- else if (EQ (sound, intern ("asterisk")))
+ else if (EQ (sound, Qasterisk))
sound_type = MB_ICONASTERISK;
- else if (EQ (sound, intern ("exclamation")))
+ else if (EQ (sound, Qexclamation))
sound_type = MB_ICONEXCLAMATION;
- else if (EQ (sound, intern ("hand")))
+ else if (EQ (sound, Qhand))
sound_type = MB_ICONHAND;
- else if (EQ (sound, intern ("question")))
+ else if (EQ (sound, Qquestion))
sound_type = MB_ICONQUESTION;
- else if (EQ (sound, intern ("ok")))
+ else if (EQ (sound, Qok))
sound_type = MB_OK;
- else if (EQ (sound, intern ("silent")))
+ else if (EQ (sound, Qsilent))
sound_type = MB_EMACS_SILENT;
else
sound_type = 0xFFFFFFFF;
@@ -6854,7 +6854,7 @@ DEFUN ("x-open-connection", Fx_open_connection,
Sx_open_connection,
if (NILP (Ffile_readable_p (color_file)))
color_file =
Fexpand_file_name (build_string ("rgb.txt"),
- Fsymbol_value (intern ("data-directory")));
+ Fsymbol_value (Qdata_directory));
Vw32_color_map = Fx_load_color_file (color_file);
}
@@ -7749,8 +7749,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
start_timer:
/* Let the tip disappear after timeout seconds. */
- tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
- intern ("x-hide-tip"));
+ tip_timer = call3 (Qrun_at_time, timeout, Qnil,
+ Qx_hide_tip);
return unbind_to (count, Qnil);
}
@@ -8188,15 +8188,14 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog,
2, 5, 0,
filename = Qnil;
/* An error occurred, fallback on reading from the mini-buffer. */
else
- filename = Fcompleting_read (
- orig_prompt,
- intern ("read-file-name-internal"),
- orig_dir,
- mustmatch,
- orig_dir,
- Qfile_name_history,
- default_filename,
- Qnil);
+ filename = Fcompleting_read (orig_prompt,
+ Qread_file_name_internal,
+ orig_dir,
+ mustmatch,
+ orig_dir,
+ Qfile_name_history,
+ default_filename,
+ Qnil);
}
/* Make "Cancel" equivalent to C-g. */
@@ -8223,7 +8222,7 @@ DEFUN ("system-move-file-to-trash",
Fsystem_move_file_to_trash,
if (!NILP (Ffile_directory_p (filename))
&& NILP (Ffile_symlink_p (filename)))
{
- operation = intern ("delete-directory");
+ operation = Qdelete_directory;
filename = Fdirectory_file_name (filename);
}
@@ -8927,11 +8926,11 @@ to change the state. */)
int vk_code;
LPARAM lparam;
- if (EQ (key, intern ("capslock")))
+ if (EQ (key, Qcapslock))
vk_code = VK_CAPITAL;
- else if (EQ (key, intern ("kp-numlock")))
+ else if (EQ (key, Qkp_numlock))
vk_code = VK_NUMLOCK;
- else if (EQ (key, intern ("scroll")))
+ else if (EQ (key, Qscroll))
vk_code = VK_SCROLL;
else
return Qnil;
@@ -10714,6 +10713,7 @@ syms_of_w32fns (void)
DEFSYM (Qtip_frame, "tip-frame");
DEFSYM (Qassq_delete_all, "assq-delete-all");
DEFSYM (Qunicode_sip, "unicode-sip");
+ DEFSYM (Qread_file_name_internal, "read-file-name-internal");
#if defined WINDOWSNT && !defined HAVE_DBUS
DEFSYM (QCicon, ":icon");
DEFSYM (QCtip, ":tip");
@@ -11108,6 +11108,23 @@ keys when IME input is received. */);
defsubr (&Ssystem_move_file_to_trash);
defsubr (&Sw32_set_wallpaper);
#endif
+
+ DEFSYM (Qnot_useful, "not-useful");
+ DEFSYM (Qpseudo_color, "pseudo-color");
+ DEFSYM (Qstatic_gray, "static-gray");
+ DEFSYM (Qstatic_color, "static-color");
+ DEFSYM (Qtrue_color, "true-color");
+ DEFSYM (Qasterisk, "asterisk");
+ DEFSYM (Qexclamation, "exclamation");
+ DEFSYM (Qquestion, "question");
+ DEFSYM (Qok, "ok");
+ DEFSYM (Qsilent, "silent");
+ DEFSYM (Qdata_directory, "data-directory");
+ DEFSYM (Qrun_at_time, "run-at-time");
+ DEFSYM (Qx_hide_tip, "x-hide-tip");
+ DEFSYM (Qcapslock, "capslock");
+ DEFSYM (Qkp_numlock, "kp-numlock");
+ DEFSYM (Qscroll, "scroll");
}
diff --git a/src/w32font.c b/src/w32font.c
index 56061c0d9ce..1c2da1b26fc 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -1196,15 +1196,15 @@ w32_enumfont_pattern_entity (Lisp_Object frame,
if (EQ (backend, Quniscribe) && (full_type & NTMFLAGS_OPENTYPE))
tem = Qopentype;
else if (font_type & TRUETYPE_FONTTYPE)
- tem = intern ("truetype");
+ tem = Qtruetype;
else if (full_type & NTM_PS_OPENTYPE)
tem = Qpostscript;
else if (full_type & NTM_TYPE1)
- tem = intern ("type1");
+ tem = Qtype1;
else if (font_type & RASTER_FONTTYPE)
- tem = intern ("w32bitmap");
+ tem = Qw32bitmap;
else
- tem = intern ("w32vector");
+ tem = Qw32vector;
font_put_extra (entity, QCformat, tem);
@@ -2773,6 +2773,12 @@ syms_of_w32font (void)
DEFSYM (Qsubpixel, "subpixel");
DEFSYM (Qnatural, "natural");
+ /* Font formats. */
+ DEFSYM (Qtruetype, "truetype");
+ DEFSYM (Qtype1, "type1");
+ DEFSYM (Qw32bitmap, "w32bitmap");
+ DEFSYM (Qw32vector, "w32vector");
+
/* Languages */
DEFSYM (Qzh, "zh");
diff --git a/src/w32term.c b/src/w32term.c
index 96f8530ab00..9520f0782a4 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -1455,7 +1455,7 @@ static void
w32_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
{
struct glyph *glyph = s->first_glyph;
- unsigned char2b[8];
+ static unsigned char2b[8];
int x, i, j;
bool with_background;
@@ -2535,6 +2535,89 @@ w32_draw_stretch_glyph_string (struct glyph_string *s)
s->background_filled_p = true;
}
+/* Draw a dashed underline of thickness THICKNESS and width WIDTH onto F
+ at a vertical offset of OFFSET from the position of the glyph string
+ S, with each segment SEGMENT pixels in length, and in the color
+ FOREGROUND. */
+
+static void
+w32_draw_dash (struct frame *f, struct glyph_string *s,
+ COLORREF foreground, int width, char segment,
+ int offset, int thickness)
+{
+ int y_base, which, length, x, doffset;
+ HDC hdc = s->hdc;
+
+ /* A pen with PS_DASH (or PS_DOT) is unsuitable for two reasons: first
+ that PS_DASH does not accept width values greater than 1, with
+ itself considered equivalent to PS_SOLID if such a value be
+ specified, and second that it does not provide for an offset to be
+ applied to the pattern, absent which Emacs cannot align dashes that
+ are displayed at locations not multiples of each other. I can't be
+ bothered to research this matter further, so, for want of a better
+ option, draw the specified pattern manually. */
+
+ y_base = s->ybase + offset;
+
+ /* Remove redundant portions of OFFSET. */
+ doffset = s->x % (segment * 2);
+
+ /* Set which to the phase of the first dash that ought to be drawn and
+ length to its length. */
+ which = doffset < segment;
+ length = segment - (s->x % segment);
+
+ /* Begin drawing this dash. */
+ for (x = s->x; x < s->x + width; x += length, length = segment)
+ {
+ if (which)
+ w32_fill_area (f, hdc, foreground, x, y_base, length,
+ thickness);
+
+ which = !which;
+ }
+}
+
+/* Draw an underline of STYLE onto F at an offset of POSITION from the
+ baseline of the glyph string S, in the color FOREGROUND that is
+ THICKNESS in height. */
+
+static void
+w32_fill_underline (struct frame *f, struct glyph_string *s,
+ COLORREF foreground,
+ enum face_underline_type style, int position,
+ int thickness)
+{
+ int segment;
+
+ segment = thickness * 3;
+
+ switch (style)
+ {
+ /* FACE_UNDERLINE_DOUBLE_LINE is treated identically to SINGLE, as
+ the second line will be filled by another invocation of this
+ function. */
+ case FACE_UNDERLINE_SINGLE:
+ case FACE_UNDERLINE_DOUBLE_LINE:
+ w32_fill_area (s->f, s->hdc, foreground, s->x,
+ s->ybase + position, s->width, thickness);
+ break;
+
+ case FACE_UNDERLINE_DOTS:
+ segment = thickness;
+ FALLTHROUGH;
+
+ case FACE_UNDERLINE_DASHES:
+ w32_draw_dash (f, s, foreground, s->width, segment, position,
+ thickness);
+ break;
+
+ case FACE_NO_UNDERLINE:
+ case FACE_UNDERLINE_WAVE:
+ default:
+ emacs_abort ();
+ }
+}
/* Draw glyph string S. */
@@ -2641,7 +2724,7 @@ w32_draw_glyph_string (struct glyph_string *s)
/* Draw underline. */
if (s->face->underline)
{
- if (s->face->underline == FACE_UNDER_WAVE)
+ if (s->face->underline == FACE_UNDERLINE_WAVE)
{
COLORREF color;
@@ -2652,13 +2735,14 @@ w32_draw_glyph_string (struct glyph_string *s)
w32_draw_underwave (s, color);
}
- else if (s->face->underline == FACE_UNDER_LINE)
+ else if (s->face->underline >= FACE_UNDERLINE_SINGLE)
{
unsigned long thickness, position;
- int y;
+ COLORREF foreground;
if (s->prev
- && s->prev->face->underline == FACE_UNDER_LINE
+ && (s->prev->face->underline != FACE_UNDERLINE_WAVE
+ && s->prev->face->underline >= FACE_UNDERLINE_SINGLE)
&& (s->prev->face->underline_at_descent_line_p
== s->face->underline_at_descent_line_p)
&& (s->prev->face->underline_pixels_above_descent_line
@@ -2734,18 +2818,26 @@ w32_draw_glyph_string (struct glyph_string *s)
if (s->y + s->height < s->ybase + position + thickness)
thickness = (s->y + s->height) - (s->ybase + position);
s->underline_thickness = thickness;
- s->underline_position = position;
- y = s->ybase + position;
+ s->underline_position = position;
+
if (s->face->underline_defaulted_p)
- {
- w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x,
- y, s->width, 1);
- }
- else
- {
- w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x,
- y, s->width, 1);
- }
+ foreground = s->gc->foreground;
+ else
+ foreground = s->face->underline_color;
+
+ w32_fill_underline (s->f, s, foreground, s->face->underline,
+ position, thickness);
+
+ /* Place a second underline above the first if this was
+ requested in the face specification. */
+
+ if (s->face->underline == FACE_UNDERLINE_DOUBLE_LINE)
+ {
+ /* Compute the position of the second underline. */
+ position = position - thickness - 1;
+ w32_fill_underline (s->f, s, foreground, s->face->underline,
+ position, thickness);
+ }
}
}
/* Draw overline. */
@@ -6403,17 +6495,17 @@ w32_bitmap_icon (struct frame *f, Lisp_Object icon)
{
LPCTSTR name;
- if (EQ (icon, intern ("application")))
+ if (EQ (icon, Qapplication))
name = (LPCTSTR) IDI_APPLICATION;
- else if (EQ (icon, intern ("hand")))
+ else if (EQ (icon, Qhand))
name = (LPCTSTR) IDI_HAND;
- else if (EQ (icon, intern ("question")))
+ else if (EQ (icon, Qquestion))
name = (LPCTSTR) IDI_QUESTION;
- else if (EQ (icon, intern ("exclamation")))
+ else if (EQ (icon, Qexclamation))
name = (LPCTSTR) IDI_EXCLAMATION;
- else if (EQ (icon, intern ("asterisk")))
+ else if (EQ (icon, Qasterisk))
name = (LPCTSTR) IDI_ASTERISK;
- else if (EQ (icon, intern ("winlogo")))
+ else if (EQ (icon, Qwinlogo))
name = (LPCTSTR) IDI_WINLOGO;
else
return 1;
@@ -7823,6 +7915,10 @@ syms_of_w32term (void)
DEFSYM (Qrenamed_from, "renamed-from");
DEFSYM (Qrenamed_to, "renamed-to");
+ /* Bitmap icon constants. */
+ DEFSYM (Qapplication, "application");
+ DEFSYM (Qwinlogo, "winlogo");
+
DEFVAR_LISP ("x-wait-for-event-timeout", Vx_wait_for_event_timeout,
doc: /* SKIP: real doc in xterm.c. */);
Vx_wait_for_event_timeout = make_float (0.1);
diff --git a/src/window.c b/src/window.c
index 6c0fce4119f..ff28bac5306 100644
--- a/src/window.c
+++ b/src/window.c
@@ -3514,6 +3514,10 @@ window-start value is reasonable when this function is
called. */)
get called. */
w->optional_new_start = true;
+ /* Reset the vscroll, as redisplay will not. */
+ w->vscroll = 0;
+ w->preserve_vscroll_p = false;
+
set_buffer_internal (obuf);
}
}
@@ -4421,6 +4425,7 @@ make_window (void)
wset_old_pointm (w, Fmake_marker ());
wset_vertical_scroll_bar_type (w, Qt);
wset_horizontal_scroll_bar_type (w, Qt);
+ wset_cursor_type (w, Qt);
/* These Lisp fields are marked specially so they're not set to nil by
allocate_window. */
wset_prev_buffers (w, Qnil);
@@ -5751,6 +5756,11 @@ window_scroll_for_long_lines (struct window *w, int n,
bool noerror)
else if (n < 0)
pos = *vmotion (PT, PT_BYTE, - (ht / 2), w);
SET_PT_BOTH (pos.bufpos, pos.bytepos);
+
+ /* Since `vmotion' computes coordinates after vscroll is applied,
+ it is taken into account in POS, and vscroll must be reset by
+ `force_start' in `redisplay_internal'. */
+ w->preserve_vscroll_p = false;
}
else
{
@@ -6894,8 +6904,14 @@ and redisplay normally--don't erase and redraw the
frame. */)
/* Set the new window start. */
set_marker_both (w->start, w->contents, charpos, bytepos);
- w->window_end_valid = false;
+ /* The window start was calculated with an iterator already adjusted
+ by the existing vscroll, so w->start must not be combined with
+ retaining the existing vscroll, which redisplay will not reset if
+ w->preserve_vscroll_p is enabled. (bug#70386) */
+ w->vscroll = 0;
+ w->preserve_vscroll_p = false;
+ w->window_end_valid = false;
w->optional_new_start = true;
w->start_at_line_beg = (bytepos == BEGV_BYTE
@@ -6983,6 +6999,11 @@ from the top of the window. */)
set_marker_both (w->start, w->contents, PT, PT_BYTE);
w->start_at_line_beg = !NILP (Fbolp ());
w->force_start = true;
+
+ /* Since `Fvertical_motion' computes coordinates after vscroll is
+ applied, it is taken into account in POS, and vscroll must be
+ reset by `force_start' in `redisplay_internal'. */
+ w->preserve_vscroll_p = false;
}
else
Fgoto_char (w->start);
@@ -8030,6 +8051,52 @@ PERSISTENT), see `set-window-fringes'. */)
w->fringes_persistent ? Qt : Qnil);
}
+DEFUN ("set-window-cursor-type", Fset_window_cursor_type,
+ Sset_window_cursor_type, 2, 2, 0,
+ doc: /* Set the `cursor-type' of WINDOW to TYPE.
+
+This setting takes precedence over the variable `cursor-type', and TYPE
+has the same format as the value of that variable. The initial value
+for new windows is t, which says to respect the buffer-local value of
+`cursor-type'.
+
+WINDOW nil means use the selected window. This setting persists across
+buffers shown in WINDOW, so `set-window-buffer' does not reset it. */)
+ (Lisp_Object window, Lisp_Object type)
+{
+ struct window *w = decode_live_window (window);
+
+ if (!(NILP (type)
+ || EQ (type, Qt)
+ || EQ (type, Qbox)
+ || EQ (type, Qhollow)
+ || EQ (type, Qbar)
+ || EQ (type, Qhbar)
+ || (CONSP (type)
+ && (EQ (XCAR (type), Qbox)
+ || EQ (XCAR (type), Qbar)
+ || EQ (XCAR (type), Qhbar))
+ && INTEGERP (XCDR (type)))))
+ error ("Invalid cursor type");
+
+ wset_cursor_type (w, type);
+
+ /* Redisplay with updated cursor type. */
+ wset_redisplay (w);
+
+ return type;
+}
+
+/* FIXME: Add a way to get the _effective_ cursor type, possibly by
+ extending this function with an additional optional argument. */
+DEFUN ("window-cursor-type", Fwindow_cursor_type, Swindow_cursor_type,
+ 0, 1, 0,
+ doc: /* Return the `cursor-type' of WINDOW.
+WINDOW must be a live window and defaults to the selected one. */)
+ (Lisp_Object window)
+{
+ return decode_live_window (window)->cursor_type;
+}
/***********************************************************************
@@ -8171,9 +8238,18 @@ DEFUN ("window-scroll-bars", Fwindow_scroll_bars,
Swindow_scroll_bars,
WINDOW must be a live window and defaults to the selected one.
Value is a list of the form (WIDTH COLUMNS VERTICAL-TYPE HEIGHT LINES
-HORIZONTAL-TYPE PERSISTENT), see `set-window-scroll-bars'. If WIDTH
-or HEIGHT is nil or VERTICAL-TYPE or HORIZONTAL-TYPE is t, WINDOW is
-using the frame's corresponding value. */)
+HORIZONTAL-TYPE PERSISTENT). WIDTH reports the pixel width of the
+vertical scroll bar; COLUMNS is the equivalent number of columns.
+Similarly, HEIGHT and LINES are the height of the horizontal scroll
+bar in pixels and the equivalent number of lines. VERTICAL-TYPE
+reports the type of the vertical scroll bar, either left, right, nil,
+or t. HORIZONTAL-TYPE reports the type of the horizontal scroll bar,
+either bottom, nil or t. PERSISTENT reports the value specified by
+the last successful call to `set-window-scroll-bars', or nil if there
+was none.
+
+If WIDTH or HEIGHT is nil or VERTICAL-TYPE or HORIZONTAL-TYPE is t,
+WINDOW is using the corresponding value specified for the frame. */)
(Lisp_Object window)
{
struct window *w = decode_live_window (window);
@@ -8956,4 +9032,6 @@ displayed after a scrolling operation to be somewhat
inaccurate. */);
defsubr (&Swindow_parameters);
defsubr (&Swindow_parameter);
defsubr (&Sset_window_parameter);
+ defsubr (&Swindow_cursor_type);
+ defsubr (&Sset_window_cursor_type);
}
diff --git a/src/window.h b/src/window.h
index 19283725931..86932181252 100644
--- a/src/window.h
+++ b/src/window.h
@@ -205,6 +205,9 @@ struct window
/* An alist with parameters. */
Lisp_Object window_parameters;
+ /* `cursor-type' to use in this window. */
+ Lisp_Object cursor_type;
+
/* The help echo text for this window. Qnil if there's none. */
Lisp_Object mode_line_help_echo;
@@ -542,6 +545,12 @@ wset_horizontal_scroll_bar_type (struct window *w,
Lisp_Object val)
w->horizontal_scroll_bar_type = val;
}
+INLINE void
+wset_cursor_type (struct window *w, Lisp_Object val)
+{
+ w->cursor_type = val;
+}
+
INLINE void
wset_prev_buffers (struct window *w, Lisp_Object val)
{
diff --git a/src/xdisp.c b/src/xdisp.c
index c722afe069f..3760e57d63b 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -3881,7 +3881,7 @@ init_from_display_pos (struct it *it, struct window *w,
struct display_pos *pos)
if (in_ellipses_for_invisible_text_p (pos, w))
{
--charpos;
- bytepos = 0;
+ bytepos = BYTE_TO_CHAR (charpos);
}
/* Keep in mind: the call to reseat in init_iterator skips invisible
@@ -12056,8 +12056,8 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool
nlflag, bool multibyte)
bool newbuffer = NILP (Fget_buffer (Vmessages_buffer_name));
Fset_buffer (Fget_buffer_create (Vmessages_buffer_name, Qnil));
if (newbuffer
- && !NILP (Ffboundp (intern ("messages-buffer-mode"))))
- call0 (intern ("messages-buffer-mode"));
+ && !NILP (Ffboundp (Qmessages_buffer_mode)))
+ call0 (Qmessages_buffer_mode);
bset_undo_list (current_buffer, Qt);
bset_cache_long_scans (current_buffer, Qnil);
@@ -13198,8 +13198,6 @@ truncate_message_1 (void *a1, Lisp_Object a2)
return false;
}
-extern intptr_t garbage_collection_inhibited;
-
/* Set the current message to STRING. */
static void
@@ -17853,6 +17851,7 @@ mark_window_display_accurate_1 (struct window *w, bool
accurate_p)
if ((prev_point != w->last_point
|| prev_mark != w->last_mark)
&& FRAME_WINDOW_P (WINDOW_XFRAME (w))
+ && !FRAME_TOOLTIP_P (WINDOW_XFRAME (w))
&& w == XWINDOW (WINDOW_XFRAME (w)->selected_window))
report_point_change (WINDOW_XFRAME (w), w, b);
#endif /* HAVE_TEXT_CONVERSION */
@@ -18185,7 +18184,7 @@ set_cursor_from_row (struct window *w, struct glyph_row
*row,
--glyph;
/* By default, in reversed rows we put the cursor on the
rightmost (first in the reading order) glyph. */
- for (x = 0, g = end + 1; g < glyph; g++)
+ for (x = row->x, g = end + 1; g < glyph; g++)
x += g->pixel_width;
while (end < glyph
&& NILP ((end + 1)->object)
@@ -24418,6 +24417,7 @@ push_prefix_prop (struct it *it, Lisp_Object prop)
{
it->method = GET_FROM_STRETCH;
it->object = prop;
+ it->string_from_prefix_prop_p = true;
}
#ifdef HAVE_WINDOW_SYSTEM
else if (IMAGEP (prop))
@@ -24425,6 +24425,7 @@ push_prefix_prop (struct it *it, Lisp_Object prop)
it->what = IT_IMAGE;
it->image_id = lookup_image (it->f, prop, it->face_id);
it->method = GET_FROM_IMAGE;
+ it->string_from_prefix_prop_p = true;
}
#endif /* HAVE_WINDOW_SYSTEM */
else
@@ -28863,7 +28864,7 @@ decode_mode_spec (struct window *w, register int c, int
field_width,
Lisp_Object val = Qnil;
if (STRINGP (curdir))
- val = dsafe_call1 (intern ("file-remote-p"), curdir);
+ val = dsafe_call1 (Qfile_remote_p, curdir);
val = unbind_to (count, val);
@@ -33618,7 +33619,9 @@ get_window_cursor_type (struct window *w, struct glyph
*glyph, int *width,
{
if (w == XWINDOW (echo_area_window))
{
- if (EQ (BVAR (b, cursor_type), Qt) || NILP (BVAR (b, cursor_type)))
+ if (!EQ (Qt, w->cursor_type))
+ return get_specified_cursor_type (w->cursor_type, width);
+ else if (EQ (BVAR (b, cursor_type), Qt) || NILP (BVAR (b,
cursor_type)))
{
*width = FRAME_CURSOR_WIDTH (f);
return FRAME_DESIRED_CURSOR (f);
@@ -33645,18 +33648,23 @@ get_window_cursor_type (struct window *w, struct
glyph *glyph, int *width,
non_selected = true;
}
- /* Never display a cursor in a window in which cursor-type is nil. */
- if (NILP (BVAR (b, cursor_type)))
- return NO_CURSOR;
-
- /* Get the normal cursor type for this window. */
- if (EQ (BVAR (b, cursor_type), Qt))
+ if (!EQ (Qt, w->cursor_type))
+ cursor_type = get_specified_cursor_type (w->cursor_type, width);
+ else
{
- cursor_type = FRAME_DESIRED_CURSOR (f);
- *width = FRAME_CURSOR_WIDTH (f);
+ /* Never display a cursor in a window in which cursor-type is nil. */
+ if (NILP (BVAR (b, cursor_type)))
+ return NO_CURSOR;
+
+ /* Get the normal cursor type for this window. */
+ if (EQ (BVAR (b, cursor_type), Qt))
+ {
+ cursor_type = FRAME_DESIRED_CURSOR (f);
+ *width = FRAME_CURSOR_WIDTH (f);
+ }
+ else
+ cursor_type = get_specified_cursor_type (BVAR (b, cursor_type), width);
}
- else
- cursor_type = get_specified_cursor_type (BVAR (b, cursor_type), width);
/* Use cursor-in-non-selected-windows instead
for non-selected window or frame. */
@@ -35379,15 +35387,15 @@ define_frame_cursor1 (struct frame *f, Emacs_Cursor
cursor, Lisp_Object pointer)
cursor = FRAME_OUTPUT_DATA (f)->hand_cursor;
else if (EQ (pointer, Qtext))
cursor = FRAME_OUTPUT_DATA (f)->text_cursor;
- else if (EQ (pointer, intern ("hdrag")))
+ else if (EQ (pointer, Qhdrag))
cursor = FRAME_OUTPUT_DATA (f)->horizontal_drag_cursor;
- else if (EQ (pointer, intern ("nhdrag")))
+ else if (EQ (pointer, Qnhdrag))
cursor = FRAME_OUTPUT_DATA (f)->vertical_drag_cursor;
# ifdef HAVE_X_WINDOWS
- else if (EQ (pointer, intern ("vdrag")))
+ else if (EQ (pointer, Qvdrag))
cursor = FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor;
# endif
- else if (EQ (pointer, intern ("hourglass")))
+ else if (EQ (pointer, Qhourglass))
cursor = FRAME_OUTPUT_DATA (f)->hourglass_cursor;
else if (EQ (pointer, Qmodeline))
cursor = FRAME_OUTPUT_DATA (f)->modeline_cursor;
@@ -35735,6 +35743,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window,
int x, int y,
define_frame_cursor1 (f, cursor, pointer);
}
+#ifdef HAVE_WINDOW_SYSTEM
/* Take proper action when mouse has moved to the window WINDOW, with
window-local x-position X and y-position Y. This is only used for
@@ -35813,6 +35822,8 @@ note_fringe_highlight (struct frame *f, Lisp_Object
window, int x, int y,
}
}
+#endif /* HAVE_WINDOW_SYSTEM */
+
/* EXPORT:
Take proper action when the mouse has moved to position X, Y on
frame F with regards to highlighting portions of display that have
@@ -38288,6 +38299,16 @@ The default value is zero, which disables this feature.
The recommended non-zero value is between 100000 and 1000000,
depending on your patience and the speed of your system. */);
max_redisplay_ticks = 0;
+
+ /* Called by decode_mode_spec. */
+ DEFSYM (Qfile_remote_p, "file-remote-p");
+
+ /* Called or compared against by various functions. */
+ DEFSYM (Qmessages_buffer_mode, "messages-buffer-mode");
+ DEFSYM (Qhdrag, "hdrag");
+ DEFSYM (Qnhdrag, "nhdrag");
+ DEFSYM (Qvdrag, "vdrag");
+ DEFSYM (Qhourglass, "hourglass");
}
diff --git a/src/xfaces.c b/src/xfaces.c
index 835a9b3f5cb..92d273f3920 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -500,7 +500,7 @@ void
x_free_dpy_colors (Display *dpy, Screen *screen, Colormap cmap,
unsigned long *pixels, int npixels)
{
- struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
+ struct x_display_info *dpyinfo = x_dpyinfo (dpy);
/* If display has an immutable color map, freeing colors is not
necessary and some servers don't allow it. So don't do it. */
@@ -615,21 +615,7 @@ static struct android_gc *
x_create_gc (struct frame *f, unsigned long value_mask,
Emacs_GC *xgcv)
{
- struct android_gc_values gcv;
- unsigned long mask;
-
- gcv.foreground = xgcv->foreground;
- gcv.background = xgcv->background;
-
- mask = 0;
-
- if (value_mask & GCForeground)
- mask |= ANDROID_GC_FOREGROUND;
-
- if (value_mask & GCBackground)
- mask |= ANDROID_GC_BACKGROUND;
-
- return android_create_gc (mask, &gcv);
+ return android_create_gc (value_mask, xgcv);
}
static void
@@ -1094,7 +1080,7 @@ tty_lookup_color (struct frame *f, Lisp_Object color,
Emacs_Color *tty_color,
return true;
}
- else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
+ else if (NILP (Fsymbol_value (Qtty_defined_color_alist)))
/* We were called early during startup, and the colors are not
yet set up in tty-defined-color-alist. Don't return a failure
indication, since this produces the annoying "Unable to
@@ -3307,7 +3293,11 @@ FRAME 0 means change the face on all frames, and change
the default
}
else if (EQ (key, QCstyle)
- && !(EQ (val, Qline) || EQ (val, Qwave)))
+ && !(EQ (val, Qline)
+ || EQ (val, Qdouble_line)
+ || EQ (val, Qwave)
+ || EQ (val, Qdots)
+ || EQ (val, Qdashes)))
{
valid_p = false;
break;
@@ -4637,14 +4627,18 @@ prepare_face_for_display (struct frame *f, struct face
*face)
#endif
block_input ();
-#ifdef HAVE_X_WINDOWS
+#if defined HAVE_X_WINDOWS || defined HAVE_ANDROID
if (face->stipple)
{
egc.fill_style = FillOpaqueStippled;
+#ifndef ANDROID_STUBIFY
egc.stipple = image_bitmap_pixmap (f, face->stipple);
+#else /* !ANDROID_STUBIFY */
+ emacs_abort ();
+#endif /* !ANDROID_STUBIFY */
mask |= GCFillStyle | GCStipple;
}
-#endif
+#endif /* HAVE_X_WINDOWS || HAVE_ANDROID */
face->gc = x_create_gc (f, mask, &egc);
if (face->font)
font_prepare_for_face (f, face);
@@ -5307,6 +5301,7 @@ gui_supports_face_attributes_p (struct frame *f,
Lisp_Object attrs[LFACE_VECTOR_SIZE],
struct face *def_face)
{
+ Lisp_Object val;
Lisp_Object *def_attrs = def_face->lface;
Lisp_Object lattrs[LFACE_VECTOR_SIZE];
@@ -5401,6 +5396,14 @@ gui_supports_face_attributes_p (struct frame *f,
return false;
}
+ /* Check supported underline styles. */
+ val = attrs[LFACE_UNDERLINE_INDEX];
+ if (!UNSPECIFIEDP (val)
+ && EQ (CAR_SAFE (val), QCstyle)
+ && !(EQ (CAR_SAFE (CDR_SAFE (val)), Qline)
+ || EQ (CAR_SAFE (CDR_SAFE (val)), Qwave)))
+ return false; /* Unsupported underline style. */
+
/* Everything checks out, this face is supported. */
return true;
}
@@ -5494,9 +5497,18 @@ tty_supports_face_attributes_p (struct frame *f,
if (!UNSPECIFIEDP (val))
{
if (STRINGP (val))
- return false; /* ttys can't use colored underlines */
- else if (EQ (CAR_SAFE (val), QCstyle) && EQ (CAR_SAFE (CDR_SAFE (val)),
Qwave))
- return false; /* ttys can't use wave underlines */
+ test_caps |= TTY_CAP_UNDERLINE_STYLED;
+ else if (EQ (CAR_SAFE (val), QCstyle))
+ {
+ if (!(EQ (CAR_SAFE (CDR_SAFE (val)), Qline)
+ || EQ (CAR_SAFE (CDR_SAFE (val)), Qdouble_line)
+ || EQ (CAR_SAFE (CDR_SAFE (val)), Qwave)
+ || EQ (CAR_SAFE (CDR_SAFE (val)), Qdots)
+ || EQ (CAR_SAFE (CDR_SAFE (val)), Qdashes)))
+ return false; /* Face uses an unsupported underline style. */
+
+ test_caps |= TTY_CAP_UNDERLINE_STYLED;
+ }
else if (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX]))
return false; /* same as default */
else
@@ -6357,7 +6369,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object
attrs[LFACE_VECTOR_SIZE]
if (EQ (underline, Qt))
{
/* Use default color (same as foreground color). */
- face->underline = FACE_UNDER_LINE;
+ face->underline = FACE_UNDERLINE_SINGLE;
face->underline_defaulted_p = true;
face->underline_color = 0;
face->underline_at_descent_line_p = false;
@@ -6366,7 +6378,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object
attrs[LFACE_VECTOR_SIZE]
else if (STRINGP (underline))
{
/* Use specified color. */
- face->underline = FACE_UNDER_LINE;
+ face->underline = FACE_UNDERLINE_SINGLE;
face->underline_defaulted_p = false;
face->underline_color
= load_color (f, face, underline,
@@ -6386,7 +6398,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object
attrs[LFACE_VECTOR_SIZE]
{
/* `(:color COLOR :style STYLE)'.
STYLE being one of `line' or `wave'. */
- face->underline = FACE_UNDER_LINE;
+ face->underline = FACE_UNDERLINE_SINGLE;
face->underline_color = 0;
face->underline_defaulted_p = true;
face->underline_at_descent_line_p = false;
@@ -6422,11 +6434,19 @@ realize_gui_face (struct face_cache *cache, Lisp_Object
attrs[LFACE_VECTOR_SIZE]
}
else if (EQ (keyword, QCstyle))
{
- if (EQ (value, Qline))
- face->underline = FACE_UNDER_LINE;
- else if (EQ (value, Qwave))
- face->underline = FACE_UNDER_WAVE;
- }
+ if (EQ (value, Qline))
+ face->underline = FACE_UNDERLINE_SINGLE;
+ else if (EQ (value, Qdouble_line))
+ face->underline = FACE_UNDERLINE_DOUBLE_LINE;
+ else if (EQ (value, Qwave))
+ face->underline = FACE_UNDERLINE_WAVE;
+ else if (EQ (value, Qdots))
+ face->underline = FACE_UNDERLINE_DOTS;
+ else if (EQ (value, Qdashes))
+ face->underline = FACE_UNDERLINE_DASHES;
+ else
+ face->underline = FACE_UNDERLINE_SINGLE;
+ }
else if (EQ (keyword, QCposition))
{
face->underline_at_descent_line_p = !NILP (value);
@@ -6476,17 +6496,18 @@ realize_gui_face (struct face_cache *cache, Lisp_Object
attrs[LFACE_VECTOR_SIZE]
}
-/* Map a specified color of face FACE on frame F to a tty color index.
- IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
- specifies which color to map. Set *DEFAULTED to true if mapping to the
+/* Map the specified color COLOR of face FACE on frame F to a tty
+ color index. IDX is one of LFACE_FOREGROUND_INDEX,
+ LFACE_BACKGROUND_INDEX or LFACE_UNDERLINE_INDEX, and specifies
+ which color to map. Set *DEFAULTED to true if mapping to the
default foreground/background colors. */
static void
-map_tty_color (struct frame *f, struct face *face,
- enum lface_attribute_index idx, bool *defaulted)
+map_tty_color (struct frame *f, struct face *face, Lisp_Object color,
+ enum lface_attribute_index idx, bool *defaulted)
{
- Lisp_Object frame, color, def;
- bool foreground_p = idx == LFACE_FOREGROUND_INDEX;
+ Lisp_Object frame, def;
+ bool foreground_p = idx != LFACE_BACKGROUND_INDEX;
unsigned long default_pixel =
foreground_p ? FACE_TTY_DEFAULT_FG_COLOR : FACE_TTY_DEFAULT_BG_COLOR;
unsigned long pixel = default_pixel;
@@ -6495,10 +6516,11 @@ map_tty_color (struct frame *f, struct face *face,
foreground_p ? FACE_TTY_DEFAULT_BG_COLOR : FACE_TTY_DEFAULT_FG_COLOR;
#endif
- eassert (idx == LFACE_FOREGROUND_INDEX || idx == LFACE_BACKGROUND_INDEX);
+ eassert (idx == LFACE_FOREGROUND_INDEX
+ || idx == LFACE_BACKGROUND_INDEX
+ || idx == LFACE_UNDERLINE_INDEX);
XSETFRAME (frame, f);
- color = face->lface[idx];
if (STRINGP (color)
&& SCHARS (color)
@@ -6543,13 +6565,21 @@ map_tty_color (struct frame *f, struct face *face,
#endif /* MSDOS */
}
- if (foreground_p)
- face->foreground = pixel;
- else
- face->background = pixel;
+ switch (idx)
+ {
+ case LFACE_FOREGROUND_INDEX:
+ face->foreground = pixel;
+ break;
+ case LFACE_UNDERLINE_INDEX:
+ face->underline_color = pixel;
+ break;
+ case LFACE_BACKGROUND_INDEX:
+ default:
+ face->background = pixel;
+ break;
+ }
}
-
/* Realize the fully-specified face with attributes ATTRS in face
cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
Value is a pointer to the newly created realized face. */
@@ -6560,6 +6590,7 @@ realize_tty_face (struct face_cache *cache,
{
struct face *face;
int weight, slant;
+ Lisp_Object underline;
bool face_colors_defaulted = false;
struct frame *f = cache->f;
@@ -6579,16 +6610,83 @@ realize_tty_face (struct face_cache *cache,
face->tty_bold_p = true;
if (slant != 100)
face->tty_italic_p = true;
- if (!NILP (attrs[LFACE_UNDERLINE_INDEX]))
- face->tty_underline_p = true;
if (!NILP (attrs[LFACE_INVERSE_INDEX]))
face->tty_reverse_p = true;
if (!NILP (attrs[LFACE_STRIKE_THROUGH_INDEX]))
face->tty_strike_through_p = true;
+ /* Text underline. */
+ underline = attrs[LFACE_UNDERLINE_INDEX];
+ if (NILP (underline))
+ {
+ face->underline = FACE_NO_UNDERLINE;
+ face->underline_color = 0;
+ }
+ else if (EQ (underline, Qt))
+ {
+ face->underline = FACE_UNDERLINE_SINGLE;
+ face->underline_color = 0;
+ }
+ else if (STRINGP (underline))
+ {
+ face->underline = FACE_UNDERLINE_SINGLE;
+ bool underline_color_defaulted;
+ map_tty_color (f, face, underline, LFACE_UNDERLINE_INDEX,
+ &underline_color_defaulted);
+ }
+ else if (CONSP (underline))
+ {
+ /* `(:color COLOR :style STYLE)'.
+ STYLE being one of `line', `double-line', `wave', `dots' or `dashes'.
*/
+ face->underline = FACE_UNDERLINE_SINGLE;
+ face->underline_color = 0;
+
+ while (CONSP (underline))
+ {
+ Lisp_Object keyword, value;
+
+ keyword = XCAR (underline);
+ underline = XCDR (underline);
+
+ if (!CONSP (underline))
+ break;
+ value = XCAR (underline);
+ underline = XCDR (underline);
+
+ if (EQ (keyword, QCcolor))
+ {
+ if (EQ (value, Qforeground_color))
+ face->underline_color = 0;
+ else if (STRINGP (value))
+ {
+ bool underline_color_defaulted;
+ map_tty_color (f, face, value, LFACE_UNDERLINE_INDEX,
+ &underline_color_defaulted);
+ }
+ }
+ else if (EQ (keyword, QCstyle))
+ {
+ if (EQ (value, Qline))
+ face->underline = FACE_UNDERLINE_SINGLE;
+ else if (EQ (value, Qdouble_line))
+ face->underline = FACE_UNDERLINE_DOUBLE_LINE;
+ else if (EQ (value, Qwave))
+ face->underline = FACE_UNDERLINE_WAVE;
+ else if (EQ (value, Qdots))
+ face->underline = FACE_UNDERLINE_DOTS;
+ else if (EQ (value, Qdashes))
+ face->underline = FACE_UNDERLINE_DASHES;
+ else
+ face->underline = FACE_UNDERLINE_SINGLE;
+ }
+ }
+ }
+
/* Map color names to color indices. */
- map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted);
- map_tty_color (f, face, LFACE_BACKGROUND_INDEX, &face_colors_defaulted);
+ map_tty_color (f, face, face->lface[LFACE_FOREGROUND_INDEX],
+ LFACE_FOREGROUND_INDEX, &face_colors_defaulted);
+ map_tty_color (f, face, face->lface[LFACE_BACKGROUND_INDEX],
+ LFACE_BACKGROUND_INDEX, &face_colors_defaulted);
/* Swap colors if face is inverse-video. If the colors are taken
from the frame colors, they are already inverted, since the
@@ -7274,6 +7372,9 @@ syms_of_xfaces (void)
DEFSYM (QCposition, ":position");
DEFSYM (Qline, "line");
DEFSYM (Qwave, "wave");
+ DEFSYM (Qdouble_line, "double-line");
+ DEFSYM (Qdots, "dots");
+ DEFSYM (Qdashes, "dashes");
DEFSYM (Qreleased_button, "released-button");
DEFSYM (Qpressed_button, "pressed-button");
DEFSYM (Qflat_button, "flat-button");
@@ -7343,6 +7444,7 @@ syms_of_xfaces (void)
/* The name of the function used to compute colors on TTYs. */
DEFSYM (Qtty_color_alist, "tty-color-alist");
+ DEFSYM (Qtty_defined_color_alist, "tty-defined-color-alist");
Vface_alternative_font_family_alist = Qnil;
staticpro (&Vface_alternative_font_family_alist);
diff --git a/src/xfns.c b/src/xfns.c
index d610c839bfc..c48fa24b6be 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -3917,11 +3917,12 @@ xic_string_conversion_callback (XIC ic, XPointer
client_data,
return;
failure:
- /* Return a string of length 0 using the C library malloc. This
+ /* Return a string of length 0 using the C library malloc (1)
+ (not malloc (0), to pacify gcc -Walloc-size). This
assumes XFree is able to free data allocated with our malloc
wrapper. */
call_data->text->length = 0;
- call_data->text->string.mbs = malloc (0);
+ call_data->text->string.mbs = malloc (1);
}
#endif /* HAVE_X_I18N */
@@ -6546,10 +6547,7 @@ void
xlw_monitor_dimensions_at_pos (Display *dpy, Screen *screen, int src_x,
int src_y, int *x, int *y, int *width, int
*height)
{
- struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
-
- if (!dpyinfo)
- emacs_abort ();
+ struct x_display_info *dpyinfo = x_dpyinfo (dpy);
block_input ();
xlw_monitor_dimensions_at_pos_1 (dpyinfo, screen, src_x, src_y,
@@ -10213,10 +10211,7 @@ XkbFreeNames (XkbDescPtr xkb, unsigned int which, Bool
free_map)
int
XDisplayCells (Display *dpy, int screen_number)
{
- struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
-
- if (!dpyinfo)
- emacs_abort ();
+ struct x_display_info *dpyinfo = x_dpyinfo (dpy);
/* Not strictly correct, since the display could be using a
non-default visual, but it satisfies the callers we need to care
diff --git a/src/xmenu.c b/src/xmenu.c
index ef1eeb5925f..8682e67dad4 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -236,7 +236,7 @@ x_menu_translate_generic_event (XEvent *event)
XEvent copy;
XIDeviceEvent *xev;
- dpyinfo = x_display_info_for_display (event->xgeneric.display);
+ dpyinfo = x_dpyinfo (event->xgeneric.display);
if (event->xgeneric.extension == dpyinfo->xi2_opcode)
{
diff --git a/src/xml.c b/src/xml.c
index 85f16746289..dc707bea864 100644
--- a/src/xml.c
+++ b/src/xml.c
@@ -165,7 +165,7 @@ make_dom (xmlNode *node)
else if (node->type == XML_COMMENT_NODE)
{
if (node->content)
- return list3 (intern ("comment"), Qnil,
+ return list3 (Qcomment, Qnil,
build_string ((char *) node->content));
else
return Qnil;
@@ -353,4 +353,6 @@ syms_of_xml (void)
defsubr (&Slibxml_parse_xml_region);
#endif
defsubr (&Slibxml_available_p);
+
+ DEFSYM (Qcomment, "comment");
}
diff --git a/src/xselect.c b/src/xselect.c
index b93c2423f0e..b733f2660cc 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -562,12 +562,12 @@ struct x_selection_request
/* Stack of selections currently being processed.
NULL if all requests have been fully processed. */
-struct x_selection_request *selection_request_stack;
+static struct x_selection_request *selection_request_stack;
/* List of all outstanding selection transfers which are currently
being processed. */
-struct transfer outstanding_transfers;
+static struct transfer outstanding_transfers;
/* A counter for selection serials. */
diff --git a/src/xterm.c b/src/xterm.c
index 7acd7f9c2a5..4261d1f2103 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -974,7 +974,7 @@ struct x_selection_request_event
selection requests inside long-lasting modal event loops, such as
the drag-and-drop loop. */
-struct x_selection_request_event *pending_selection_requests;
+static struct x_selection_request_event *pending_selection_requests;
struct x_atom_ref
{
@@ -1277,7 +1277,7 @@ static int x_dnd_waiting_for_motif_finish;
/* The display the Motif drag receiver will send response data
from. */
-struct x_display_info *x_dnd_waiting_for_motif_finish_display;
+static struct x_display_info *x_dnd_waiting_for_motif_finish_display;
/* Whether or not F1 was pressed during the drag-and-drop operation.
@@ -2936,7 +2936,6 @@ x_dnd_free_toplevels (bool display_alive)
unsigned long *prev_masks UNINIT;
specpdl_ref count;
Display *dpy UNINIT;
- struct x_display_info *dpyinfo;
if (!x_dnd_toplevels)
/* Probably called inside an IO error handler. */
@@ -2998,25 +2997,21 @@ x_dnd_free_toplevels (bool display_alive)
record_unwind_protect_ptr (xfree, destroy_windows);
record_unwind_protect_ptr (xfree, prev_masks);
- if (display_alive)
+ if (display_alive && n_windows)
{
- dpyinfo = x_display_info_for_display (dpy);
+ struct x_display_info *dpyinfo = x_dpyinfo (dpy);
- if (n_windows)
- {
- eassume (dpyinfo);
- x_ignore_errors_for_next_request (dpyinfo, 0);
+ x_ignore_errors_for_next_request (dpyinfo, 0);
- for (i = 0; i < n_windows; ++i)
- {
- XSelectInput (dpy, destroy_windows[i], prev_masks[i]);
+ for (i = 0; i < n_windows; ++i)
+ {
+ XSelectInput (dpy, destroy_windows[i], prev_masks[i]);
#ifdef HAVE_XSHAPE
- XShapeSelectInput (dpy, destroy_windows[i], None);
+ XShapeSelectInput (dpy, destroy_windows[i], None);
#endif
- }
-
- x_stop_ignoring_errors (dpyinfo);
}
+
+ x_stop_ignoring_errors (dpyinfo);
}
unbind_to (count, Qnil);
@@ -6889,7 +6884,20 @@ x_draw_horizontal_wave (struct frame *f, GC gc, int x,
int y,
#endif
-/* Return the struct x_display_info corresponding to DPY. */
+/* Return the struct x_display_info corresponding to DPY,
+ when it is guaranteed that one will correspond. */
+
+struct x_display_info *
+x_dpyinfo (Display *dpy)
+{
+ for (struct x_display_info *dpyinfo = x_display_list; ;
+ dpyinfo = dpyinfo->next)
+ if (dpyinfo->display == dpy)
+ return dpyinfo;
+}
+
+/* Return the struct x_display_info corresponding to DPY,
+ or a null pointer if none corresponds. */
struct x_display_info *
x_display_info_for_display (Display *dpy)
@@ -8903,7 +8911,7 @@ x_frame_of_widget (Widget widget)
Lisp_Object tail, frame;
struct frame *f;
- dpyinfo = x_display_info_for_display (XtDisplay (widget));
+ dpyinfo = x_dpyinfo (XtDisplay (widget));
/* Find the top-level shell of the widget. Note that this function
can be called when the widget is not yet realized, so XtWindow
@@ -9097,8 +9105,7 @@ cvt_pixel_dtor (XtAppContext app, XrmValuePtr to,
XtPointer closure, XrmValuePtr
static const XColor *
x_color_cells (Display *dpy, int *ncells)
{
- struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
- eassume (dpyinfo);
+ struct x_display_info *dpyinfo = x_dpyinfo (dpy);
if (dpyinfo->color_cells == NULL)
{
@@ -9373,16 +9380,13 @@ x_parse_color (struct frame *f, const char *color_name,
static bool
x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color)
{
- struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
- bool rc;
-
- eassume (dpyinfo);
- rc = XAllocColor (dpy, cmap, color) != 0;
+ struct x_display_info *dpyinfo = x_dpyinfo (dpy);
+ bool rc = XAllocColor (dpy, cmap, color) != 0;
if (dpyinfo->visual_info.class == DirectColor)
return rc;
- if (rc == 0)
+ if (!rc)
{
/* If we got to this point, the colormap is full, so we're going
to try and get the next closest color. The algorithm used is
@@ -9485,8 +9489,7 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap,
XColor *color)
/* If allocation succeeded, and the allocated pixel color is not
equal to a cached pixel color recorded earlier, there was a
change in the colormap, so clear the color cache. */
- struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
- eassume (dpyinfo);
+ struct x_display_info *dpyinfo = x_dpyinfo (dpy);
if (dpyinfo->color_cells)
{
@@ -10743,10 +10746,10 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
}
static void
-x_get_scale_factor (Display *disp, int *scale_x, int *scale_y)
+x_get_scale_factor (struct x_display_info *dpyinfo,
+ int *scale_x, int *scale_y)
{
- const int base_res = 96;
- struct x_display_info * dpyinfo = x_display_info_for_display (disp);
+ int base_res = 96;
*scale_x = *scale_y = 1;
@@ -10772,12 +10775,12 @@ x_get_scale_factor (Display *disp, int *scale_x, int
*scale_y)
static void
x_draw_underwave (struct glyph_string *s, int decoration_width)
{
- Display *display = FRAME_X_DISPLAY (s->f);
-
+ struct x_display_info *dpyinfo;
/* Adjust for scale/HiDPI. */
int scale_x, scale_y;
- x_get_scale_factor (display, &scale_x, &scale_y);
+ dpyinfo = FRAME_DISPLAY_INFO (s->f);
+ x_get_scale_factor (dpyinfo, &scale_x, &scale_y);
int wave_height = 3 * scale_y, wave_length = 2 * scale_x;
@@ -10785,6 +10788,7 @@ x_draw_underwave (struct glyph_string *s, int
decoration_width)
x_draw_horizontal_wave (s->f, s->gc, s->x, s->ybase - wave_height + 3,
decoration_width, wave_height, wave_length);
#else /* not USE_CAIRO */
+ Display *display;
int dx, dy, x0, y0, width, x1, y1, x2, y2, xmax, thickness = scale_y;;
bool odd;
XRectangle wave_clip, string_clip, final_clip;
@@ -10807,6 +10811,7 @@ x_draw_underwave (struct glyph_string *s, int
decoration_width)
if (!gui_intersect_rectangles (&wave_clip, &string_clip, &final_clip))
return;
+ display = dpyinfo->display;
XSetClipRectangles (display, s->gc, 0, 0, &final_clip, 1, Unsorted);
/* Draw the waves */
@@ -10839,6 +10844,97 @@ x_draw_underwave (struct glyph_string *s, int
decoration_width)
#endif /* not USE_CAIRO */
}
+/* Draw a dashed underline of thickness THICKNESS and width WIDTH onto F
+ at a vertical offset of OFFSET from the position of the glyph string
+ S, with each segment SEGMENT pixels in length. */
+
+static void
+x_draw_dash (struct frame *f, struct glyph_string *s, int width,
+ char segment, int offset, int thickness)
+{
+#ifndef USE_CAIRO
+ GC gc;
+ Display *display;
+ XGCValues gcv;
+ int y_center;
+
+ /* Configure the GC, the dash pattern and a suitable offset. */
+ gc = s->gc;
+ display = FRAME_X_DISPLAY (f);
+
+ gcv.line_style = LineOnOffDash;
+ gcv.line_width = thickness;
+ XChangeGC (display, s->gc, GCLineStyle | GCLineWidth, &gcv);
+ XSetDashes (display, s->gc, s->x, &segment, 1);
+
+ /* Offset the origin of the line by half the line width. */
+ y_center = s->ybase + offset + thickness / 2;
+ XDrawLine (display, FRAME_X_DRAWABLE (f), gc,
+ s->x, y_center, s->x + width, y_center);
+
+ /* Restore the initial line style. */
+ gcv.line_style = LineSolid;
+ gcv.line_width = 1;
+ XChangeGC (display, s->gc, GCLineStyle | GCLineWidth, &gcv);
+#else /* USE_CAIRO */
+ cairo_t *cr;
+ double cr_segment, y_center;
+
+ cr = x_begin_cr_clip (f, s->gc);
+ cr_segment = (double) segment;
+ y_center = s->ybase + offset + (thickness / 2.0);
+
+ x_set_cr_source_with_gc_foreground (f, s->gc, false);
+ cairo_set_dash (cr, &cr_segment, 1, s->x);
+ cairo_set_line_width (cr, thickness);
+ cairo_move_to (cr, s->x, y_center);
+ cairo_line_to (cr, s->x + width, y_center);
+ cairo_stroke (cr);
+ x_end_cr_clip (f);
+#endif /* USE_CAIRO */
+}
+
+/* Draw an underline of STYLE onto F at an offset of POSITION from the
+ baseline of the glyph string S, DECORATION_WIDTH in length, and
+ THICKNESS in height. */
+
+static void
+x_fill_underline (struct frame *f, struct glyph_string *s,
+ enum face_underline_type style, int position,
+ int decoration_width, int thickness)
+{
+ int segment;
+ char x_segment;
+
+ segment = thickness * 3;
+
+ switch (style)
+ {
+ /* FACE_UNDERLINE_DOUBLE_LINE is treated identically to SINGLE, as
+ the second line will be filled by another invocation of this
+ function. */
+ case FACE_UNDERLINE_SINGLE:
+ case FACE_UNDERLINE_DOUBLE_LINE:
+ x_fill_rectangle (f, s->gc, s->x, s->ybase + position,
+ decoration_width, thickness, false);
+ break;
+
+ case FACE_UNDERLINE_DOTS:
+ segment = thickness;
+ FALLTHROUGH;
+
+ case FACE_UNDERLINE_DASHES:
+ x_segment = min (segment, CHAR_MAX);
+ x_draw_dash (f, s, decoration_width, x_segment, position,
+ thickness);
+ break;
+
+ case FACE_NO_UNDERLINE:
+ case FACE_UNDERLINE_WAVE:
+ default:
+ emacs_abort ();
+ }
+}
/* Draw glyph string S. */
@@ -10965,7 +11061,7 @@ x_draw_glyph_string (struct glyph_string *s)
/* Draw underline. */
if (s->face->underline)
{
- if (s->face->underline == FACE_UNDER_WAVE)
+ if (s->face->underline == FACE_UNDERLINE_WAVE)
{
if (s->face->underline_defaulted_p)
x_draw_underwave (s, decoration_width);
@@ -10979,13 +11075,13 @@ x_draw_glyph_string (struct glyph_string *s)
XSetForeground (display, s->gc, xgcv.foreground);
}
}
- else if (s->face->underline == FACE_UNDER_LINE)
+ else if (s->face->underline >= FACE_UNDERLINE_SINGLE)
{
unsigned long thickness, position;
- int y;
if (s->prev
- && s->prev->face->underline == FACE_UNDER_LINE
+ && (s->prev->face->underline != FACE_UNDERLINE_WAVE
+ && s->prev->face->underline >= FACE_UNDERLINE_SINGLE)
&& (s->prev->face->underline_at_descent_line_p
== s->face->underline_at_descent_line_p)
&& (s->prev->face->underline_pixels_above_descent_line
@@ -11062,22 +11158,36 @@ x_draw_glyph_string (struct glyph_string *s)
thickness = (s->y + s->height) - (s->ybase + position);
s->underline_thickness = thickness;
s->underline_position = position;
- y = s->ybase + position;
- if (s->face->underline_defaulted_p)
- x_fill_rectangle (s->f, s->gc,
- s->x, y, decoration_width, thickness,
- false);
- else
- {
- Display *display = FRAME_X_DISPLAY (s->f);
- XGCValues xgcv;
- XGetGCValues (display, s->gc, GCForeground, &xgcv);
- XSetForeground (display, s->gc, s->face->underline_color);
- x_fill_rectangle (s->f, s->gc,
- s->x, y, decoration_width, thickness,
- false);
- XSetForeground (display, s->gc, xgcv.foreground);
- }
+
+ {
+ Display *display = FRAME_X_DISPLAY (s->f);
+ XGCValues xgcv;
+
+ if (!s->face->underline_defaulted_p)
+ {
+ XGetGCValues (display, s->gc, GCForeground, &xgcv);
+ XSetForeground (display, s->gc, s->face->underline_color);
+ }
+
+ x_fill_underline (s->f, s, s->face->underline,
+ position, decoration_width,
+ thickness);
+
+ /* Place a second underline above the first if this was
+ requested in the face specification. */
+
+ if (s->face->underline == FACE_UNDERLINE_DOUBLE_LINE)
+ {
+ /* Compute the position of the second underline. */
+ position = position - thickness - 1;
+ x_fill_underline (s->f, s, s->face->underline,
+ position, decoration_width,
+ thickness);
+ }
+
+ if (!s->face->underline_defaulted_p)
+ XSetForeground (display, s->gc, xgcv.foreground);
+ }
}
}
/* Draw overline. */
@@ -11448,19 +11558,9 @@ XTflash (struct frame *f)
int fd, rc;
block_input ();
-
- if (FRAME_X_VISUAL_INFO (f)->class == TrueColor)
- {
- values.function = GXxor;
- values.foreground = (FRAME_FOREGROUND_PIXEL (f)
- ^ FRAME_BACKGROUND_PIXEL (f));
-
- gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- GCFunction | GCForeground, &values);
- }
- else
- gc = FRAME_X_OUTPUT (f)->normal_gc;
-
+ values.function = GXinvert;
+ gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ GCFunction, &values);
/* Get the height not including a menu bar widget. */
int height = FRAME_PIXEL_HEIGHT (f);
@@ -11547,8 +11647,7 @@ XTflash (struct frame *f)
flash_left, FRAME_INTERNAL_BORDER_WIDTH (f),
width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f));
- if (FRAME_X_VISUAL_INFO (f)->class == TrueColor)
- XFreeGC (FRAME_X_DISPLAY (f), gc);
+ XFreeGC (FRAME_X_DISPLAY (f), gc);
x_flush (f);
unblock_input ();
@@ -14513,12 +14612,7 @@ x_query_pointer (Display *dpy, Window w, Window
*root_return,
int *root_y_return, int *win_x_return,
int *win_y_return, unsigned int *mask_return)
{
- struct x_display_info *dpyinfo;
-
- dpyinfo = x_display_info_for_display (dpy);
-
- if (!dpyinfo)
- emacs_abort ();
+ struct x_display_info *dpyinfo = x_dpyinfo (dpy);
#ifdef HAVE_XINPUT2
return x_query_pointer_1 (dpyinfo, dpyinfo->client_pointer_device,
@@ -31866,8 +31960,6 @@ x_activate_timeout_atimer (void)
/* Set up use of X before we make the first connection. */
-extern frame_parm_handler x_frame_parm_handlers[];
-
static struct redisplay_interface x_redisplay_interface =
{
x_frame_parm_handlers,
@@ -32627,6 +32719,10 @@ Android does not support scroll bars at all. */);
DEFSYM (Qraise_and_focus, "raise-and-focus");
DEFSYM (Qreally_fast, "really-fast");
+ /* Referenced in gtkutil.c. */
+ DEFSYM (Qtheme_name, "theme-name");
+ DEFSYM (Qfile_name_sans_extension, "file-name-sans-extension");
+
DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym,
doc: /* Which modifer value Emacs reports when Ctrl is depressed.
This should be one of the symbols `ctrl', `alt', `hyper', `meta', or
diff --git a/src/xterm.h b/src/xterm.h
index 2c00b1e7bec..bf402de326b 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -993,6 +993,8 @@ extern int popup_activated_flag;
/* This is a chain of structures for all the X displays currently in use. */
extern struct x_display_info *x_display_list;
+extern struct x_display_info *x_dpyinfo (Display *)
+ ATTRIBUTE_RETURNS_NONNULL;
extern struct x_display_info *x_display_info_for_display (Display *);
extern struct frame *x_top_window_to_frame (struct x_display_info *, int);
extern struct x_display_info *x_term_init (Lisp_Object, char *, char *);
@@ -1725,6 +1727,7 @@ SELECTION_EVENT_DISPLAY (struct selection_input_event *ev)
/* From xfns.c. */
+extern frame_parm_handler x_frame_parm_handlers[];
extern void x_free_gcs (struct frame *);
extern void x_relative_mouse_position (struct frame *, int *, int *);
extern void x_real_pos_and_offsets (struct frame *, int *, int *, int *,
diff --git a/src/xwidget.c b/src/xwidget.c
index 389c48ca7f5..04ebcbfe96c 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -2286,7 +2286,7 @@ store_xwidget_download_callback_event (struct xwidget *xw,
EVENT_INIT (event);
event.kind = XWIDGET_EVENT;
event.frame_or_window = Qnil;
- event.arg = list5 (intern ("download-callback"),
+ event.arg = list5 (Qdownload_callback,
xwl,
build_string (url),
build_string (mimetype),
@@ -2305,7 +2305,7 @@ store_xwidget_js_callback_event (struct xwidget *xw,
EVENT_INIT (event);
event.kind = XWIDGET_EVENT;
event.frame_or_window = Qnil;
- event.arg = list4 (intern ("javascript-callback"), xwl, proc, argument);
+ event.arg = list4 (Qjavascript_callback, xwl, proc, argument);
kbd_buffer_store_event (&event);
}
@@ -4001,6 +4001,8 @@ to take effect. */);
staticpro (&dummy_tooltip_string);
#endif
#endif
+ DEFSYM (Qdownload_callback, "download-callback");
+ DEFSYM (Qjavascript_callback, "javascript-callback");
}
diff --git a/test/README b/test/README
index 7a3cf871a57..fb9f45490c5 100644
--- a/test/README
+++ b/test/README
@@ -109,6 +109,12 @@ debugging. To do that, use
make TEST_INTERACTIVE=yes ...
+Sometimes, some further settings are needed in order to run the batch
+test. This can be indicated by the $EMACS_EXTRAOPT environment
+variable, like
+
+ make ... EMACS_EXTRAOPT="--eval '(setopt ert-batch-print-length nil
ert-batch-print-level nil)'"
+
By default, ERT test failure summaries are quite brief in batch
mode--only the names of the failed tests are listed. If the
$EMACS_TEST_VERBOSE environment variable is set and non-empty, the
diff --git a/test/data/decompress/tzg.tar.gz b/test/data/decompress/tzg.tar.gz
new file mode 100644
index 00000000000..611f543688e
Binary files /dev/null and b/test/data/decompress/tzg.tar.gz differ
diff --git a/test/data/decompress/ztg.zip b/test/data/decompress/ztg.zip
new file mode 100644
index 00000000000..5f4aea4c8dc
Binary files /dev/null and b/test/data/decompress/ztg.zip differ
diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba
index d79072b06b5..088df86ad70 100644
--- a/test/infra/Dockerfile.emba
+++ b/test/infra/Dockerfile.emba
@@ -29,7 +29,7 @@ FROM debian:bullseye as emacs-base
RUN apt-get update && \
apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev \
- libdbus-1-dev libacl1-dev acl git texinfo gdb \
+ libxml2-dev libdbus-1-dev libacl1-dev acl git texinfo gdb \
&& rm -rf /var/lib/apt/lists/*
FROM emacs-base as emacs-inotify
@@ -45,7 +45,7 @@ WORKDIR /checkout
RUN ./autogen.sh autoconf
RUN ./configure
# 'make -j4 bootstrap' does not work reliably.
-RUN make bootstrap
+RUN make -j `nproc` bootstrap
FROM emacs-base as emacs-filenotify-gio
@@ -58,7 +58,7 @@ COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
RUN ./configure --with-file-notification=gfile
-RUN make bootstrap
+RUN make -j `nproc` bootstrap
# Debian bullseye doesn't provide proper packages. So we use Debian
# sid for this.
@@ -68,20 +68,49 @@ FROM debian:sid as emacs-eglot
RUN apt-get update && \
apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev \
- libdbus-1-dev libacl1-dev acl git texinfo gdb \
+ libxml2-dev libdbus-1-dev libacl1-dev acl git texinfo gdb \
&& rm -rf /var/lib/apt/lists/*
-# Install clangd.
+# Install clangd, tsserver.
RUN apt-get update && \
apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
- clangd \
+ clangd node-typescript \
&& rm -rf /var/lib/apt/lists/*
+# eclipse-jdt-ls is planned as Java language server.
+# See <https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=1024246>.
+
+# The following LSP servers exist as snap packages. However, snap
+# cannot be used inside containers. We keep this here for reference.
+
+# # Install snapd.
+# RUN apt-get update && \
+# apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
+# snapd \
+# && rm -rf /var/lib/apt/lists/*
+# RUN snap install core
+
+# # Install rust-analyzer.
+# RUN snap install rust-analyzer --beta
+
+# # Install typescript-language-server.
+# RUN snap install typescript-language-server
+
+# # Install vscode-json-languageserver.
+# RUN snap install vscode-json-languageserver
+
COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
RUN ./configure
-RUN make bootstrap
+RUN make -j `nproc` bootstrap
+
+# # Install company and yasnippet.
+# RUN mkdir /root/.emacs.d
+# RUN src/emacs --batch \
+# --eval '(setq url-debug 0 debug-on-error t)' \
+# --eval '(package-install (quote company))' \
+# --eval '(package-install (quote yasnippet))'
# Debian bullseye doesn't provide proper packages. So we use Debian
# sid for this.
@@ -91,7 +120,7 @@ FROM debian:sid as emacs-tree-sitter
RUN apt-get update && \
apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev \
- libdbus-1-dev libacl1-dev acl git texinfo gdb \
+ libxml2-dev libdbus-1-dev libacl1-dev acl git texinfo gdb \
&& rm -rf /var/lib/apt/lists/*
# Install tree-sitter library.
@@ -104,7 +133,7 @@ COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
RUN ./configure --with-tree-sitter
-RUN make bootstrap
+RUN make -j `nproc` bootstrap
# Install language grammars.
RUN mkdir -p /root/.emacs.d/tree-sitter
@@ -129,6 +158,7 @@ RUN src/emacs -Q --batch \
(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";) \
+ (rust "https://github.com/tree-sitter/tree-sitter-rust";) \
(tsx "https://github.com/tree-sitter/tree-sitter-typescript"; "master"
"tsx/src") \
(typescript "https://github.com/tree-sitter/tree-sitter-typescript";
"master" "typescript/src"))))' \
--eval '(dolist (lang (mapcar (quote car) treesit-language-source-alist)) \
@@ -145,7 +175,7 @@ COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
RUN ./configure --with-ns
-RUN make bootstrap
+RUN make -j `nproc` bootstrap
FROM emacs-base as emacs-native-comp
@@ -161,7 +191,7 @@ COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
RUN ./configure --with-native-compilation
-RUN make bootstrap -j2 \
+RUN make -j `nproc` bootstrap \
NATIVE_FULL_AOT=1 BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 0)"'
FROM emacs-native-comp as emacs-native-comp-speed1
@@ -170,7 +200,7 @@ COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
RUN ./configure --with-native-compilation
-RUN make bootstrap -j2 BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 1)"'
+RUN make -j `nproc` bootstrap BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq
comp-speed 1)"'
FROM emacs-native-comp as emacs-native-comp-speed2
@@ -178,4 +208,4 @@ COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
RUN ./configure --with-native-compilation
-RUN make bootstrap -j2
+RUN make -j `nproc` bootstrap
diff --git a/test/infra/Makefile.in b/test/infra/Makefile.in
index 20fa9021abc..9c32fd6a192 100644
--- a/test/infra/Makefile.in
+++ b/test/infra/Makefile.in
@@ -76,6 +76,15 @@ define subdir_template
define changes
@echo ' - lisp/so-long*.el' >>$(FILE)
endef
+ else ifeq ($(findstring textmodes, $(1)), textmodes)
+ define changes
+ @echo ' - $(1)/*-ts-mode.el' >>$(FILE)
+ @echo ' - test/$(1)/*-ts-mode-resources/**' >>$(FILE)
+ @echo ' - test/$(1)/*-ts-mode-tests.el' >>$(FILE)
+ @echo ' when: never' >>$(FILE)
+ @echo ' - changes:' >>$(FILE)
+ @echo ' - $(1)/*.el' >>$(FILE)
+ endef
else ifeq ($(findstring misc, $(1)), misc)
define changes
@echo ' - admin/*.el' >>$(FILE)
@@ -103,7 +112,7 @@ define subdir_template
@echo ' - test/$(1)/*.el' >>$(FILE)
@echo ' variables:' >>$(FILE)
@echo ' target: emacs-inotify' >>$(FILE)
- @echo ' make_params: "-k -C test $(target)"' >>$(FILE)
+ @echo ' make_params: -C test $(target)' >>$(FILE)
endef
$(foreach subdir, $(SUBDIRS), $(eval $(call subdir_template,$(subdir))))
diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml
index 4c44ba6c55c..11ff0d1c738 100644
--- a/test/infra/gitlab-ci.yml
+++ b/test/infra/gitlab-ci.yml
@@ -86,13 +86,14 @@ default:
# TODO: with make -j4 several of the tests were failing, for
# example shadowfile-tests, but passed without it.
- 'export PWD=$(pwd)'
- - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} -e
EMACS_TEST_JUNIT_REPORT=${EMACS_TEST_JUNIT_REPORT} -e
EMACS_TEST_TIMEOUT=${EMACS_TEST_TIMEOUT} -e
EMACS_TEST_VERBOSE=${EMACS_TEST_VERBOSE} --volumes-from $(docker ps -q -f
"label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name}
${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -xvc "git fetch ${PWD}
HEAD && echo checking out these updated files && git diff --name-only
FETCH_HEAD && ( git diff --name-only F [...]
+ - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} -e
EMACS_TEST_JUNIT_REPORT=${EMACS_TEST_JUNIT_REPORT} -e
EMACS_TEST_TIMEOUT=${EMACS_TEST_TIMEOUT} -e
EMACS_TEST_VERBOSE=${EMACS_TEST_VERBOSE} -e NPROC=`nproc` --volumes-from
$(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro
--name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -xvc
"git fetch ${PWD} HEAD && echo checking out these updated files && git diff
--name-only FETCH_HEAD && ( git d [...]
after_script:
# - docker ps -a
# - printenv
# - test -n "$(docker ps -aq -f name=${test_name})" && ( docker export
${test_name} | tar -tvf - )
# Prepare test artifacts.
- test -n "$(docker ps -aq -f name=${test_name})" && docker cp
${test_name}:checkout/test ${test_name}
+ - test -n "$(docker ps -aq -f name=${test_name})" && docker cp
${test_name}:checkout/configure.log ${test_name}
- test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name}
- find ${test_name} ! \( -name "*.log" -o -name ${EMACS_TEST_JUNIT_REPORT}
\) -type f -delete
# BusyBox find does not know -empty.
@@ -185,12 +186,15 @@ default:
- lisp/progmodes/*-ts-mode.el
- lisp/progmodes/js.el
- lisp/progmodes/python.el
+ - lisp/textmodes/*-ts-mode.el
- src/treesit.{h,c}
- test/infra/*
- test/lisp/progmodes/*-ts-mode-resources/**
- test/lisp/progmodes/*-ts-mode-tests.el
- test/lisp/progmodes/js-tests.el
- test/lisp/progmodes/python-tests.el
+ - test/lisp/textmodes/*-ts-mode-resources/**
+ - test/lisp/textmodes/*-ts-mode-tests.el
- test/src/treesit-tests.el
.native-comp-template:
@@ -254,7 +258,10 @@ test-filenotify-gio:
variables:
target: emacs-filenotify-gio
# This is needed in order to get a JUnit test report.
- make_params: '-k -C test check-expensive
LOGFILES="lisp/autorevert-tests.log lisp/filenotify-tests.log"'
+ make_params: >-
+ check-expensive
+ TEST_HOME=/root
+ LOGFILES="lisp/autorevert-tests.log lisp/filenotify-tests.log"
build-image-eglot:
stage: platform-images
@@ -271,7 +278,13 @@ test-eglot:
variables:
target: emacs-eglot
# This is needed in order to get a JUnit test report.
- make_params: '-k -C test check-expensive
LOGFILES="lisp/progmodes/eglot-tests.log"'
+ make_params: >-
+ check-expensive
+ TEST_HOME=/root LOGFILES="lisp/progmodes/eglot-tests.log"
+ # EMACS_EXTRAOPT="--eval \(package-reinstall\ \(quote\ company\)\)
+ # --eval \(package-reinstall\ \(quote\ yasnippet\)\)
+ # --eval \(use-package\ company\)
+ # --eval \(use-package\ yasnippet\)"
build-image-tree-sitter:
stage: platform-images
@@ -287,8 +300,11 @@ test-tree-sitter:
optional: true
variables:
target: emacs-tree-sitter
+ selector: >-
+ \(and\ \$\{SELECTOR_EXPENSIVE\}\ \(or\ \\\"^treesit\\\"\ \\\"-ts-\\\"\)\)
# This is needed in order to get a JUnit test report.
- make_params: '-k -C test SELECTOR=\(and\ \$\{SELECTOR_EXPENSIVE\}\
\\\"-ts-\\\"\) TEST_HOME=/root LOGFILES="$tree_sitter_files"'
+ make_params: >-
+ check SELECTOR=$selector TEST_HOME=/root LOGFILES="$tree_sitter_files"
build-image-gnustep:
stage: platform-images
@@ -336,7 +352,7 @@ test-native-comp-speed2:
optional: true
variables:
target: emacs-native-comp-speed2
- make_params: "-k -C test check SELECTOR='(not (tag :unstable))'"
+ make_params: check SELECTOR='(not (tag :unstable))'
# Local Variables:
# add-log-current-defun-header-regexp: "^\\([-_.[:alnum:]]+\\)[ \t]*:"
diff --git a/test/infra/test-jobs.yml b/test/infra/test-jobs.yml
index 095964ee4ed..0d9cbb029e5 100644
--- a/test/infra/test-jobs.yml
+++ b/test/infra/test-jobs.yml
@@ -15,7 +15,7 @@ test-lib-src-inotify:
- test/lib-src/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lib-src"
+ make_params: -C test check-lib-src
test-lisp-inotify:
stage: normal
@@ -32,7 +32,7 @@ test-lisp-inotify:
- test/lisp/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp"
+ make_params: -C test check-lisp
test-lisp-calc-inotify:
stage: normal
@@ -49,7 +49,7 @@ test-lisp-calc-inotify:
- test/lisp/calc/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-calc"
+ make_params: -C test check-lisp-calc
test-lisp-calendar-inotify:
stage: normal
@@ -66,7 +66,7 @@ test-lisp-calendar-inotify:
- test/lisp/calendar/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-calendar"
+ make_params: -C test check-lisp-calendar
test-lisp-cedet-inotify:
stage: normal
@@ -83,7 +83,7 @@ test-lisp-cedet-inotify:
- test/lisp/cedet/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-cedet"
+ make_params: -C test check-lisp-cedet
test-lisp-cedet-semantic-inotify:
stage: normal
@@ -100,7 +100,7 @@ test-lisp-cedet-semantic-inotify:
- test/lisp/cedet/semantic/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-cedet-semantic"
+ make_params: -C test check-lisp-cedet-semantic
test-lisp-cedet-semantic-bovine-inotify:
stage: normal
@@ -117,7 +117,7 @@ test-lisp-cedet-semantic-bovine-inotify:
- test/lisp/cedet/semantic/bovine/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-cedet-semantic-bovine"
+ make_params: -C test check-lisp-cedet-semantic-bovine
test-lisp-cedet-srecode-inotify:
stage: normal
@@ -134,7 +134,7 @@ test-lisp-cedet-srecode-inotify:
- test/lisp/cedet/srecode/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-cedet-srecode"
+ make_params: -C test check-lisp-cedet-srecode
test-lisp-emacs-lisp-inotify:
stage: normal
@@ -151,7 +151,7 @@ test-lisp-emacs-lisp-inotify:
- test/lisp/emacs-lisp/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-emacs-lisp"
+ make_params: -C test check-lisp-emacs-lisp
test-lisp-emacs-lisp-eieio-tests-inotify:
stage: normal
@@ -168,7 +168,7 @@ test-lisp-emacs-lisp-eieio-tests-inotify:
- test/lisp/emacs-lisp/eieio-tests/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-emacs-lisp-eieio-tests"
+ make_params: -C test check-lisp-emacs-lisp-eieio-tests
test-lisp-emacs-lisp-faceup-tests-inotify:
stage: normal
@@ -185,7 +185,7 @@ test-lisp-emacs-lisp-faceup-tests-inotify:
- test/lisp/emacs-lisp/faceup-tests/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-emacs-lisp-faceup-tests"
+ make_params: -C test check-lisp-emacs-lisp-faceup-tests
test-lisp-emulation-inotify:
stage: normal
@@ -202,7 +202,7 @@ test-lisp-emulation-inotify:
- test/lisp/emulation/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-emulation"
+ make_params: -C test check-lisp-emulation
test-lisp-erc-inotify:
stage: normal
@@ -219,7 +219,7 @@ test-lisp-erc-inotify:
- test/lisp/erc/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-erc"
+ make_params: -C test check-lisp-erc
test-lisp-eshell-inotify:
stage: normal
@@ -236,7 +236,7 @@ test-lisp-eshell-inotify:
- test/lisp/eshell/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-eshell"
+ make_params: -C test check-lisp-eshell
test-lisp-gnus-inotify:
stage: normal
@@ -253,7 +253,7 @@ test-lisp-gnus-inotify:
- test/lisp/gnus/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-gnus"
+ make_params: -C test check-lisp-gnus
test-lisp-image-inotify:
stage: normal
@@ -270,7 +270,7 @@ test-lisp-image-inotify:
- test/lisp/image/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-image"
+ make_params: -C test check-lisp-image
test-lisp-international-inotify:
stage: normal
@@ -287,7 +287,7 @@ test-lisp-international-inotify:
- test/lisp/international/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-international"
+ make_params: -C test check-lisp-international
test-lisp-mail-inotify:
stage: normal
@@ -304,7 +304,7 @@ test-lisp-mail-inotify:
- test/lisp/mail/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-mail"
+ make_params: -C test check-lisp-mail
test-lisp-mh-e-inotify:
stage: normal
@@ -321,7 +321,7 @@ test-lisp-mh-e-inotify:
- test/lisp/mh-e/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-mh-e"
+ make_params: -C test check-lisp-mh-e
test-lisp-net-inotify:
stage: normal
@@ -338,7 +338,7 @@ test-lisp-net-inotify:
- test/lisp/net/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-net"
+ make_params: -C test check-lisp-net
test-lisp-nxml-inotify:
stage: normal
@@ -355,7 +355,7 @@ test-lisp-nxml-inotify:
- test/lisp/nxml/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-nxml"
+ make_params: -C test check-lisp-nxml
test-lisp-obsolete-inotify:
stage: normal
@@ -372,7 +372,7 @@ test-lisp-obsolete-inotify:
- test/lisp/obsolete/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-obsolete"
+ make_params: -C test check-lisp-obsolete
test-lisp-org-inotify:
stage: normal
@@ -389,7 +389,7 @@ test-lisp-org-inotify:
- test/lisp/org/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-org"
+ make_params: -C test check-lisp-org
test-lisp-play-inotify:
stage: normal
@@ -406,7 +406,7 @@ test-lisp-play-inotify:
- test/lisp/play/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-play"
+ make_params: -C test check-lisp-play
test-lisp-progmodes-inotify:
stage: normal
@@ -430,7 +430,7 @@ test-lisp-progmodes-inotify:
- test/lisp/progmodes/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-progmodes"
+ make_params: -C test check-lisp-progmodes
test-lisp-so-long-tests-inotify:
stage: normal
@@ -447,7 +447,7 @@ test-lisp-so-long-tests-inotify:
- test/lisp/so-long-tests/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-so-long-tests"
+ make_params: -C test check-lisp-so-long-tests
test-lisp-term-inotify:
stage: normal
@@ -464,7 +464,7 @@ test-lisp-term-inotify:
- test/lisp/term/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-term"
+ make_params: -C test check-lisp-term
test-lisp-textmodes-inotify:
stage: normal
@@ -475,13 +475,18 @@ test-lisp-textmodes-inotify:
rules:
- if: '$CI_PIPELINE_SOURCE == "schedule"'
when: never
+ - changes:
+ - lisp/textmodes/*-ts-mode.el
+ - test/lisp/textmodes/*-ts-mode-resources/**
+ - test/lisp/textmodes/*-ts-mode-tests.el
+ when: never
- changes:
- lisp/textmodes/*.el
- test/lisp/textmodes/*resources/**
- test/lisp/textmodes/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-textmodes"
+ make_params: -C test check-lisp-textmodes
test-lisp-url-inotify:
stage: normal
@@ -498,7 +503,7 @@ test-lisp-url-inotify:
- test/lisp/url/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-url"
+ make_params: -C test check-lisp-url
test-lisp-use-package-inotify:
stage: normal
@@ -515,7 +520,7 @@ test-lisp-use-package-inotify:
- test/lisp/use-package/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-use-package"
+ make_params: -C test check-lisp-use-package
test-lisp-vc-inotify:
stage: normal
@@ -532,7 +537,7 @@ test-lisp-vc-inotify:
- test/lisp/vc/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-lisp-vc"
+ make_params: -C test check-lisp-vc
test-misc-inotify:
stage: normal
@@ -549,7 +554,7 @@ test-misc-inotify:
- test/misc/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-misc"
+ make_params: -C test check-misc
test-src-inotify:
stage: normal
@@ -570,7 +575,7 @@ test-src-inotify:
- test/src/*.el
variables:
target: emacs-inotify
- make_params: "-k -C test check-src"
+ make_params: -C test check-src
# js-tests.el and python-tests.el don't follow test file name convention.
.tree-sitter-files-template:
@@ -585,5 +590,6 @@ test-src-inotify:
lisp/progmodes/lua-ts-mode-tests.log
lisp/progmodes/python-tests.log
lisp/progmodes/ruby-ts-mode-tests.log
+ lisp/progmodes/rust-ts-mode-tests.log
lisp/progmodes/typescript-ts-mode-tests.log
src/treesit-tests.log
diff --git a/test/lisp/align-tests.el b/test/lisp/align-tests.el
index cd309ea07bf..eaebaf8360c 100644
--- a/test/lisp/align-tests.el
+++ b/test/lisp/align-tests.el
@@ -52,7 +52,7 @@
(autoload 'treesit-ready-p "treesit")
(ert-deftest align-lua ()
- (skip-unless (treesit-ready-p 'lua))
+ (skip-unless (treesit-ready-p 'lua t))
(let ((comment-column 20)
(indent-tabs-mode nil))
(ert-test-erts-file (ert-resource-file "lua-ts-mode.erts")
diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el
index acc416d6f78..5ebc56a84fc 100644
--- a/test/lisp/arc-mode-tests.el
+++ b/test/lisp/arc-mode-tests.el
@@ -46,6 +46,22 @@
(when (buffer-live-p zip-buffer) (kill-buffer zip-buffer))
(when (buffer-live-p gz-buffer) (kill-buffer gz-buffer)))))
+(declare-function tar-extract "tar-mode")
+(ert-deftest arc-mode-test-zip-extract-tar-and-gz ()
+ (skip-unless (and archive-zip-extract (executable-find (car
archive-zip-extract))))
+ (skip-unless (executable-find "gzip"))
+ (require 'tar-mode)
+ (let* ((zip-file (expand-file-name "ztg.zip" arc-mode-tests-data-directory))
+ zip-buffer tar-buffer gz-buffer)
+ (unwind-protect
+ (with-current-buffer (setq zip-buffer (find-file-noselect zip-file))
+ (with-current-buffer (setq tar-buffer (archive-extract))
+ (setq gz-buffer (tar-extract))
+ (should (equal (char-after) ?\N{SNOWFLAKE}))))
+ (when (buffer-live-p zip-buffer) (kill-buffer zip-buffer))
+ (when (buffer-live-p tar-buffer) (kill-buffer tar-buffer))
+ (when (buffer-live-p gz-buffer) (kill-buffer gz-buffer)))))
+
(ert-deftest arc-mode-test-zip-ensure-ext ()
"Regression test for bug#61326."
(skip-unless (executable-find "zip"))
diff --git a/test/lisp/color-tests.el b/test/lisp/color-tests.el
index 9b6b8c1f8dc..0f53e4332a4 100644
--- a/test/lisp/color-tests.el
+++ b/test/lisp/color-tests.el
@@ -247,5 +247,38 @@
(should (equal (color-darken-name "red" 0) "#ffff00000000"))
(should (equal (color-darken-name "red" 10) "#e66500000000")))
+(ert-deftest color-tests-oklab-to-xyz ()
+ (should (color-tests--approx-equal (color-oklab-to-xyz 0 0 0) '(0.0 0.0
0.0)))
+ (should (color-tests--approx-equal (color-oklab-to-xyz 1.0 0.0 0.0)
+ '(0.95047005 1.0 1.0883001)))
+ (should (color-tests--approx-equal (color-oklab-to-xyz 0.450 1.236 -0.019)
'(1.000604 -0.000008 -0.000038)))
+ (should (color-tests--approx-equal (color-oklab-to-xyz 0.922 -0.671 0.263)
'(0.000305 1.000504 0.000898)))
+ (should (color-tests--approx-equal (color-oklab-to-xyz 0.153 -1.415 -0.449)
'(0.000590 0.000057 1.001650))))
+
+(ert-deftest color-tests-xyz-to-oklab ()
+ (should (color-tests--approx-equal (color-xyz-to-oklab 0 0 0) '(0.0 0.0
0.0)))
+ (should (color-tests--approx-equal (color-xyz-to-oklab 0.95 1.0 1.089)
+ '(0.999969 -0.000258 -0.000115)))
+ (should (color-tests--approx-equal (color-xyz-to-oklab 1.0 0.0 0.0)
+ '(0.449932 1.235710 -0.019028)))
+ (should (color-tests--approx-equal (color-xyz-to-oklab 0.0 1.0 0.0)
+ '(0.921817 -0.671238 0.263324)))
+ (should (color-tests--approx-equal (color-xyz-to-oklab 0.0 0.0 1.0)
+ '(0.152603 -1.414997 -0.448927))))
+
+(ert-deftest color-tests-srgb-to-oklab ()
+ (should (equal (color-srgb-to-oklab 0 0 0) '(0.0 0.0 0.0)))
+ (should
+ (color-tests--approx-equal (color-srgb-to-oklab 0 0 1) '(0.451978 -0.032430
-0.311611)))
+ (should
+ (color-tests--approx-equal (color-srgb-to-oklab 0.1 0.2 0.3) '(0.313828
-0.019091 -0.052561))))
+
+(ert-deftest color-tests-oklab-to-srgb ()
+ (should (equal (color-oklab-to-srgb 0 0 0) '(0.0 0.0 0.0)))
+ (should
+ (color-tests--approx-equal (color-oklab-to-srgb 0.451978 -0.032430
-0.311611) '(0.0 0.0 1.0)))
+ (should
+ (color-tests--approx-equal (color-oklab-to-srgb 0.313828 -0.019091
-0.052561) '(0.1 0.2 0.3))))
+
(provide 'color-tests)
;;; color-tests.el ends here
diff --git a/test/lisp/completion-preview-tests.el
b/test/lisp/completion-preview-tests.el
index 5b2c28bd3dd..7d358d07519 100644
--- a/test/lisp/completion-preview-tests.el
+++ b/test/lisp/completion-preview-tests.el
@@ -27,23 +27,25 @@
(when-let ((bounds (bounds-of-thing-at-point 'symbol)))
(append (list (car bounds) (cdr bounds) completions) props))))
-(defun completion-preview-tests--check-preview (string &optional exact)
+(defun completion-preview-tests--check-preview
+ (string &optional beg-face end-face)
"Check that the completion preview is showing STRING.
-If EXACT is non-nil, check that STRING has the
-`completion-preview-exact' face. Otherwise check that STRING has
-the `completion-preview' face.
+BEG-FACE and END-FACE say which faces the beginning and end of STRING
+should have, respectively. Both BEG-FACE and END-FACE default to
+`completion-preview'.
If STRING is nil, check that there is no completion preview
instead."
(if (not string)
- (should (not completion-preview--overlay))
+ (should-not completion-preview--overlay)
(should completion-preview--overlay)
(let ((after-string (completion-preview--get 'after-string)))
(should (string= after-string string))
(should (eq (get-text-property 0 'face after-string)
- (if exact
- 'completion-preview-exact
+ (or beg-face 'completion-preview)))
+ (should (eq (get-text-property (1- (length after-string)) 'face
after-string)
+ (or end-face
'completion-preview))))))
(ert-deftest completion-preview ()
@@ -57,7 +59,9 @@ instead."
(completion-preview--post-command))
;; Exact match
- (completion-preview-tests--check-preview "barbaz" 'exact)
+ (completion-preview-tests--check-preview "barbaz"
+ 'completion-preview-exact
+ 'completion-preview-exact)
(insert "v")
(let ((this-command 'self-insert-command))
@@ -71,7 +75,9 @@ instead."
(completion-preview--post-command))
;; Exact match again
- (completion-preview-tests--check-preview "barbaz" 'exact)))
+ (completion-preview-tests--check-preview "barbaz"
+ 'completion-preview-exact
+ 'completion-preview-exact)))
(ert-deftest completion-preview-multiple-matches ()
"Test Completion Preview mode with multiple matching candidates."
@@ -84,12 +90,12 @@ instead."
(completion-preview--post-command))
;; Multiple matches, the preview shows the first one
- (completion-preview-tests--check-preview "bar")
+ (completion-preview-tests--check-preview "bar" 'completion-preview-common)
(completion-preview-next-candidate 1)
;; Next match
- (completion-preview-tests--check-preview "baz")))
+ (completion-preview-tests--check-preview "baz"
'completion-preview-common)))
(ert-deftest completion-preview-exact-match-only ()
"Test `completion-preview-exact-match-only'."
@@ -111,7 +117,9 @@ instead."
(completion-preview--post-command))
;; Exact match
- (completion-preview-tests--check-preview "m" 'exact)))
+ (completion-preview-tests--check-preview "m"
+ 'completion-preview-exact
+ 'completion-preview-exact)))
(ert-deftest completion-preview-function-capfs ()
"Test Completion Preview mode with capfs that return a function."
@@ -124,7 +132,7 @@ instead."
(insert "foo")
(let ((this-command 'self-insert-command))
(completion-preview--post-command))
- (completion-preview-tests--check-preview "bar")))
+ (completion-preview-tests--check-preview "bar"
'completion-preview-common)))
(ert-deftest completion-preview-non-exclusive-capfs ()
"Test Completion Preview mode with non-exclusive capfs."
@@ -140,11 +148,13 @@ instead."
(insert "foo")
(let ((this-command 'self-insert-command))
(completion-preview--post-command))
- (completion-preview-tests--check-preview "bar")
+ (completion-preview-tests--check-preview "bar" 'completion-preview-common)
(setq-local completion-preview-exact-match-only t)
(let ((this-command 'self-insert-command))
(completion-preview--post-command))
- (completion-preview-tests--check-preview "barbaz" 'exact)))
+ (completion-preview-tests--check-preview "barbaz"
+ 'completion-preview-exact
+ 'completion-preview-exact)))
(ert-deftest completion-preview-face-updates ()
"Test updating the face in completion preview when match is no longer exact."
@@ -160,7 +170,9 @@ instead."
(insert "b")
(let ((this-command 'self-insert-command))
(completion-preview--post-command))
- (completion-preview-tests--check-preview "arbaz" 'exact)
+ (completion-preview-tests--check-preview "arbaz"
+ 'completion-preview-exact
+ 'completion-preview-exact)
(delete-char -1)
(let ((this-command 'delete-backward-char))
(completion-preview--post-command))
@@ -173,13 +185,15 @@ instead."
(with-temp-buffer
(setq-local completion-at-point-functions
(list
- (lambda () (user-error "bad"))
+ (lambda () (user-error "Bad"))
(completion-preview-tests--capf
'("foobarbaz"))))
(insert "foo")
(let ((this-command 'self-insert-command))
(completion-preview--post-command))
- (completion-preview-tests--check-preview "barbaz" 'exact)))
+ (completion-preview-tests--check-preview "barbaz"
+ 'completion-preview-exact
+ 'completion-preview-exact)))
(ert-deftest completion-preview-mid-symbol-cycle ()
"Test cycling the completion preview with point at the middle of a symbol."
@@ -196,4 +210,101 @@ instead."
(completion-preview-next-candidate 1)
(completion-preview-tests--check-preview "z")))
+(ert-deftest completion-preview-complete ()
+ "Test `completion-preview-complete'."
+ (with-temp-buffer
+ (let ((exit-fn-called nil)
+ (exit-fn-args nil)
+ (message-args nil)
+ (completion-auto-help nil))
+ (setq-local completion-at-point-functions
+ (list
+ (completion-preview-tests--capf
+ '("foobar" "foobaz" "foobash" "foobash-mode")
+ :exit-function
+ (lambda (&rest args)
+ (setq exit-fn-called t
+ exit-fn-args args)))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (message "here")
+
+ (completion-preview-tests--check-preview "bar"
'completion-preview-common)
+
+ ;; Insert the common prefix, "ba".
+ (completion-preview-complete)
+
+ ;; Only "r" should remain.
+ (completion-preview-tests--check-preview "r")
+
+ (cl-letf (((symbol-function #'minibuffer-message)
+ (lambda (&rest args) (setq message-args args))))
+
+ ;; With `completion-auto-help' set to nil, a second call to
+ ;; `completion-preview-complete' just displays a message.
+ (completion-preview-complete)
+ (setq completion-preview--inhibit-update-p nil)
+
+ (should (equal message-args '("Next char not unique"))))
+
+ ;; The preview should stay put.
+ (completion-preview-tests--check-preview "r")
+ ;; (completion-preview-active-mode -1)
+
+ ;; Narrow further.
+ (insert "s")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; The preview should indicate an exact match.
+ (completion-preview-tests--check-preview "h"
+ 'completion-preview-common
+ 'completion-preview-common)
+
+ ;; Insert the entire preview content.
+ (completion-preview-complete)
+ (setq completion-preview--inhibit-update-p nil)
+ (let ((this-command 'completion-preview-complete))
+ (completion-preview--post-command))
+
+ ;; The preview should update to indicate that there's a further
+ ;; possible completion.
+ (completion-preview-tests--check-preview "-mode"
+ 'completion-preview-exact
+ 'completion-preview-exact)
+ (should exit-fn-called)
+ (should (equal exit-fn-args '("foobash" exact)))
+ (setq exit-fn-called nil exit-fn-args nil)
+
+ ;; Insert the extra suffix.
+ (completion-preview-complete)
+
+ ;; Nothing more to show, so the preview should now be gone.
+ (should-not completion-preview--overlay)
+ (should exit-fn-called)
+ (should (equal exit-fn-args '("foobash-mode" finished))))))
+
+(ert-deftest completion-preview-insert-calls-exit-function ()
+ "Test that `completion-preview-insert' calls the completion exit function."
+ (let ((exit-fn-called nil) (exit-fn-args nil))
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (completion-preview-tests--capf
+ '("foobar" "foobaz")
+ :exit-function
+ (lambda (&rest args)
+ (setq exit-fn-called t
+ exit-fn-args args)))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "bar"
'completion-preview-common)
+ (completion-preview-insert)
+ (should (string= (buffer-string) "foobar"))
+ (should-not completion-preview--overlay)
+ (should exit-fn-called)
+ (should (equal exit-fn-args '("foobar" finished))))))
+
;;; completion-preview-tests.el ends here
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index a943012e5fc..e3ce87cc9af 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -1135,7 +1135,7 @@ byte-compiled. Run with dynamic binding."
"var.*foo.*lacks a prefix")
(bytecomp--define-warning-file-test "warn-format.el"
- "called with 2 args to fill 1 format field")
+ "called with 2 arguments to fill 1 format field")
(bytecomp--define-warning-file-test "warn-free-setq.el"
"free.*foo")
diff --git a/test/lisp/emacs-lisp/macroexp-resources/vk.el
b/test/lisp/emacs-lisp/macroexp-resources/vk.el
index 5358bcaeb5c..c59a6b9f8f1 100644
--- a/test/lisp/emacs-lisp/macroexp-resources/vk.el
+++ b/test/lisp/emacs-lisp/macroexp-resources/vk.el
@@ -78,29 +78,31 @@
(defconst vk-val3 (eval-when-compile (vk-f3 0)))
-(defconst vk-f4 '(lambda (x)
- (defvar vk-v4)
- (let ((vk-v4 31)
- (y 32))
- (ignore vk-v4 x y)
- (list
- (vk-variable-kind vk-a) ; dyn
- (vk-variable-kind vk-b) ; dyn
- (vk-variable-kind vk-v4) ; dyn
- (vk-variable-kind x) ; dyn
- (vk-variable-kind y))))) ; dyn
-
-(defconst vk-f5 '(closure (t) (x)
- (defvar vk-v5)
- (let ((vk-v5 41)
- (y 42))
- (ignore vk-v5 x y)
- (list
- (vk-variable-kind vk-a) ; dyn
- (vk-variable-kind vk-b) ; dyn
- (vk-variable-kind vk-v5) ; dyn
- (vk-variable-kind x) ; lex
- (vk-variable-kind y))))) ; lex
+(defconst vk-f4 (eval '(lambda (x)
+ (defvar vk-v4)
+ (let ((vk-v4 31)
+ (y 32))
+ (ignore vk-v4 x y)
+ (list
+ (vk-variable-kind vk-a) ; dyn
+ (vk-variable-kind vk-b) ; dyn
+ (vk-variable-kind vk-v4) ; dyn
+ (vk-variable-kind x) ; dyn
+ (vk-variable-kind y)))) ; dyn
+ nil))
+
+(defconst vk-f5 (eval '(lambda (x)
+ (defvar vk-v5)
+ (let ((vk-v5 41)
+ (y 42))
+ (ignore vk-v5 x y)
+ (list
+ (vk-variable-kind vk-a) ; dyn
+ (vk-variable-kind vk-b) ; dyn
+ (vk-variable-kind vk-v5) ; dyn
+ (vk-variable-kind x) ; lex
+ (vk-variable-kind y)))) ; lex
+ t))
(defun vk-f6 ()
(eval '(progn
diff --git a/test/lisp/emacs-lisp/oclosure-tests.el
b/test/lisp/emacs-lisp/oclosure-tests.el
index 4760f403158..14c205631e0 100644
--- a/test/lisp/emacs-lisp/oclosure-tests.el
+++ b/test/lisp/emacs-lisp/oclosure-tests.el
@@ -32,7 +32,7 @@
(cl-defmethod oclosure-test-gen ((_x compiled-function)) "#<bytecode>")
-(cl-defmethod oclosure-test-gen ((_x cons)) "#<cons>")
+(cl-defmethod oclosure-test-gen ((_x interpreted-function))
"#<interpreted-function>")
(cl-defmethod oclosure-test-gen ((_x oclosure))
(format "#<oclosure:%s>" (cl-call-next-method)))
@@ -63,7 +63,7 @@
(should (cl-typep ocl1 'oclosure-test))
(should (cl-typep ocl1 'oclosure))
(should (member (oclosure-test-gen ocl1)
- '("#<oclosure-test:#<oclosure:#<cons>>>"
+ '("#<oclosure-test:#<oclosure:#<interpreted-function>>>"
"#<oclosure-test:#<oclosure:#<bytecode>>>")))
(should (stringp (documentation #'oclosure-test--fst)))
))
diff --git a/test/lisp/emacs-lisp/package-resources/package-test-server.py
b/test/lisp/emacs-lisp/package-resources/package-test-server.py
index 128b4249ec3..16f3e391aa1 100644
--- a/test/lisp/emacs-lisp/package-resources/package-test-server.py
+++ b/test/lisp/emacs-lisp/package-resources/package-test-server.py
@@ -1,23 +1,19 @@
import sys
-import BaseHTTPServer
-from SimpleHTTPServer import SimpleHTTPRequestHandler
+try:
+ from http.server import HTTPServer, SimpleHTTPRequestHandler
+except ImportError:
+ from BaseHTTPServer import HTTPServer
+ from SimpleHTTPServer import SimpleHTTPRequestHandler
-HandlerClass = SimpleHTTPRequestHandler
-ServerClass = BaseHTTPServer.HTTPServer
-Protocol = "HTTP/1.0"
-
-if sys.argv[1:]:
- port = int(sys.argv[1])
-else:
- port = 0
-server_address = ('127.0.0.1', port)
-HandlerClass.protocol_version = Protocol
-httpd = ServerClass(server_address, HandlerClass)
+HandlerClass = SimpleHTTPRequestHandler
+HandlerClass.protocol_version = "HTTP/1.0"
+server_address = ("127.0.0.1", int(sys.argv[1]) if sys.argv[1:] else 0)
+httpd = HTTPServer(server_address, HandlerClass)
ip, port = httpd.socket.getsockname()[0:2]
-print ("Server started, http://%s:%s/"; % (ip, port))
+print("Server started, http://%s:%s/"; % (ip, port))
# Flush in case we're in full buffering mode (instead of line
# buffering), this might happen if python is a cygwin program and we
# run it from a native w32 program.
diff --git a/test/lisp/emacs-lisp/package-tests.el
b/test/lisp/emacs-lisp/package-tests.el
index d95b94f2145..692d6550250 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -634,14 +634,15 @@ but with a different end of line convention (bug#48137)."
(ert-deftest package-test-update-archives-async ()
"Test updating package archives asynchronously."
:tags '(:expensive-test)
- (skip-unless (executable-find "python2"))
(let* ((package-menu-async t)
(default-directory package-test-data-dir)
- (process (start-process
+ (python-interpreter (seq-some #'executable-find '("python" "python3"
"python2")))
+ process addr)
+ (skip-unless python-interpreter)
+ (setq process (start-process
"package-server" "package-server-buffer"
- (executable-find "python2")
+ python-interpreter
"package-test-server.py"))
- (addr nil))
(unwind-protect
(progn
(with-current-buffer "package-server-buffer"
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 072209bcbcc..1bb79f72671 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -619,18 +619,19 @@
"[^amz]\\S_"))))
(ert-deftest rx-constituents ()
- (let ((rx-constituents
- (append '((beta . gamma)
- (gamma . "a*b")
- (delta . ((lambda (form)
- (regexp-quote (format "<%S>" form)))
- 1 nil symbolp))
- (epsilon . delta))
- rx-constituents)))
- (should (equal (rx-to-string '(seq (+ beta) nonl gamma) t)
- "\\(?:a*b\\)+.\\(?:a*b\\)"))
- (should (equal (rx-to-string '(seq (delta a b c) (* (epsilon d e))) t)
- "\\(?:<(delta a b c)>\\)\\(?:<(epsilon d e)>\\)*"))))
+ (with-suppressed-warnings ((obsolete rx-constituents))
+ (let ((rx-constituents
+ (append '((beta . gamma)
+ (gamma . "a*b")
+ (delta . ((lambda (form)
+ (regexp-quote (format "<%S>" form)))
+ 1 nil symbolp))
+ (epsilon . delta))
+ rx-constituents)))
+ (should (equal (rx-to-string '(seq (+ beta) nonl gamma) t)
+ "\\(?:a*b\\)+.\\(?:a*b\\)"))
+ (should (equal (rx-to-string '(seq (delta a b c) (* (epsilon d e))) t)
+ "\\(?:<(delta a b c)>\\)\\(?:<(epsilon d e)>\\)*")))))
(ert-deftest rx-compat ()
"Test old symbol retained for compatibility (bug#37517)."
diff --git a/test/lisp/emacs-lisp/vtable-tests.el
b/test/lisp/emacs-lisp/vtable-tests.el
index 08fdf1594a4..1d4b0650210 100644
--- a/test/lisp/emacs-lisp/vtable-tests.el
+++ b/test/lisp/emacs-lisp/vtable-tests.el
@@ -39,4 +39,34 @@
:insert nil)))
'(left right left))))
+(ert-deftest test-vtable-insert-object ()
+ (should
+ (equal (let ((buffer (get-buffer-create " *vtable-test*")))
+ (pop-to-buffer buffer)
+ (erase-buffer)
+ (let* ((object1 '("Foo" 3))
+ (object2 '("Gazonk" 8))
+ (table (make-vtable
+ :columns '("Name" (:name "Rank" :width 5))
+ :objects (list object1 object2))))
+ (mapc (lambda (args)
+ (pcase-let ((`(,object ,location ,before) args))
+ (vtable-insert-object table object location before)))
+ `( ; Some correct inputs.
+ ;; object location before
+ (("Fizz" 4) ,object1 nil)
+ (("Bop" 7) ,object2 t)
+ (("Zat" 5) 2 nil)
+ (("Dib" 6) 3 t)
+ (("Wup" 9) nil nil)
+ (("Quam" 2) nil t)
+ ;; And some faulty inputs.
+ (("Yat" 1) -1 nil) ; non-existing index,
`before' is ignored.
+ (("Vop" 10) 100 t) ; non-existing index,
`before' is ignored.
+ (("Jib" 11) ("Bleh" 0) nil) ; non-existing object.
+ (("Nix" 0) ("Ugh" 0) t) ; non-existing object.
+ ))
+ (mapcar #'cadr (vtable-objects table))))
+ (number-sequence 0 11))))
+
;;; vtable-tests.el ends here
diff --git a/test/lisp/erc/erc-button-tests.el
b/test/lisp/erc/erc-button-tests.el
index 603b3745a27..9d8fb0081c5 100644
--- a/test/lisp/erc/erc-button-tests.el
+++ b/test/lisp/erc/erc-button-tests.el
@@ -74,9 +74,11 @@
(entry (list (rx "+1") 0 func #'ignore 0))
(erc-button-alist (cons entry erc-button-alist)))
- (erc-display-message nil 'notice (current-buffer) "Foo bar baz")
- (erc-display-message nil nil (current-buffer) "+1")
- (erc-display-message nil 'notice (current-buffer) "Spam")
+ (erc-tests-common-display-message nil 'notice (current-buffer)
+ "Foo bar baz")
+ (erc-tests-common-display-message nil nil (current-buffer) "+1")
+ (erc-tests-common-display-message nil 'notice (current-buffer) "Spam")
+
(should (equal (pop erc-button-tests--form)
'(53 55 ignore nil ("+1") "\\+1")))
(should-not erc-button-tests--form)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 3c4ad04abd7..f8bfc362085 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -48,7 +48,7 @@
:command "PRIVMSG"
:command-args (list "#chan" msg)
:contents msg)))
- (erc-display-message parsed nil (current-buffer) msg)))
+ (erc-tests-common-display-message parsed nil (current-buffer) msg)))
(defun erc-fill-tests--wrap-populate (test)
(let ((original-window-buffer (window-buffer (selected-window)))
@@ -79,7 +79,7 @@
(erc-update-channel-member
"#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
- (erc-display-message
+ (erc-tests-common-display-message
nil 'notice (current-buffer)
(concat "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 "
@@ -260,29 +260,31 @@
(erc-fill-tests--insert-privmsg "bob" "zero.")
(erc-fill-tests--insert-privmsg "bob" "0.5")
- (erc-process-ctcp-query
- erc-server-process
- (make-erc-response
- :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION one.\1"
- :sender "bob!~u@fake"
- :command "PRIVMSG"
- :command-args '("#chan" "\1ACTION one.\1")
- :contents "\1ACTION one.\1")
- "bob" "~u" "fake")
+ (erc-tests-common-with-date-aware-display-message
+ (erc-process-ctcp-query
+ erc-server-process
+ (make-erc-response
+ :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION one.\1"
+ :sender "bob!~u@fake"
+ :command "PRIVMSG"
+ :command-args '("#chan" "\1ACTION one.\1")
+ :contents "\1ACTION one.\1")
+ "bob" "~u" "fake"))
(erc-fill-tests--insert-privmsg "bob" "two.")
(erc-fill-tests--insert-privmsg "bob" "2.5")
;; Compat switch to opt out of overhanging speaker.
- (let (erc-fill--wrap-action-dedent-p)
- (erc-process-ctcp-query
- erc-server-process
- (make-erc-response
- :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION three\1"
- :sender "bob!~u@fake" :command "PRIVMSG"
- :command-args '("#chan" "\1ACTION three\1")
- :contents "\1ACTION three\1")
- "bob" "~u" "fake"))
+ (erc-tests-common-with-date-aware-display-message
+ (let (erc-fill--wrap-action-dedent-p)
+ (erc-process-ctcp-query
+ erc-server-process
+ (make-erc-response
+ :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION three\1"
+ :sender "bob!~u@fake" :command "PRIVMSG"
+ :command-args '("#chan" "\1ACTION three\1")
+ :contents "\1ACTION three\1")
+ "bob" "~u" "fake")))
(erc-fill-tests--insert-privmsg "bob" "four."))
@@ -299,17 +301,9 @@
(ert-deftest erc-fill-wrap--merge-action/indicator-pre ()
:tags `(:unstable
,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
- (let ((erc-fill-wrap-merge-indicator '(pre ?> shadow)))
+ (let ((erc-fill-wrap-merge-indicator '(?> . shadow)))
(erc-fill-wrap-tests--merge-action "merge-wrap-indicator-pre-01")))
-;; One crucial thing this test asserts is that the indicator is
-;; omitted when the previous line ends in a stamp.
-(ert-deftest erc-fill-wrap--merge-action/indicator-post ()
- :tags `(:unstable
- ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
- (let ((erc-fill-wrap-merge-indicator '(post ?~ shadow)))
- (erc-fill-wrap-tests--merge-action "merge-wrap-indicator-post-01")))
-
(ert-deftest erc-fill-line-spacing ()
:tags `(:unstable
,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
@@ -320,8 +314,10 @@
(erc-fill-tests--wrap-populate
(lambda ()
(erc-fill-tests--insert-privmsg "bob" "This buffer is for text.")
- (erc-display-message nil 'notice (current-buffer) "one two three")
- (erc-display-message nil 'notice (current-buffer) "four five six")
+ (erc-tests-common-display-message nil 'notice
+ (current-buffer) "one two three")
+ (erc-tests-common-display-message nil 'notice
+ (current-buffer) "four five six")
(erc-fill-tests--insert-privmsg "bob" "Somebody stop me")
(erc-fill-tests--compare "spacing-01-mono")))))
@@ -450,4 +446,34 @@
rear-nonsticky t
font-lock-face erc-prompt-face))))))))))
+(ert-deftest erc-fill--wrap-massage-legacy-indicator-type ()
+ (let (calls
+ erc-fill-wrap-merge-indicator)
+ (cl-letf (((symbol-function 'erc--warn-once-before-connect)
+ (lambda (_ &rest args) (push args calls))))
+ ;; List of (pre CHAR FACE) becomes (CHAR . FACE).
+ (let ((erc-fill-wrap-merge-indicator
+ '(pre #xb7 erc-fill-wrap-merge-indicator-face)))
+ (erc-fill--wrap-massage-legacy-indicator-type)
+ (should (equal erc-fill-wrap-merge-indicator
+ '(#xb7 . erc-fill-wrap-merge-indicator-face)))
+ (should (string-search "(pre CHAR FACE)" (nth 1 (pop calls)))))
+
+ ;; Cons of (CHAR . STRING) becomes STRING.
+ (let ((erc-fill-wrap-merge-indicator '(pre . "\u00b7")))
+ (erc-fill--wrap-massage-legacy-indicator-type)
+ (should (equal erc-fill-wrap-merge-indicator "\u00b7"))
+ (should (string-search "(pre . STRING)" (nth 1 (pop calls)))))
+
+ ;; Anything with a CAR of `post' becomes nil.
+ (let ((erc-fill-wrap-merge-indicator
+ '(post #xb6 erc-fill-wrap-merge-indicator-face)))
+ (erc-fill--wrap-massage-legacy-indicator-type)
+ (should-not erc-fill-wrap-merge-indicator)
+ (should (string-search "no longer available" (nth 1 (pop calls)))))
+ (let ((erc-fill-wrap-merge-indicator '(post . "\u00b7")))
+ (erc-fill--wrap-massage-legacy-indicator-type)
+ (should-not erc-fill-wrap-merge-indicator)
+ (should (string-search "no longer available" (nth 1 (pop calls))))))))
+
;;; erc-fill-tests.el ends here
diff --git a/test/lisp/erc/erc-networks-tests.el
b/test/lisp/erc/erc-networks-tests.el
index 0d8861f2167..90d6f13f2f6 100644
--- a/test/lisp/erc/erc-networks-tests.el
+++ b/test/lisp/erc/erc-networks-tests.el
@@ -1243,6 +1243,7 @@
(with-current-buffer (get-buffer-create "irc.foonet.org")
(erc-mode)
+ (erc--initialize-markers (point) nil)
(setq erc-network 'FooNet
erc-server-current-nick "tester"
erc-server-process (erc-networks-tests--create-live-proc)
@@ -1282,6 +1283,7 @@
(ert-info ("New buffer steals name, content")
(with-current-buffer (get-buffer-create "irc.foonet.org")
(erc-mode)
+ (erc--initialize-markers (point) nil)
(setq erc-network 'FooNet
erc-server-current-nick "tester"
erc-server-process (erc-networks-tests--create-live-proc)
@@ -1522,6 +1524,7 @@
(ert-info ("New server buffer steals name, content")
(with-current-buffer (get-buffer-create "irc.foonet.org")
(erc-mode)
+ (erc--initialize-markers (point) nil)
(setq erc-network 'FooNet
erc-server-current-nick "tester"
erc-server-announced-name "us-east.foonet.org"
@@ -1574,6 +1577,7 @@
(ert-info ("New server buffer steals name, content")
(with-current-buffer (get-buffer-create "irc.foonet.org")
(erc-mode)
+ (erc--initialize-markers (point) nil)
(setq erc-network 'FooNet
erc-server-current-nick "tester"
erc-server-announced-name "us-east.foonet.org" ; east
diff --git a/test/lisp/erc/erc-scenarios-base-association-nick.el
b/test/lisp/erc/erc-scenarios-base-association-nick.el
index 57e8abda73c..c4601f3771f 100644
--- a/test/lisp/erc/erc-scenarios-base-association-nick.el
+++ b/test/lisp/erc/erc-scenarios-base-association-nick.el
@@ -28,22 +28,22 @@
;; You register a new nick in a dedicated query buffer, disconnect,
;; and log back in, but your nick is not granted (maybe you just
-;; turned off SASL). In any case, ERC obtains a backtick'd version.
+;; turned off SASL). In any case, ERC obtains a backticked version.
;; You open a query buffer for NickServ, and ERC gives you the
;; existing one. And after you identify, all buffers retain their
;; names, although your net ID has changed internally.
;;
-;; If ERC would've instead failed (or intentionally refused) to make
-;; the association, you would've ended up with a new NickServ buffer
-;; named after the new net ID as a suffix (based on the backtick'd
-;; nick), for example, NickServ@foonet/tester`. And the original
-;; (disconnected) NickServ buffer would've gotten suffixed with *its*
-;; net-ID as well, e.g., NickServ@foonet/tester. And after
-;; identifying, you would've seen ERC merge the two as well as their
-;; server buffers. While this alternate behavior may arguably be a
-;; more honest reflection of reality, it's also quite inconvenient.
-;; For a clearer example, see the original version of this file
-;; introduced by "Add user-oriented test scenarios for ERC".
+;; If ERC had instead failed (or intentionally refused) to make the
+;; association, you would find yourself with a new NickServ buffer
+;; named with a suffix reflecting the new net ID (based on the
+;; backticked nick), for example, NickServ@foonet/tester`. And the
+;; original (disconnected) NickServ buffer would also receive a suffix
+;; with *its* net-ID, e.g., NickServ@foonet/tester. Upon identifying
+;; yourself, you'd see ERC merge both buffers along with their server
+;; buffers. While this alternate behavior might more accurately
+;; reflect reality, it introduces significant inconvenience. For a
+;; clearer example, see the original version of this file introduced
+;; by "Add user-oriented test scenarios for ERC".
(ert-deftest erc-scenarios-base-association-nick-bumped ()
:tags '(:expensive-test)
diff --git a/test/lisp/erc/erc-scenarios-base-kill-on-part.el
b/test/lisp/erc/erc-scenarios-base-kill-on-part.el
new file mode 100644
index 00000000000..0ca0b1ae054
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-kill-on-part.el
@@ -0,0 +1,95 @@
+;;; erc-scenarios-base-kill-on-part.el --- killing buffers on part -*-
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-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+;; Assert channel buffer is killed when `erc-kill-buffer-on-part' is
+;; enabled and a user issues a /part. Also assert that code in
+;; `erc-kill-channel-hook' can detect when `erc-response-PART' is
+;; killing a buffer on behalf of that option.
+(ert-deftest erc-scenarios-base-kill-on-part--enabled ()
+ :tags '(:expensive-test)
+ (should-not erc-kill-buffer-on-part)
+
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/reuse-buffers/channel")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'foonet))
+ (port (process-contact dumb-server :service))
+ (erc-kill-buffer-on-part t)
+ (calls nil)
+ (erc-part-hook (lambda (b) (push (buffer-name b) calls)))
+ (erc-kill-channel-hook
+ (cons (lambda () (push erc-killing-buffer-on-part-p calls))
+ erc-kill-channel-hook))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to foonet")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :password "foonet:changeme"
+ :full-name "tester")
+ (funcall expect 10 "This server is in debug mode")))
+
+ (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#chan"))
+ (funcall expect 10 "<alice> bob: Whilst I can shake")
+ (erc-scenarios-common-say "/part"))
+
+ (erc-d-t-wait-for 20 (null (get-buffer "#chan")))
+ (should (equal calls '(t "#chan")))))
+
+;; When `erc-kill-buffer-on-part' is non-nil, and the parted buffer has
+;; already been killed, don't kill the server buffer. Bug#70840
+(ert-deftest erc-scenarios-base-kill-on-part--enabled/killed ()
+ :tags '(:expensive-test)
+ (should-not erc-kill-buffer-on-part)
+
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/reuse-buffers/channel")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'foonet))
+ (port (process-contact dumb-server :service))
+ (erc-kill-buffer-on-part t)
+ (calls nil)
+ (erc-part-hook (lambda (b) (push b calls)))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to foonet")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :password "foonet:changeme"
+ :full-name "tester")
+ (funcall expect 10 "This server is in debug mode")))
+
+ (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#chan"))
+ (funcall expect 10 "<alice> bob: Whilst I can shake")
+ (kill-buffer))
+
+ (erc-d-t-wait-for 20 (null (get-buffer "#chan")))
+ (erc-d-t-wait-for 10 (equal calls '(nil)))
+ (erc-d-t-ensure-for 0.1 (get-buffer "foonet"))))
+
+;;; erc-scenarios-base-kill-on-part.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-renick.el
b/test/lisp/erc/erc-scenarios-base-renick.el
index e0fcb8b9366..3001fde6da0 100644
--- a/test/lisp/erc/erc-scenarios-base-renick.el
+++ b/test/lisp/erc/erc-scenarios-base-renick.el
@@ -177,7 +177,7 @@
(ert-info ("Joined by bouncer to #foo, pal persent")
(with-current-buffer (erc-d-t-wait-for 1 (get-buffer "#foo"))
- (erc-d-t-search-for 1 "On Thursday")
+ (erc-d-t-search-for 5 "On Thursday")
(erc-scenarios-common-say "hi")))
(erc-d-t-wait-for 10 "Query buffer appears with message from pal"
@@ -253,7 +253,7 @@
(ert-info ("Joined by bouncer to #chan@barnet, pal persent")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan@barnet"))
(funcall expect 1 "rando")
- (funcall expect 2 "come, sir, I am")))
+ (funcall expect 5 "come, sir, I am")))
(ert-info ("Query buffer exists for rando@foonet")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "rando@foonet"))
diff --git a/test/lisp/erc/erc-scenarios-ignore.el
b/test/lisp/erc/erc-scenarios-ignore.el
index 1142bbef14d..55be613b51b 100644
--- a/test/lisp/erc/erc-scenarios-ignore.el
+++ b/test/lisp/erc/erc-scenarios-ignore.el
@@ -62,8 +62,8 @@
(funcall expect 10 "ignoring alice for 1m0s")
(funcall expect 10 "<bob> alice: Signior Iachimo")
(erc-scenarios-common-say "/ignore")
- (funcall expect 10 "alice 59s")
- (funcall expect 10 "mike 59m59s")
+ (funcall expect 20 '(: "alice 5" (any "0-9") "s"))
+ (funcall expect 10 '(: "mike 59m5" (any "0-9") "s"))
(funcall expect -0.1 "<alice>")
(funcall expect 10 "<bob> alice: The ground is bloody")
(erc-scenarios-common-say "/unignore alice")
diff --git a/test/lisp/erc/erc-scenarios-match.el
b/test/lisp/erc/erc-scenarios-match.el
index 22e34a8efe8..8600af800f1 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -71,7 +71,8 @@
;;
(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep)
(unless noninteractive
- (kill-new "erc-match-toggle-hidden-fools"))
+ (push "erc-match-toggle-hidden-fools" extended-command-history)
+ (push "erc-toggle-timestamps" extended-command-history))
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "join/legacy")
diff --git a/test/lisp/erc/erc-scenarios-misc.el
b/test/lisp/erc/erc-scenarios-misc.el
index 2afa1ce67a4..4cb5e65b15a 100644
--- a/test/lisp/erc/erc-scenarios-misc.el
+++ b/test/lisp/erc/erc-scenarios-misc.el
@@ -49,7 +49,7 @@
(ert-info ("#chan@foonet exists")
(with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan/foonet"))
- (erc-d-t-search-for 2 "<bob/foonet>")
+ (erc-d-t-search-for 10 "<bob/foonet>")
(erc-d-t-absent-for 0.1 "<joe")
(funcall expect 3 "was created on")))
@@ -58,7 +58,7 @@
(erc-d-t-search-for 2 "<joe/barnet>")
(erc-d-t-absent-for 0.1 "<bob")
(funcall expect 3 "was created on")
- (funcall expect 5 "To get good guard")))
+ (funcall expect 10 "To get good guard")))
(ert-info ("Message not held in queue limbo")
(with-current-buffer "#chan/foonet"
diff --git a/test/lisp/erc/erc-scenarios-stamp.el
b/test/lisp/erc/erc-scenarios-stamp.el
index 3a10f709548..6f2fbc1b7e9 100644
--- a/test/lisp/erc/erc-scenarios-stamp.el
+++ b/test/lisp/erc/erc-scenarios-stamp.el
@@ -101,17 +101,19 @@
:port port
:full-name "tester"
:nick "tester")
- (funcall expect 5 "Opening connection")
+ (funcall expect 5 "*** Welcome")
(goto-char (1- (match-beginning 0)))
(should (eq 'erc-timestamp (field-at-pos (point))))
- (should (eq 'unknown (erc--get-inserted-msg-prop 'erc--msg)))
+ (should (eq 'notice (erc--get-inserted-msg-prop 'erc--msg)))
;; Force redraw of date stamp.
(setq erc-timestamp-last-inserted-left nil)
(funcall expect 5 "This server is in debug mode")
(while (and (zerop (forward-line -1))
(not (eq 'erc-timestamp (field-at-pos (point))))))
- (should (erc--get-inserted-msg-prop 'erc--cmd)))))))
+ (should (erc--get-inserted-msg-prop 'erc--cmd))
+ (should-not erc-stamp--date-mode)
+ (should-not erc-stamp--date-stamps))))))
;; This user-owned hook member places a marker on the first message in
;; a buffer. Inserting a date stamp in front of it shouldn't move the
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 5fee21ec28f..61f03685e5d 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -349,4 +349,122 @@
(lambda (arg)
(should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg))))))
+(ert-deftest erc-stamp--dedupe-date-stamps-from-target-buffer ()
+ (unless (>= emacs-major-version 29)
+ (ert-skip "Requires hz-ticks lisp time format"))
+ (let ((erc-modules erc-modules)
+ (erc-stamp--tz t))
+ (erc-tests-common-make-server-buf)
+ (erc-stamp-mode +1)
+
+ ;; Create two buffers with an overlapping date stamp.
+ (with-current-buffer (erc--open-target "#chan@old")
+ (let ((erc-stamp--current-time '(1690761600001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer)
+ "2023-07-31T00:00:00.001Z"))
+ (let ((erc-stamp--current-time '(1690761601001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer) "0.0"))
+
+ (let ((erc-stamp--current-time '(1690848000001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer)
+ "2023-08-01T00:00:00.001Z"))
+ (let ((erc-stamp--current-time '(1690848001001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer) "1.0"))
+ (let ((erc-stamp--current-time '(1690848060001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer) "1.1"))
+
+ (let ((erc-stamp--current-time '(1690934400001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer)
+ "2023-08-02T00:00:00.001Z"))
+ (let ((erc-stamp--current-time '(1690934401001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer) "2.0"))
+ (let ((erc-stamp--current-time '(1690956000001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer) "2.6")))
+
+ (with-current-buffer (erc--open-target "#chan@new")
+ (let ((erc-stamp--current-time '(1690956001001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer)
+ "2023-08-02T06:00:01.001Z"))
+ (let ((erc-stamp--current-time '(1690963200001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer) "2.8"))
+
+ (let ((erc-stamp--current-time '(1691020800001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer)
+ "2023-08-03T00:00:00.001Z"))
+ (let ((erc-stamp--current-time '(1691020801001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer) "3.0"))
+ (let ((erc-stamp--current-time '(1691053200001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer) "3.9"))
+
+ (let ((erc-stamp--current-time '(1691107200001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer)
+ "2023-08-04T00:00:00.001Z"))
+ (let ((erc-stamp--current-time '(1691107201001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer) "4.0"))
+ (let ((erc-stamp--current-time '(1691110800001 . 1000)))
+ (erc-tests-common-display-message nil 'notice (current-buffer) "4.1")))
+
+ (erc-stamp--dedupe-date-stamps-from-target-buffer
+ #'erc-networks--transplant-buffer-content
+ (get-buffer "#chan@old")
+ (get-buffer "#chan@new"))
+
+ ;; Ensure the "model", `erc-stamp--date-stamps', matches reality
+ ;; in the buffer's contents.
+ (with-current-buffer "#chan@new"
+ (let ((stamps erc-stamp--date-stamps))
+ (goto-char 3)
+ (should (looking-at (rx "\n[Mon Jul 31 2023]")))
+ (should (= (erc--get-inserted-msg-beg (point))
+ (erc-stamp--date-marker (pop stamps))))
+ (goto-char (1+ (match-end 0)))
+ (should (looking-at (rx "*** 2023-07-31T00:00:00.001Z")))
+ (forward-line 1)
+ (should (looking-at (rx "*** 0.0")))
+ (forward-line 1)
+
+ (should (looking-at (rx "\n[Tue Aug 1 2023]")))
+ (should (= (erc--get-inserted-msg-beg (point))
+ (erc-stamp--date-marker (pop stamps))))
+ (goto-char (1+ (match-end 0)))
+ (should (looking-at (rx "*** 2023-08-01T00:00:00.001Z")))
+ (forward-line 1)
+ (should (looking-at (rx "*** 1.0")))
+ (forward-line 1)
+ (should (looking-at (rx "*** 1.1")))
+ (forward-line 1)
+
+ (should (looking-at (rx "\n[Wed Aug 2 2023]")))
+ (should (= (erc--get-inserted-msg-beg (point))
+ (erc-stamp--date-marker (pop stamps))))
+ (goto-char (1+ (match-end 0)))
+ (should (looking-at (rx "*** 2023-08-02T00:00:00.001Z")))
+ (forward-line 1)
+ (should (looking-at (rx "*** 2.0")))
+ (forward-line 1)
+ (should (looking-at (rx "*** 2.6")))
+ (forward-line 1)
+ (should (looking-at
+ (rx "*** Grafting buffer `#chan@new' onto `#chan@old'")))
+ (forward-line 1)
+ (should (looking-at (rx "*** 2023-08-02T06:00:01.001Z")))
+ (forward-line 1)
+ (should (looking-at (rx "*** 2.8")))
+ (forward-line 1)
+
+ (should (looking-at (rx "\n[Thu Aug 3 2023]")))
+ (should (= (erc--get-inserted-msg-beg (point))
+ (erc-stamp--date-marker (pop stamps))))
+ (goto-char (1+ (match-end 0)))
+ (should (looking-at (rx "*** 2023-08-03T00:00:00.001Z")))
+ (forward-line 3) ; ...
+
+ (should (looking-at (rx "\n[Fri Aug 4 2023]")))
+ (should (= (erc--get-inserted-msg-beg (point))
+ (erc-stamp--date-marker (pop stamps))))
+ (should-not stamps))))
+
+ (when noninteractive
+ (erc-tests-common-kill-buffers)))
+
;;; erc-stamp-tests.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 22432a68034..999d9f100c9 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1227,6 +1227,35 @@
(erc-tests-common-kill-buffers))
+(ert-deftest erc-query-buffer-p ()
+ ;; Nil in a non-ERC buffer.
+ (should-not (erc-query-buffer-p))
+ (should-not (erc-query-buffer-p (current-buffer)))
+ (should-not (erc-query-buffer-p (buffer-name)))
+
+ (erc-tests-common-make-server-buf)
+ ;; Nil in a server buffer.
+ (should-not (erc-query-buffer-p))
+ (should-not (erc-query-buffer-p (current-buffer)))
+ (should-not (erc-query-buffer-p (buffer-name)))
+
+ ;; Nil in a channel buffer.
+ (with-current-buffer (erc--open-target "#chan")
+ (should-not (erc-query-buffer-p))
+ (should-not (erc-query-buffer-p (current-buffer)))
+ (should-not (erc-query-buffer-p (buffer-name))))
+
+ ;; Non-nil in a query buffer.
+ (with-current-buffer (erc--open-target "alice")
+ (should (erc-query-buffer-p))
+ (should (erc-query-buffer-p (current-buffer)))
+ (should (erc-query-buffer-p (buffer-name))))
+
+ (should (erc-query-buffer-p (get-buffer "alice")))
+ (should (erc-query-buffer-p "alice"))
+
+ (erc-tests-common-kill-buffers))
+
(ert-deftest erc--valid-local-channel-p ()
(ert-info ("Local channels not supported")
(let ((erc--isupport-params (make-hash-table)))
@@ -1927,7 +1956,48 @@
(lambda (arg)
(should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg))))))
-(ert-deftest erc--delete-inserted-message ()
+(ert-deftest erc--insert-before-markers-transplanting-hidden ()
+ (with-current-buffer (get-buffer-create "*erc-test*")
+ (erc-mode)
+ (erc-tests-common-prep-for-insertion)
+
+ ;; Create a message that has a foreign invisibility property on
+ ;; its trailing newline that's not claimed by the next message.
+ (let ((erc-insert-post-hook
+ (lambda ()
+ (put-text-property (point-min) (point-max) 'invisible 'b))))
+ (erc-display-message nil 'notice (current-buffer) "before"))
+ (should (eq 'b (get-text-property (1- erc-insert-marker) 'invisible)))
+
+ ;; Insert a message that's hidden with `erc--hide-message'. It
+ ;; advertises `invisible' value `a', applied on the trailing
+ ;; newline of the previous message.
+ (let ((erc-insert-post-hook (lambda () (erc--hide-message 'a))))
+ (erc-display-message nil 'notice (current-buffer) "after"))
+
+ (goto-char (point-min))
+ (should (search-forward "*** before\n" nil t))
+ (should (equal '(a b) (get-text-property (1- (point)) 'invisible)))
+
+ ;; Splice in a new message.
+ (let ((erc--insert-line-function
+ #'erc--insert-before-markers-transplanting-hidden)
+ (erc--insert-marker (copy-marker (point))))
+ (goto-char (point-max))
+ (erc-display-message nil 'notice (current-buffer) "middle"))
+
+ (goto-char (point-min))
+ (should (search-forward "*** before\n" nil t))
+ (should (eq 'b (get-text-property (1- (point)) 'invisible)))
+ (should (looking-at (rx "*** middle\n")))
+ (should (eq 'a (get-text-property (pos-eol) 'invisible)))
+ (forward-line)
+ (should (looking-at (rx "*** after\n")))
+
+ (setq buffer-invisibility-spec nil)
+ (when noninteractive (kill-buffer))))
+
+(ert-deftest erc--delete-inserted-message-naively ()
(erc-mode)
(erc--initialize-markers (point) nil)
;; Put unique invisible properties on the line endings.
@@ -1945,7 +2015,7 @@
(should (eq 'datestamp (get-text-property (point) 'erc--msg)))
(should (eq (point) (field-beginning (1+ (point)))))
- (erc--delete-inserted-message (point))
+ (erc--delete-inserted-message-naively (point))
;; Preceding line ending clobbered, replaced by trailing.
(should (looking-back (rx "*** one\n")))
@@ -1961,7 +2031,7 @@
(p (point)))
(set-marker-insertion-type m t)
(goto-char (point-max))
- (erc--delete-inserted-message p)
+ (erc--delete-inserted-message-naively p)
(should (= (marker-position n) p))
(should (= (marker-position m) p))
(goto-char p)
@@ -1975,7 +2045,7 @@
(should (looking-at (rx "*** three\n")))
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
(let ((erc-legacy-invisible-bounds-p t))
- (erc--delete-inserted-message (point))))
+ (erc--delete-inserted-message-naively (point))))
(should (looking-at (rx "*** four\n"))))
(ert-info ("Deleting most recent message preserves markers")
@@ -1985,7 +2055,7 @@
(should (equal "*** four\n" (buffer-substring p erc-insert-marker)))
(set-marker-insertion-type m t)
(goto-char (point-max))
- (erc--delete-inserted-message p)
+ (erc--delete-inserted-message-naively p)
(should (= (marker-position m) p))
(should (= (marker-position n) p))
(goto-char p)
@@ -2041,6 +2111,13 @@
(let ((v '(42 y)))
(should-not (erc--check-msg-prop 'b v)))))
+(ert-deftest erc--memq-msg-prop ()
+ (let ((erc--msg-props (map-into '((a . 1) (b x y)) 'hash-table)))
+ (should-not (erc--memq-msg-prop 'a 1))
+ (should-not (erc--memq-msg-prop 'b 'z))
+ (should (erc--memq-msg-prop 'b 'x))
+ (should (erc--memq-msg-prop 'b 'y))))
+
(ert-deftest erc--merge-prop ()
(with-current-buffer (get-buffer-create "*erc-test*")
;; Baseline.
diff --git a/test/lisp/erc/resources/base/assoc/bouncer-history/barnet.eld
b/test/lisp/erc/resources/base/assoc/bouncer-history/barnet.eld
index 060f4178723..5e7ac8afb41 100644
--- a/test/lisp/erc/resources/base/assoc/bouncer-history/barnet.eld
+++ b/test/lisp/erc/resources/base/assoc/bouncer-history/barnet.eld
@@ -1,5 +1,5 @@
;; -*- mode: lisp-data; -*-
-((pass 3 "PASS :barnet:changeme"))
+((pass 10 "PASS :barnet:changeme"))
((nick 1 "NICK tester"))
((user 1 "USER user 0 * :tester")
(0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
diff --git a/test/lisp/erc/resources/base/auth-source/foonet.eld
b/test/lisp/erc/resources/base/auth-source/foonet.eld
index 1fe772c7e23..31ddccbdaee 100644
--- a/test/lisp/erc/resources/base/auth-source/foonet.eld
+++ b/test/lisp/erc/resources/base/auth-source/foonet.eld
@@ -1,5 +1,5 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
+((pass 10 "PASS :changeme"))
((nick 1 "NICK tester"))
((user 1 "USER user 0 * :tester")
(0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
diff --git a/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld
b/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld
index d106a45cf66..17f3cfd72b1 100644
--- a/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld
+++ b/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld
@@ -34,7 +34,7 @@
(0 ":irc.barnet.org NOTICE tester :[09:05:35] 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 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-((mode 3 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620205534")
(0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: That will be given to
the loudest noise we make.")
diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el
b/test/lisp/erc/resources/erc-d/erc-d-tests.el
index 78f87399afb..dd0d5f8cb87 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-tests.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el
@@ -367,8 +367,6 @@
(should (equal (funcall it) "foo3foo")))
(ert-info ("Exits clean")
- (when (listp (alist-get 'f (erc-d-dialog-vars dialog))) ; may be compiled
- (should (eq 'closure (car (alist-get 'f (erc-d-dialog-vars dialog))))))
(should-not (funcall it))
(should (equal (erc-d-dialog-vars dialog)
`((:a . 1)
@@ -646,7 +644,7 @@ nonzero for this to work."
(ert-deftest erc-d-run-basic ()
:tags '(:expensive-test)
(erc-d-tests-with-server (_ _) basic
- (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan"))
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
(erc-d-t-search-for 2 "hey"))
(when noninteractive
(kill-buffer "#chan"))))
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el
b/test/lisp/erc/resources/erc-scenarios-common.el
index 9ad5ce49429..c7d5c9d6677 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -194,6 +194,7 @@ Dialog resource directories are located by expanding the
variable
(ert-info ("Running extra teardown")
(funcall erc-scenarios-common-extra-teardown)))
+ (erc-buffer-do #'erc-scenarios-common--assert-date-stamps)
(when (and (boundp 'erc-autojoin-mode)
(not (eq erc-autojoin-mode ,orig-autojoin-mode)))
(erc-autojoin-mode (if ,orig-autojoin-mode +1 -1)))
@@ -325,6 +326,12 @@ See Info node `(emacs) Term Mode' for the various
commands."
erc-scenarios-common-interactive-debug-term-p))
(erc-scenarios-common-with-cleanup ,@body)))
+(defun erc-scenarios-common--assert-date-stamps ()
+ "Ensure all date stamps are accounted for."
+ (dolist (stamp erc-stamp--date-stamps)
+ (should (eq 'datestamp (get-text-property (erc-stamp--date-marker stamp)
+ 'erc--msg)))))
+
(defun erc-scenarios-common-assert-initial-buf-name (id port)
;; Assert no limbo period when explicit ID given
(should (string= (if id
diff --git a/test/lisp/erc/resources/erc-tests-common.el
b/test/lisp/erc/resources/erc-tests-common.el
index 99f15b89b03..2ec32db77cd 100644
--- a/test/lisp/erc/resources/erc-tests-common.el
+++ b/test/lisp/erc/resources/erc-tests-common.el
@@ -39,7 +39,7 @@
;;; Code:
(require 'ert-x)
(require 'erc)
-
+(eval-when-compile (require 'erc-stamp))
(defmacro erc-tests-common-equal-with-props (a b)
"Compare strings A and B for equality including text props.
@@ -196,6 +196,25 @@ For simplicity, assume string evaluates to itself."
(erc-readonly-mode +1)
(funcall assert-fn test-fn)))
+(defun erc-tests--common-display-message (orig &rest args)
+ (require 'erc-stamp)
+ (defvar erc-stamp--deferred-date-stamp)
+ (let (erc-stamp--deferred-date-stamp)
+ (prog1 (apply orig args)
+ (when-let ((inst erc-stamp--deferred-date-stamp)
+ (fn (erc-stamp--date-fn inst)))
+ (funcall fn)))))
+
+(defun erc-tests-common-display-message (&rest args)
+ (apply #'erc-tests--common-display-message #'erc-display-message args))
+
+(defmacro erc-tests-common-with-date-aware-display-message (&rest body)
+ `(progn
+ (advice-add 'erc-display-message
+ :around #'erc-tests--common-display-message)
+ (unwind-protect (progn ,@body)
+ (advice-remove 'erc-display-message
+ #'erc-tests--common-display-message))))
;;;; Buffer snapshots
@@ -223,12 +242,19 @@ string."
(print-escape-nonascii t)
(got (erc--remove-text-properties
(buffer-substring (point-min) erc-insert-marker)))
- (repr (funcall (or trans-fn #'identity) (prin1-to-string got))))
+ (repr (funcall (or trans-fn #'identity) (prin1-to-string got)))
+ (xstr (read (with-temp-buffer
+ (insert-file-contents-literally expect-file)
+ (buffer-string)))))
(with-current-buffer (generate-new-buffer name)
(with-silent-modifications
(insert (setq got (read repr))))
(when buf-init-fn (funcall buf-init-fn))
(erc-mode))
+ (unless noninteractive
+ (with-current-buffer (generate-new-buffer (format "%s-xpt" name))
+ (insert xstr)
+ (erc-mode)))
;; LHS is a string, RHS is a symbol.
(if (string= erc-tests-common-snapshot-save-p
(ert-test-name (ert-running-test)))
@@ -242,9 +268,7 @@ string."
;; recursive (signals `max-lisp-eval-depth' exceeded).
(named-let assert-equal
((latest (read repr))
- (expect (read (with-temp-buffer
- (insert-file-contents-literally expect-file)
- (buffer-string)))))
+ (expect xstr))
(pcase latest
((or "" 'nil) t)
((pred stringp)
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 6ff7af218c0..166ed59e292 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<al [...]
\ 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<al [...]
\ 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 7d9822c80bc..8b502373807 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<al [...]
\ 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<al [...]
\ 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 2d0e5a5965f..9744e659813 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<bo [...]
\ 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<bo [...]
\ 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
deleted file mode 100644
index e019e60bb26..00000000000
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
+++ /dev/null
@@ -1 +0,0 @@
-#("\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<bo [...]
\ 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 615de982b1e..36729b890be 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<bo [...]
\ 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<bo [...]
\ 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 ae364accdea..5405ca2a7dc 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 t [...]
\ 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 t [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/join/auth-source/foonet.eld
b/test/lisp/erc/resources/join/auth-source/foonet.eld
index 32b9e3fa0b6..60dff350654 100644
--- a/test/lisp/erc/resources/join/auth-source/foonet.eld
+++ b/test/lisp/erc/resources/join/auth-source/foonet.eld
@@ -26,7 +26,7 @@
((join 6.47 "JOIN #spam secret")
(0.03 ":dummy!~u@w9rfqveugz722.irc JOIN #spam"))
-((mode 1 "MODE #spam")
+((mode-spam 10 "MODE #spam")
(0.01 ":irc.foonet.org 353 dummy = #spam :~tester dummy")
(0.00 ":irc.foonet.org 366 dummy #spam :End of NAMES list")
(0.01 ":irc.foonet.org 324 dummy #spam +knt secret")
diff --git a/test/lisp/erc/resources/sasl/external.eld
b/test/lisp/erc/resources/sasl/external.eld
index 2cd237ec4d4..c3e51a8cd6f 100644
--- a/test/lisp/erc/resources/sasl/external.eld
+++ b/test/lisp/erc/resources/sasl/external.eld
@@ -28,6 +28,6 @@
(0.21 ":irc.example.org 266 tester 1 1 :Current global users 1, max 1")
(0.0 ":irc.example.org 422 tester :MOTD File is missing"))
-((mode-user 1.2 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
(0.0 ":irc.example.org 221 tester +Zi")
(0.0 ":irc.example.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."))
diff --git a/test/lisp/erc/resources/sasl/plain.eld
b/test/lisp/erc/resources/sasl/plain.eld
index 1341cd78e5e..aa5f3e80feb 100644
--- a/test/lisp/erc/resources/sasl/plain.eld
+++ b/test/lisp/erc/resources/sasl/plain.eld
@@ -30,7 +30,7 @@
(0.21 ":irc.example.org 266 tester 1 1 :Current global users 1, max 1")
(0.0 ":irc.example.org 422 tester :MOTD File is missing"))
-((mode-user 1.2 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
(0.0 ":irc.example.org 221 tester +Zi")
(0.0 ":irc.example.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."))
diff --git a/test/lisp/eshell/em-glob-tests.el
b/test/lisp/eshell/em-glob-tests.el
index fc460a59eed..2efb3a9df69 100644
--- a/test/lisp/eshell/em-glob-tests.el
+++ b/test/lisp/eshell/em-glob-tests.el
@@ -23,6 +23,7 @@
;;; Code:
+(require 'tramp)
(require 'ert)
(require 'em-glob)
@@ -71,9 +72,9 @@ component ending in \"symlink\" is treated as a symbolic
link."
(eshell-glob-splice-results t))
(with-fake-files '("a.el" "b.el" "c.txt")
;; Ensure the default expansion splices the glob.
- (eshell-command-result-equal "list *.el" '("a.el" "b.el"))
- (eshell-command-result-equal "list *.txt" '("c.txt"))
- (eshell-command-result-equal "list *.no" '("*.no")))))
+ (eshell-command-result-equal "funcall list *.el" '("a.el" "b.el"))
+ (eshell-command-result-equal "funcall list *.txt" '("c.txt"))
+ (eshell-command-result-equal "funcall list *.no" '("*.no")))))
(ert-deftest em-glob-test/expand/no-splice-results ()
"Test that globs are treated as lists when
@@ -82,11 +83,11 @@ component ending in \"symlink\" is treated as a symbolic
link."
(eshell-glob-splice-results nil))
(with-fake-files '("a.el" "b.el" "c.txt")
;; Ensure the default expansion splices the glob.
- (eshell-command-result-equal "list *.el" '(("a.el" "b.el")))
- (eshell-command-result-equal "list *.txt" '(("c.txt")))
+ (eshell-command-result-equal "funcall list *.el" '(("a.el" "b.el")))
+ (eshell-command-result-equal "funcall list *.txt" '(("c.txt")))
;; The no-matches case is special here: the glob is just the
;; string, not the list of results.
- (eshell-command-result-equal "list *.no" '("*.no")))))
+ (eshell-command-result-equal "funcall list *.no" '("*.no")))))
(ert-deftest em-glob-test/expand/explicitly-splice-results ()
"Test explicitly splicing globs works the same no matter the
@@ -96,11 +97,11 @@ value of `eshell-glob-splice-results'."
(ert-info ((format "eshell-glob-splice-results: %s"
eshell-glob-splice-results))
(with-fake-files '("a.el" "b.el" "c.txt")
- (eshell-command-result-equal "list $@{listify *.el}"
+ (eshell-command-result-equal "funcall list $@{listify *.el}"
'("a.el" "b.el"))
- (eshell-command-result-equal "list $@{listify *.txt}"
+ (eshell-command-result-equal "funcall list $@{listify *.txt}"
'("c.txt"))
- (eshell-command-result-equal "list $@{listify *.no}"
+ (eshell-command-result-equal "funcall list $@{listify *.no}"
'("*.no")))))))
(ert-deftest em-glob-test/expand/explicitly-listify-results ()
@@ -111,11 +112,11 @@ value of `eshell-glob-splice-results'."
(ert-info ((format "eshell-glob-splice-results: %s"
eshell-glob-splice-results))
(with-fake-files '("a.el" "b.el" "c.txt")
- (eshell-command-result-equal "list ${listify *.el}"
+ (eshell-command-result-equal "funcall list ${listify *.el}"
'(("a.el" "b.el")))
- (eshell-command-result-equal "list ${listify *.txt}"
+ (eshell-command-result-equal "funcall list ${listify *.txt}"
'(("c.txt")))
- (eshell-command-result-equal "list ${listify *.no}"
+ (eshell-command-result-equal "funcall list ${listify *.no}"
'(("*.no"))))))))
@@ -138,9 +139,18 @@ value of `eshell-glob-splice-results'."
(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))))
+ (skip-unless (eshell-tests-remote-accessible-p))
+ (let* ((default-directory ert-remote-temporary-file-directory)
+ (remote (file-remote-p default-directory)))
+ (should (equal (eshell-glob-convert (format "%s/some/where/*.el" remote))
+ `(,(format "%s/some/where/" remote)
+ (("\\`.*\\.el\\'" . "\\`\\.")) nil)))))
+
+(ert-deftest em-glob-test/convert/quoted-start-directory ()
+ "Test converting a glob starting in a quoted directory name."
+ (should (equal (eshell-glob-convert
+ (concat (eshell-escape-arg "some where/") "*.el"))
+ '("./some where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil))))
;; Glob matching
@@ -288,4 +298,13 @@ value of `eshell-glob-splice-results'."
(let ((eshell-error-if-no-glob t))
(should-error (eshell-extended-glob "*.txt")))))
+(ert-deftest em-glob-test/remote-user-directory ()
+ "Test that remote directories using \"~\" pass through unchanged."
+ (skip-unless (eshell-tests-remote-accessible-p))
+ (let* ((default-directory ert-remote-temporary-file-directory)
+ (remote (file-remote-p default-directory))
+ (eshell-error-if-no-glob t))
+ (should (equal (eshell-extended-glob (format "%s~/file.txt" remote))
+ (format "%s~/file.txt" remote)))))
+
;; em-glob-tests.el ends here
diff --git a/test/lisp/eshell/em-hist-tests.el
b/test/lisp/eshell/em-hist-tests.el
index a4e1e01b124..40e6f90478d 100644
--- a/test/lisp/eshell/em-hist-tests.el
+++ b/test/lisp/eshell/em-hist-tests.el
@@ -163,6 +163,23 @@ elements against that; if t (the default), check against
EXPECTED."
(should (equal (ring-elements eshell-history-ring)
'("echo hi" "echo bye"))))))
+(ert-deftest em-hist-test/add-to-history/erase-existing-dups ()
+ "Test adding to history, erasing any old dups after switching to 'erase."
+ (let ((eshell-hist-ignoredups nil))
+ (with-temp-eshell
+ (eshell-insert-command "echo hi")
+ (eshell-insert-command "echo bye")
+ (eshell-insert-command "echo bye")
+ (eshell-insert-command "echo hi")
+ (eshell-insert-command "echo bye")
+ (setq eshell-hist-ignoredups 'erase)
+ (eshell-insert-command "echo hi")
+ (should (equal (ring-elements eshell-history-ring)
+ '("echo hi" "echo bye" "echo bye" "echo bye")))
+ (eshell-insert-command "echo bye")
+ (should (equal (ring-elements eshell-history-ring)
+ '("echo bye" "echo hi"))))))
+
(provide 'em-hist-test)
;;; em-hist-tests.el ends here
diff --git a/test/lisp/eshell/esh-cmd-tests.el
b/test/lisp/eshell/esh-cmd-tests.el
index ef965a896c1..d84f8802bdc 100644
--- a/test/lisp/eshell/esh-cmd-tests.el
+++ b/test/lisp/eshell/esh-cmd-tests.el
@@ -213,6 +213,18 @@ This should also wait for the subcommand."
(eshell-match-command-output "echo ${*echo hi | *cat} | *cat"
"hi")))
+(ert-deftest esh-cmd-test/pipeline-wait/nested-pipes ()
+ "Check that piping a subcommand with its own pipe works.
+This should also wait for the subcommand."
+ (skip-unless (and (executable-find "echo")
+ (executable-find "cat")
+ (executable-find "sh")
+ (executable-find "sleep")))
+ (with-temp-eshell
+ (eshell-match-command-output
+ "{ sh -c 'sleep 1; echo goodbye 1>&2' | *echo hello } | *cat"
+ "hello\ngoodbye\n")))
+
(ert-deftest esh-cmd-test/reset-in-pipeline/subcommand ()
"Check that subcommands reset `eshell-in-pipeline-p'."
(skip-unless (executable-find "cat"))
diff --git a/test/lisp/eshell/esh-ext-tests.el
b/test/lisp/eshell/esh-ext-tests.el
index 8abbd74f737..ce958d788cc 100644
--- a/test/lisp/eshell/esh-ext-tests.el
+++ b/test/lisp/eshell/esh-ext-tests.el
@@ -102,7 +102,7 @@
;; Check the value of $INSIDE_EMACS using `sh' in order to
;; delay variable expansion.
(eshell-match-command-output
- (format "/:%s -c 'echo $INSIDE_EMACS'" cmd)
+ (format "/local:%s -c 'echo $INSIDE_EMACS'" cmd)
"eshell\n"))))))
;; esh-ext-tests.el ends here
diff --git a/test/lisp/eshell/esh-var-tests.el
b/test/lisp/eshell/esh-var-tests.el
index b94e8a276d7..1b46b214e77 100644
--- a/test/lisp/eshell/esh-var-tests.el
+++ b/test/lisp/eshell/esh-var-tests.el
@@ -436,7 +436,7 @@ nil, use FUNCTION instead."
(ert-deftest esh-var-test/quoted-interp-lisp-indices ()
"Interpolate Lisp form evaluation with index."
- (eshell-command-result-equal "concat \"$(list 1 2)[1]\" cool"
+ (eshell-command-result-equal "funcall concat \"$(list 1 2)[1]\" cool"
"2cool"))
(ert-deftest esh-var-test/quoted-interp-cmd ()
@@ -446,7 +446,7 @@ nil, use FUNCTION instead."
(ert-deftest esh-var-test/quoted-interp-cmd-indices ()
"Interpolate command result with index inside double-quotes."
- (eshell-command-result-equal "concat \"${listify 1 2}[1]\" cool"
+ (eshell-command-result-equal "funcall concat \"${listify 1 2}[1]\" cool"
"2cool"))
(ert-deftest esh-var-test/quoted-interp-temp-cmd ()
@@ -504,9 +504,9 @@ nil, use FUNCTION instead."
(ert-deftest esh-var-test/interp-convert-quoted-var-number ()
"Interpolate numeric quoted numeric variable."
(let ((eshell-test-value 123))
- (eshell-command-result-equal "type-of $'eshell-test-value'"
+ (eshell-command-result-equal "funcall type-of $'eshell-test-value'"
'integer)
- (eshell-command-result-equal "type-of $\"eshell-test-value\""
+ (eshell-command-result-equal "funcall type-of $\"eshell-test-value\""
'integer)))
(ert-deftest esh-var-test/interp-convert-quoted-var-split-indices ()
@@ -546,7 +546,7 @@ nil, use FUNCTION instead."
(ert-deftest esh-var-test/quoted-interp-convert-var-number ()
"Interpolate numeric variable inside double-quotes."
(let ((eshell-test-value 123))
- (eshell-command-result-equal "type-of \"$eshell-test-value\""
+ (eshell-command-result-equal "funcall type-of \"$eshell-test-value\""
'string)))
(ert-deftest esh-var-test/quoted-interp-convert-var-split-indices ()
@@ -560,10 +560,11 @@ nil, use FUNCTION instead."
(ert-deftest esh-var-test/quoted-interp-convert-quoted-var-number ()
"Interpolate numeric quoted variable inside double-quotes."
(let ((eshell-test-value 123))
- (eshell-command-result-equal "type-of \"$'eshell-test-value'\""
+ (eshell-command-result-equal "funcall type-of \"$'eshell-test-value'\""
'string)
- (eshell-command-result-equal "type-of \"$\\\"eshell-test-value\\\"\""
- 'string)))
+ (eshell-command-result-equal
+ "funcall type-of \"$\\\"eshell-test-value\\\"\""
+ 'string)))
(ert-deftest esh-var-test/quoted-interp-convert-quoted-var-split-indices ()
"Interpolate quoted string variable with indices inside double-quotes."
@@ -905,11 +906,11 @@ the value of the $PAGER env var."
(ert-deftest esh-var-test/last-status-var-lisp-command ()
"Test using the \"last exit status\" ($?) variable with a Lisp command."
(with-temp-eshell
- (eshell-match-command-output "zerop 0; echo $?"
+ (eshell-match-command-output "funcall zerop 0; echo $?"
"t\n0\n")
- (eshell-match-command-output "zerop 1; echo $?"
+ (eshell-match-command-output "funcall zerop 1; echo $?"
"0\n")
- (eshell-match-command-output "zerop foo; echo $?"
+ (eshell-match-command-output "funcall zerop foo; echo $?"
"1\n" nil t)))
(ert-deftest esh-var-test/last-status-var-lisp-form ()
@@ -972,10 +973,10 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
"Test using the \"last result\" ($$) variable with split indices."
(with-temp-eshell
(eshell-match-command-output
- "string-join (list \"01\" \"02\") :; + $$[: 1] 3"
+ "funcall string-join (list \"01\" \"02\") :; + $$[: 1] 3"
"01:02\n5\n")
(eshell-match-command-output
- "string-join (list \"01\" \"02\") :; echo \"$$[: 1]\""
+ "funcall string-join (list \"01\" \"02\") :; echo \"$$[: 1]\""
"01:02\n02\n")))
(ert-deftest esh-var-test/last-arg-var ()
@@ -995,9 +996,11 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
(ert-deftest esh-var-test/last-arg-var-split-indices ()
"Test using the \"last arg\" ($_) variable with split indices."
(with-temp-eshell
- (eshell-match-command-output "concat 01:02 03:04; + $_[0][: 1] 5"
- "01:0203:04\n7\n")
- (eshell-match-command-output "concat 01:02 03:04; echo \"$_[0][: 1]\""
- "01:0203:04\n02\n")))
+ (eshell-match-command-output
+ "funcall concat 01:02 03:04; + $_[1][: 1] 5"
+ "01:0203:04\n7\n")
+ (eshell-match-command-output
+ "funcall concat 01:02 03:04; echo \"$_[1][: 1]\""
+ "01:0203:04\n02\n")))
;; esh-var-tests.el ends here
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index d4c1ef3ba67..ad54addf06b 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1196,18 +1196,21 @@ unquoted file names."
"emacs" (current-buffer)
(concat invocation-directory invocation-name)
"--version")))
- (accept-process-output proc)
- (goto-char (point-min))
- (should (search-forward emacs-version nil t))
- ;; Don't stop the test run with a query, as the subprocess
- ;; may or may not be dead by the time we reach here.
- (set-process-query-on-exit-flag proc nil)
- ;; On MS-Windows, wait for the process to die, since the OS
- ;; will not let us delete a directory that is the cwd of a
- ;; running process.
- (when (eq system-type 'windows-nt)
- (while (process-live-p proc)
- (sleep-for 0.1)))))))
+ (unwind-protect
+ (progn
+ (accept-process-output proc)
+ (goto-char (point-min))
+ (should (search-forward emacs-version nil t))
+ ;; Don't stop the test run with a query, as the subprocess
+ ;; may or may not be dead by the time we reach here.
+ (set-process-query-on-exit-flag proc nil)
+ ;; On MS-Windows, wait for the process to die, since the OS
+ ;; will not let us delete a directory that is the cwd of a
+ ;; running process.
+ (when (eq system-type 'windows-nt)
+ (while (process-live-p proc)
+ (sleep-for 0.1))))
+ (delete-process proc))))))
(files-tests--with-temp-non-special-and-file-name-handler
(tmpdir nospecial-dir t)
(with-temp-buffer
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index 1beeb77640c..82350a4bc71 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -63,14 +63,14 @@ Return first line of the output of (describe-function-1
FUNC)."
(should (string-match regexp result))))
(ert-deftest help-fns-test-lisp-defun ()
- (let ((regexp (if (featurep 'native-compile)
- "a subr-native-elisp in .+subr\\.el"
- "a compiled-function in .+subr\\.el"))
+ (let ((regexp "a \\([^ ]+\\) in .+subr\\.el")
(result (help-fns-tests--describe-function 'last)))
- (should (string-match regexp result))))
+ (should (string-match regexp result))
+ (should (member (match-string 1 result)
+ '("subr-native-elisp" "byte-code-function")))))
(ert-deftest help-fns-test-lisp-defsubst ()
- (let ((regexp "a compiled-function in .+subr\\.el")
+ (let ((regexp "a byte-code-function in .+subr\\.el")
(result (help-fns-tests--describe-function 'posn-window)))
(should (string-match regexp result))))
diff --git a/test/lisp/image/gravatar-tests.el
b/test/lisp/image/gravatar-tests.el
index edab6845775..b92c45a1d27 100644
--- a/test/lisp/image/gravatar-tests.el
+++ b/test/lisp/image/gravatar-tests.el
@@ -50,7 +50,7 @@
(should (equal (gravatar--query-string) "r=g&d=404")))
(let ((gravatar-default-image "https://foo/bar.png";))
(should (equal (gravatar--query-string)
- "r=g&d=https%3A%2F%2Ffoo%2Fbar.png")))))
+ "r=g&d=https://foo/bar.png";)))))
(ert-deftest gravatar-force-default ()
"Test query strings for `gravatar-force-default'."
diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el
index cfbea7378e2..c2afe6e3738 100644
--- a/test/lisp/jsonrpc-tests.el
+++ b/test/lisp/jsonrpc-tests.el
@@ -108,11 +108,13 @@
(ert-deftest returns-3 ()
"A basic test for adding two numbers in our test RPC."
+ (skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(should (= 3 (jsonrpc-request conn '+ [1 2])))))
(ert-deftest errors-with--32601 ()
"Errors with -32601"
+ (skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(condition-case err
(progn
@@ -123,6 +125,7 @@
(ert-deftest signals-an--32603-JSONRPC-error ()
"Signals an -32603 JSONRPC error."
+ (skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(condition-case err
(let ((jsonrpc-inhibit-debug-on-error t))
@@ -133,6 +136,7 @@
(ert-deftest times-out ()
"Request for 3-sec sit-for with 1-sec timeout times out."
+ (skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(should-error
(jsonrpc-request conn 'sit-for [3] :timeout 1))))
@@ -140,11 +144,13 @@
(ert-deftest doesnt-time-out ()
:tags '(:expensive-test)
"Request for 1-sec sit-for with 2-sec timeout succeeds."
+ (skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(jsonrpc-request conn 'sit-for [1] :timeout 2)))
(ert-deftest stretching-it-but-works ()
"Vector of numbers or vector of vector of numbers are serialized."
+ (skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
;; (vconcat [1 2 3] [3 4 5]) => [1 2 3 3 4 5] which can be
;; serialized.
@@ -161,6 +167,7 @@
(ert-deftest deferred-action-toolate ()
:tags '(:expensive-test)
"Deferred request fails because no one clears the flag."
+ (skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(should-error
(jsonrpc-request conn '+ [1 2]
@@ -173,6 +180,7 @@
(ert-deftest deferred-action-intime ()
:tags '(:expensive-test)
"Deferred request barely makes it after event clears a flag."
+ (skip-when (eq system-type 'windows-nt))
;; Send an async request, which returns immediately. However the
;; success fun which sets the flag only runs after some time.
(jsonrpc--with-emacsrpc-fixture (conn)
@@ -191,6 +199,7 @@
(ert-deftest deferred-action-complex-tests ()
:tags '(:expensive-test)
"Test a more complex situation with deferred requests."
+ (skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(let (n-deferred-1
n-deferred-2
diff --git a/test/lisp/mwheel-tests.el b/test/lisp/mwheel-tests.el
index 2b0f0ff384a..f60b9ecd3b0 100644
--- a/test/lisp/mwheel-tests.el
+++ b/test/lisp/mwheel-tests.el
@@ -23,10 +23,12 @@
(require 'mwheel)
(ert-deftest mwheel-test-enable/disable ()
- (mouse-wheel-mode 1)
- (should (eq (lookup-key (current-global-map) `[,mouse-wheel-up-event])
'mwheel-scroll))
- (mouse-wheel-mode -1)
- (should (eq (lookup-key (current-global-map) `[,mouse-wheel-up-event]) nil)))
+ (with-suppressed-warnings ((obsolete mouse-wheel-up-event))
+ (mouse-wheel-mode 1)
+ (should (eq (lookup-key (current-global-map) `[,mouse-wheel-up-event])
+ 'mwheel-scroll))
+ (mouse-wheel-mode -1)
+ (should-not (lookup-key (current-global-map) `[,mouse-wheel-up-event]))))
(ert-deftest mwheel-test--create-scroll-keys ()
(should (equal (mouse-wheel--create-scroll-keys 10 'mouse-4)
diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el
index b83435e0bd9..4ba51da408f 100644
--- a/test/lisp/net/eww-tests.el
+++ b/test/lisp/net/eww-tests.el
@@ -50,6 +50,7 @@ temporary EWW buffer for our tests."
(ert-deftest eww-test/display/html ()
"Test displaying a simple HTML page."
+ (skip-unless (libxml-available-p))
(eww-test--with-mock-retrieve
(let ((eww-test--response-function
(lambda (url)
@@ -196,6 +197,7 @@ This sets `eww-before-browse-history-function' to
(ert-deftest eww-test/readable/toggle-display ()
"Test toggling the display of the \"readable\" parts of a web page."
+ (skip-unless (libxml-available-p))
(eww-test--with-mock-retrieve
(let* ((shr-width most-positive-fixnum)
(shr-use-fonts nil)
@@ -233,7 +235,8 @@ This sets `eww-before-browse-history-function' to
(ert-deftest eww-test/readable/default-readable ()
"Test that EWW displays readable parts of pages by default when applicable."
- (eww-test--with-mock-retrieve
+ (skip-unless (libxml-available-p))
+ (eww-test--with-mock-retrieve
(let* ((eww-test--response-function
(lambda (_url)
(concat "Content-Type: text/html\n\n"
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index cdd2a1efdb2..2c61efb04d8 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -64,6 +64,7 @@
(declare-function tramp-method-out-of-band-p "tramp-sh")
(declare-function tramp-smb-get-localname "tramp-smb")
(defvar ange-ftp-make-backup-files)
+(defvar comp-warn-primitives)
(defvar tramp-connection-properties)
(defvar tramp-copy-size-limit)
(defvar tramp-fuse-remove-hidden-files)
@@ -2103,14 +2104,18 @@ is greater than 10.
(string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp"))))
;; Default values in tramp-sh.el and tramp-sudoedit.el.
(when (assoc "su" tramp-methods)
- (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
+ (dolist
+ (h `("127.0.0.1" "[::1]" "localhost" "localhost4" "localhost6"
+ "ip6-localhost" "ip6-loopback" ,(system-name)))
(should
- (string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su")))
- (dolist (m '("su" "sudo" "ksu" "doas" "sudoedit"))
+ (string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su"))))
+ (dolist (m '("su" "sudo" "ksu" "doas" "sudoedit"))
+ (when (assoc m tramp-methods)
(should (string-equal (file-remote-p (format "/%s::" m) 'user) "root"))
(should
- (string-equal (file-remote-p (format "/%s::" m) 'host) (system-name))))
- (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc"))
+ (string-equal (file-remote-p (format "/%s::" m) 'host) (system-name)))))
+ (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc"))
+ (when (assoc m tramp-methods)
(should
(string-equal
(file-remote-p (format "/%s::" m) 'user) (user-login-name)))))
@@ -2128,21 +2133,22 @@ is greater than 10.
;; Host names must match rules in case the command template of a
;; method doesn't use them.
(dolist (m '("su" "sg" "sudo" "doas" "ksu"))
- (let (tramp-connection-properties tramp-default-proxies-alist)
- (ignore-errors
- (tramp-cleanup-connection tramp-test-vec nil 'keep-password))
- ;; Single hop. The host name must match `tramp-local-host-regexp'.
- (should-error
- (find-file (format "/%s:foo:" m))
- :type 'user-error)
- ;; Multi hop. The host name must match the previous hop.
- (should-error
- (find-file
- (format
- "%s|%s:foo:"
- (substring (file-remote-p ert-remote-temporary-file-directory) 0 -1)
- m))
- :type 'user-error))))
+ (when (assoc m tramp-methods)
+ (let (tramp-connection-properties tramp-default-proxies-alist)
+ (ignore-errors
+ (tramp-cleanup-connection tramp-test-vec nil 'keep-password))
+ ;; Single hop. The host name must match `tramp-local-host-regexp'.
+ (should-error
+ (find-file (format "/%s:foo:" m))
+ :type 'user-error)
+ ;; Multi hop. The host name must match the previous hop.
+ (should-error
+ (find-file
+ (format
+ "%s|%s:foo:"
+ (substring (file-remote-p ert-remote-temporary-file-directory) 0 -1)
+ m))
+ :type 'user-error)))))
(ert-deftest tramp-test03-file-name-method-rules ()
"Check file name rules for some methods."
@@ -3684,7 +3690,8 @@ This tests also `access-file', `file-readable-p',
;; `access-file' returns nil in case of success.
(should-not (access-file tmp-name1 "error"))
;; `access-file' could use a timeout.
- (let ((remote-file-name-access-timeout 1))
+ (let ((remote-file-name-access-timeout 1)
+ comp-warn-primitives)
(cl-letf (((symbol-function #'file-exists-p)
(lambda (_filename) (sleep-for 5))))
(should-error
@@ -5367,19 +5374,23 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
:tags (append '(:expensive-test :tramp-asynchronous-processes)
(and ,unstable '(:unstable)))
(skip-unless (tramp--test-enabled))
- (let ((default-directory ert-remote-temporary-file-directory)
- (ert-test (ert-get-test ',test))
- (tramp-connection-properties
- (cons '(nil "direct-async-process" t)
- tramp-connection-properties)))
+ (let* ((default-directory ert-remote-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (connection-local-profile-alist
+ (cons
+ '(direct-async-process-profile (tramp-direct-async-process . t))
+ connection-local-profile-alist))
+ (connection-local-criteria-alist
+ (cons
+ `((:application tramp
+ :machine ,(file-remote-p default-directory 'host))
+ direct-async-process-profile)
+ connection-local-criteria-alist)))
(skip-unless (tramp-direct-async-process-p))
;; We do expect an established connection already,
;; `file-truename' does it by side-effect. Suppress
;; `tramp--test-enabled', in order to keep the connection.
- ;; Suppress "Process ... finished" messages.
- (cl-letf (((symbol-function #'tramp--test-enabled)
#'tramp-compat-always)
- ((symbol-function #'internal-default-process-sentinel)
- #'ignore))
+ (cl-letf (((symbol-function #'tramp--test-enabled)
#'tramp-compat-always))
(file-truename ert-remote-temporary-file-directory)
(funcall (ert-test-body ert-test))))))
@@ -5922,7 +5933,7 @@ INPUT, if non-nil, is a string sent to the process."
(when (natnump cols)
(should (= cols async-shell-command-width))))))
-(tramp--test-deftest-direct-async-process tramp-test32-shell-command 'unstable)
+(tramp--test-deftest-direct-async-process tramp-test32-shell-command)
;; This test is inspired by Bug#39067.
(ert-deftest tramp-test32-shell-command-dont-erase-buffer ()
@@ -7064,7 +7075,7 @@ This is used in tests which we don't want to tag
"Check, whether a container method is used.
This does not support some special file names."
(string-match-p
- (rx bol (| "docker" "podman"))
+ (rx bol (| "docker" "podman" "kubernetes" "apptainer" "run0" "nspawn"))
(file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-container-oob-p ()
@@ -7210,6 +7221,12 @@ This does not support special file names."
(string-equal
"telnet" (file-remote-p ert-remote-temporary-file-directory 'method)))
+(defun tramp--test-toolbox-p ()
+ "Check, whether the toolbox method is used.
+This does not support `tramp-test45-asynchronous-requests'."
+ (string-equal
+ "toolbox" (file-remote-p ert-remote-temporary-file-directory 'method)))
+
(defun tramp--test-windows-nt-p ()
"Check, whether the locale host runs MS Windows."
(eq system-type 'windows-nt))
@@ -7233,8 +7250,14 @@ This requires restrictions of file name syntax."
(defun tramp--test-supports-processes-p ()
"Return whether the method under test supports external processes."
- (and (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p))
- (not (tramp--test-crypt-p))))
+ ;; We use it to enable/disable tests in a given test run, for
+ ;; example for remote processes on MS Windows.
+ (if (tramp-connection-property-p
+ tramp-test-vec "tramp--test-supports-processes-p")
+ (tramp-get-connection-property
+ tramp-test-vec "tramp--test-supports-processes-p")
+ (and (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p))
+ (not (tramp--test-crypt-p)))))
(defun tramp--test-supports-set-file-modes-p ()
"Return whether the method under test supports setting file modes."
@@ -7419,7 +7442,9 @@ This requires restrictions of file name syntax."
'(tramp--test-async-shell-command))))
(with-temp-buffer
(funcall this-shell-command "cat -- *" (current-buffer))
- (should (string-equal elt (buffer-string)))))))
+ (should
+ (string-match-p
+ (rx (literal elt) eol) (buffer-string)))))))
(delete-file file2)
(should-not (file-exists-p file2))
@@ -7688,8 +7713,9 @@ process sentinels. They shall not disturb each other."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(skip-unless (not (tramp--test-container-p)))
- (skip-unless (not (tramp--test-telnet-p)))
(skip-unless (not (tramp--test-sshfs-p)))
+ (skip-unless (not (tramp--test-telnet-p)))
+ (skip-unless (not (tramp--test-toolbox-p)))
(skip-unless (not (tramp--test-windows-nt-p)))
(with-timeout
diff --git a/test/lisp/progmodes/bug-reference-tests.el
b/test/lisp/progmodes/bug-reference-tests.el
index 8cca354705b..21b9d3c8ff3 100644
--- a/test/lisp/progmodes/bug-reference-tests.el
+++ b/test/lisp/progmodes/bug-reference-tests.el
@@ -136,8 +136,11 @@
(goto-char (point-min))
;; Make sure we get the URL when `bug-reference-mode' is active...
(should (equal (thing-at-point 'url) "https://debbugs.gnu.org/1234";))
+ (should (equal (bounds-of-thing-at-point 'url) '(1 . 9)))
+ (should (= (save-excursion (forward-thing 'url) (point)) 9))
(bug-reference-mode -1)
;; ... and get nil when `bug-reference-mode' is inactive.
- (should-not (thing-at-point 'url))))
+ (should-not (thing-at-point 'url))
+ (should-not (bounds-of-thing-at-point 'url))))
;;; bug-reference-tests.el ends here
diff --git a/test/lisp/progmodes/csharp-mode-resources/indent-ts.erts
b/test/lisp/progmodes/csharp-mode-resources/indent-ts.erts
new file mode 100644
index 00000000000..3cb23608270
--- /dev/null
+++ b/test/lisp/progmodes/csharp-mode-resources/indent-ts.erts
@@ -0,0 +1,51 @@
+Code:
+ (lambda ()
+ (csharp-ts-mode)
+ (indent-region (point-min) (point-max)))
+
+Point-Char: |
+
+Name: Indent single statement body for if/else. (bug#70345)
+
+=-=
+
+int x;
+int y;
+
+if (true)
+ x = 2;
+
+if (true)
+{
+ x = 2;
+}
+
+if (true)
+ x = 2;
+else
+ y = 2;
+
+if (true)
+{
+ x = 2;
+}
+else
+{
+ y = 2;
+}
+
+if (true)
+ x = 2;
+else
+{
+ y = 2;
+}
+
+if (true)
+{
+ x = 2;
+}
+else
+ y = 2;
+
+=-=-=
diff --git a/test/lisp/progmodes/csharp-mode-tests.el
b/test/lisp/progmodes/csharp-mode-tests.el
index f50fabf5836..af06a918f6e 100644
--- a/test/lisp/progmodes/csharp-mode-tests.el
+++ b/test/lisp/progmodes/csharp-mode-tests.el
@@ -26,5 +26,9 @@
(ert-deftest csharp-mode-test-indentation ()
(ert-test-erts-file (ert-resource-file "indent.erts")))
+(ert-deftest csharp-ts-mode-test-indentation ()
+ (skip-unless (treesit-ready-p 'c-sharp t))
+ (ert-test-erts-file (ert-resource-file "indent-ts.erts")))
+
(provide 'csharp-mode-tests)
;;; csharp-mode-tests.el ends here
diff --git a/test/lisp/progmodes/eglot-tests.el
b/test/lisp/progmodes/eglot-tests.el
index 4725885038e..af1ee998919 100644
--- a/test/lisp/progmodes/eglot-tests.el
+++ b/test/lisp/progmodes/eglot-tests.el
@@ -230,7 +230,7 @@ directory hierarchy."
`(push message
,client-replies)))))))))
(unwind-protect
(progn
- (add-hook 'jsonrpc-event-hook #',log-event-hook-sym)
+ (add-hook 'jsonrpc-event-hook #',log-event-hook-sym t)
,@body)
(remove-hook 'jsonrpc-event-hook #',log-event-hook-sym))))))
@@ -436,6 +436,56 @@ directory hierarchy."
(flymake-goto-next-error 1 '() t)
(should (eq 'flymake-error (face-at-point)))))))
+(ert-deftest eglot-test-basic-symlink ()
+ "Test basic symlink support."
+ (skip-unless (executable-find "clangd"))
+ ;; MS-Windows either fails symlink creation or pops up UAC prompts.
+ (skip-when (eq system-type 'windows-nt))
+ (eglot--with-fixture
+ `(("symlink-project" .
+ (("main.cpp" . "#include\"foo.h\"\nint main() { return foo(); }")
+ ("foo.h" . "int foo();"))))
+ (with-current-buffer
+ (find-file-noselect "symlink-project/main.cpp")
+ (make-symbolic-link "main.cpp" "mainlink.cpp")
+ (eglot--tests-connect)
+ (eglot--sniffing (:client-notifications c-notifs)
+ (let ((eglot-autoshutdown nil)) (kill-buffer (current-buffer)))
+ (eglot--wait-for (c-notifs 10)
+ (&key method &allow-other-keys)
+ (and (string= method "textDocument/didClose")))))
+ (eglot--sniffing (:client-notifications c-notifs)
+ (with-current-buffer
+ (find-file-noselect "symlink-project/main.cpp")
+ (should (eglot-current-server)))
+ (eglot--wait-for (c-notifs 10)
+ (&rest whole &key params method &allow-other-keys)
+ (and (string= method "textDocument/didOpen")
+ (string-match "main.cpp$"
+ (plist-get (plist-get params :textDocument)
+ :uri)))))
+ ;; This last segment is deactivated, because it's likely not needed.
+ ;; The only way the server would answer with '3' references is if we
+ ;; had erroneously sent a 'didOpen' for anything other than
+ ;; `main.cpp', but if we got this far is because we've just asserted
+ ;; that we didn't.
+ (when nil
+ (with-current-buffer
+ (find-file-noselect "symlink-project/foo.h")
+ ;; Give clangd some time to settle its analysis so it can
+ ;; accurately respond to `textDocument/references'
+ (sleep-for 3)
+ (search-forward "foo")
+ (eglot--sniffing (:server-replies s-replies)
+ (call-interactively 'xref-find-references)
+ (eglot--wait-for (s-replies 10)
+ (&key method result &allow-other-keys)
+ ;; Expect xref buffer to not contain duplicate references to
+ ;; main.cpp and mainlink.cpp. If it did, 'result's length
+ ;; would be 3.
+ (and (string= method "textDocument/references")
+ (= (length result) 2))))))))
+
(ert-deftest eglot-test-diagnostic-tags-unnecessary-code ()
"Test rendering of diagnostics tagged \"unnecessary\"."
(skip-unless (executable-find "clangd"))
@@ -821,6 +871,12 @@ int main() {
(should (looking-back "\"foo.bar\": \""))
(should (looking-at "fb\"$"))))))
+(defun eglot-tests--get (object path)
+ (dolist (op path)
+ (setq object (if (natnump op) (aref object op)
+ (plist-get object op))))
+ object)
+
(defun eglot-tests--lsp-abiding-column-1 ()
(eglot--with-fixture
'(("project" .
@@ -837,7 +893,11 @@ int main() {
(insert "p ")
(eglot--signal-textDocument/didChange)
(eglot--wait-for (c-notifs 2) (&key params &allow-other-keys)
- (should (equal 71 (cadddr (cadadr (aref (cadddr params) 0))))))
+ (message "PARAMS=%S" params)
+ (should (equal 71 (eglot-tests--get
+ params
+ '(:contentChanges 0
+ :range :start :character)))))
(beginning-of-line)
(should (eq eglot-move-to-linepos-function
#'eglot-move-to-utf-16-linepos))
(funcall eglot-move-to-linepos-function 71)
diff --git a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts
b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts
index 48184160b4d..ba7bad1b452 100644
--- a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts
+++ b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts
@@ -66,6 +66,10 @@ end
return f
end
+f6(function()
+print'ok'
+end)
+
;(function ()
return true
end)()
@@ -118,6 +122,10 @@ function f6(...)
return f
end
+f6(function()
+ print'ok'
+end)
+
;(function ()
return true
end)()
@@ -406,6 +414,15 @@ a = 1,
b = 2,
},
nil)
+
+Test(nil, {
+ a = 1,
+ b = 2,
+ })
+
+fn( -- comment
+ 1,
+ 2)
=-=
h(
"string",
@@ -443,6 +460,15 @@ Test({
b = 2,
},
nil)
+
+Test(nil, {
+ a = 1,
+ b = 2,
+})
+
+fn( -- comment
+ 1,
+ 2)
=-=-=
Name: Parameter Indent
@@ -464,6 +490,9 @@ local f3 = function( a, b,
c, d )
print(a,b,c,d)
end
+
+local f4 = function(-- comment
+a, b, c)
=-=
function f1(
a,
@@ -481,6 +510,9 @@ local f3 = function( a, b,
c, d )
print(a,b,c,d)
end
+
+local f4 = function(-- comment
+ a, b, c)
=-=-=
Name: Table Indent
@@ -506,6 +538,10 @@ a = 1,
b = 2,
c = 3,
}
+
+local a = { -- hello world!
+ b = 10
+}
=-=
local Other = {
First={up={Step=true,Jump=true},
@@ -527,6 +563,10 @@ local Other = {
b = 2,
c = 3,
}
+
+local a = { -- hello world!
+ b = 10
+}
=-=-=
Name: Continuation Indent
diff --git a/test/lisp/progmodes/lua-ts-mode-resources/which-function.lua
b/test/lisp/progmodes/lua-ts-mode-resources/which-function.lua
new file mode 100644
index 00000000000..621d818461c
--- /dev/null
+++ b/test/lisp/progmodes/lua-ts-mode-resources/which-function.lua
@@ -0,0 +1,3 @@
+local function f(x)
+ print(x)
+end
diff --git a/test/lisp/progmodes/lua-ts-mode-tests.el
b/test/lisp/progmodes/lua-ts-mode-tests.el
index 565e6f91dbd..68b8c9ccfaa 100644
--- a/test/lisp/progmodes/lua-ts-mode-tests.el
+++ b/test/lisp/progmodes/lua-ts-mode-tests.el
@@ -23,20 +23,31 @@
(require 'ert-font-lock)
(require 'ert-x)
(require 'treesit)
+(require 'which-func)
(ert-deftest lua-ts-test-indentation ()
- (skip-unless (treesit-ready-p 'lua))
+ (skip-unless (treesit-ready-p 'lua t))
(ert-test-erts-file (ert-resource-file "indent.erts")))
(ert-deftest lua-ts-test-movement ()
- (skip-unless (treesit-ready-p 'lua))
+ (skip-unless (treesit-ready-p 'lua t))
(ert-test-erts-file (ert-resource-file "movement.erts")))
(ert-deftest lua-ts-test-font-lock ()
- (skip-unless (treesit-ready-p 'lua))
+ (skip-unless (treesit-ready-p 'lua t))
(let ((treesit-font-lock-level 4))
(ert-font-lock-test-file (ert-resource-file "font-lock.lua")
'lua-ts-mode)))
+(ert-deftest lua-ts-test-which-function ()
+ (skip-unless (treesit-ready-p 'lua t))
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "which-function.lua"))
+ (lua-ts-mode)
+ (which-function-mode)
+ (goto-char (point-min))
+ (should (equal "f" (which-function)))
+ (which-function-mode -1)))
+
(provide 'lua-ts-mode-tests)
;;; lua-ts-mode-tests.el ends here
diff --git a/test/lisp/progmodes/project-tests.el
b/test/lisp/progmodes/project-tests.el
index 04cdf1dea29..93943cef43b 100644
--- a/test/lisp/progmodes/project-tests.el
+++ b/test/lisp/progmodes/project-tests.el
@@ -163,4 +163,58 @@ When `project-ignores' includes a name matching project
dir."
(should-not (null project))
(should (string-match-p "/test/lisp/progmodes/project-resources/\\'"
(project-root project)))))
+(ert-deftest project-find-regexp ()
+ "Check the happy path."
+ (skip-unless (executable-find find-program))
+ (skip-unless (executable-find "xargs"))
+ (skip-unless (executable-find "grep"))
+ (let* ((directory (ert-resource-directory))
+ (project-find-functions nil)
+ (project-list-file (expand-file-name "emacs-projects"
temporary-file-directory))
+ (project (cons 'transient directory)))
+ (add-hook 'project-find-functions (lambda (_dir) project))
+ (should (eq (project-current) project))
+ (let* ((matches nil)
+ (xref-search-program 'grep)
+ (xref-show-xrefs-function
+ (lambda (fetcher _display)
+ (setq matches (funcall fetcher)))))
+ (project-find-regexp "etc")
+ (should (equal (mapcar (lambda (item)
+ (file-name-base
+ (xref-location-group (xref-item-location
item))))
+ matches)
+ '(".dir-locals" "etc")))
+ (should (equal (sort (mapcar #'xref-item-summary matches) #'string<)
+ '("((nil . ((project-vc-ignores . (\"etc\")))))"
"etc"))))))
+
+(ert-deftest project-find-regexp-with-prefix ()
+ "Check the happy path."
+ (skip-unless (executable-find find-program))
+ (skip-unless (executable-find "xargs"))
+ (skip-unless (executable-find "grep"))
+ (let* ((directory (ert-resource-directory))
+ (project-find-functions nil)
+ (project-list-file (expand-file-name "emacs-projects"
temporary-file-directory))
+ (project (cons 'transient (expand-file-name
"../elisp-mode-resources/" directory))))
+ (add-hook 'project-find-functions (lambda (_dir) project))
+ (should (eq (project-current) project))
+ (let* ((matches nil)
+ (xref-search-program 'grep)
+ (xref-show-xrefs-function
+ (lambda (fetcher _display)
+ (setq matches (funcall fetcher))))
+ (current-prefix-arg t))
+ (cl-letf (((symbol-function 'read-directory-name)
+ (lambda (_prompt _default _dirname _mm) directory))
+ ((symbol-function 'grep-read-files) (lambda (_re) "*")))
+ (project-find-regexp "etc"))
+ (should (equal (mapcar (lambda (item)
+ (file-name-base
+ (xref-location-group (xref-item-location
item))))
+ matches)
+ '(".dir-locals" "etc")))
+ (should (equal (sort (mapcar #'xref-item-summary matches) #'string<)
+ '("((nil . ((project-vc-ignores . (\"etc\")))))"
"etc"))))))
+
;;; project-tests.el ends here
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index e11440cdb5b..de6a4316758 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -21,6 +21,7 @@
;;; Code:
+(require 'cl-extra)
(require 'ert)
(require 'ert-x)
(require 'python)
@@ -58,7 +59,8 @@ turned off. Shell buffer will be killed on exit."
(let ((dir (make-symbol "dir")))
`(with-temp-buffer
(let ((python-indent-guess-indent-offset nil)
- (python-shell-completion-native-enable nil))
+ (python-shell-completion-native-enable nil)
+ (python-shell-interpreter (python-tests-get-shell-interpreter)))
(python-mode)
(unwind-protect
;; Prevent test failures when Jedi is used as a completion
@@ -391,7 +393,11 @@ p = (1 + 2)
(python-tests-assert-faces
"b: Tuple[Optional[int], Union[Sequence[str], str]] = (None, 'foo')"
'((1 . font-lock-variable-name-face) (2)
+ (4 . font-lock-type-face) (9)
+ (10 . font-lock-type-face) (18)
(19 . font-lock-builtin-face) (22)
+ (25 . font-lock-type-face) (30)
+ (31 . font-lock-type-face) (39)
(40 . font-lock-builtin-face) (43)
(46 . font-lock-builtin-face) (49)
(52 . font-lock-operator-face) (53)
@@ -402,12 +408,14 @@ p = (1 + 2)
(python-tests-assert-faces
"c: Collection = {1, 2, 3}"
'((1 . font-lock-variable-name-face) (2)
+ (4 . font-lock-type-face) (14)
(15 . font-lock-operator-face) (16))))
(ert-deftest python-font-lock-assignment-statement-13 ()
(python-tests-assert-faces
"d: Mapping[int, str] = {1: 'bar', 2: 'baz'}"
'((1 . font-lock-variable-name-face) (2)
+ (4 . font-lock-type-face) (11)
(12 . font-lock-builtin-face) (15)
(17 . font-lock-builtin-face) (20)
(22 . font-lock-operator-face) (23)
@@ -472,14 +480,38 @@ def f(x: CustomInt) -> CustomInt:
(58 . font-lock-operator-face) (59)
(62 . font-lock-operator-face) (63)
(70 . font-lock-variable-name-face) (72)
+ (74 . font-lock-type-face) (82)
+ (83 . font-lock-type-face) (92)
(94 . font-lock-operator-face) (95)
(102 . font-lock-operator-face) (103)
(111 . font-lock-variable-name-face) (114)
+ (116 . font-lock-type-face) (125)
(126 . font-lock-operator-face) (127)
(128 . font-lock-builtin-face) (131)
(136 . font-lock-operator-face) (137)
(144 . font-lock-keyword-face) (150))))
+(ert-deftest python-font-lock-assignment-statement-19 ()
+ (python-tests-assert-faces
+ "a: List[List[CustomInt], List[CustomInt]] = []"
+ '((1 . font-lock-variable-name-face) (2)
+ (4 . font-lock-type-face) (8)
+ (9 . font-lock-type-face) (13)
+ (14 . font-lock-type-face) (23)
+ (26 . font-lock-type-face) (30)
+ (31 . font-lock-type-face) (40)
+ (43 . font-lock-operator-face) (44))))
+
+(ert-deftest python-font-lock-assignment-statement-20 ()
+ (python-tests-assert-faces
+ "a = b = c = 1"
+ '((1 . font-lock-variable-name-face) (2)
+ (3 . font-lock-operator-face) (4)
+ (5 . font-lock-variable-name-face) (6)
+ (7 . font-lock-operator-face) (8)
+ (9 . font-lock-variable-name-face) (10)
+ (11 . font-lock-operator-face) (12))))
+
(ert-deftest python-font-lock-operator-1 ()
(python-tests-assert-faces
"1 << 2 ** 3 == +4%-5|~6&7^8%9"
@@ -3718,7 +3750,19 @@ if x:
;;; Shell integration
-(defvar python-tests-shell-interpreter "python")
+(defvar python-tests-shell-interpreter nil)
+
+(defun python-tests-get-shell-interpreter ()
+ "Get the shell interpreter.
+If env string EMACS_PYTHON_INTERPRETER exists, use it as preferred one."
+ (if python-tests-shell-interpreter
+ python-tests-shell-interpreter
+ (setq python-tests-shell-interpreter
+ (or (when-let ((interpreter (getenv "EMACS_PYTHON_INTERPRETER")))
+ (or (executable-find interpreter)
+ (error "Couldn't find EMACS_PYTHON_INTERPRETER(%s) in path"
+ interpreter)))
+ (cl-some #'executable-find '("python" "python3" "python2"))))))
(ert-deftest python-shell-get-process-name-1 ()
"Check process name calculation sans `buffer-file-name'."
@@ -3980,13 +4024,13 @@ if x:
(ert-deftest python-shell-make-comint-1 ()
"Check comint creation for global shell buffer."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
;; The interpreter can get killed too quickly to allow it to clean
;; up the tempfiles that the default python-shell-setup-codes create,
;; so it leaves tempfiles behind, which is a minor irritation.
(let* ((python-shell-setup-codes nil)
(python-shell-interpreter
- (executable-find python-tests-shell-interpreter))
+ (python-tests-get-shell-interpreter))
(proc-name (python-shell-get-process-name nil))
(shell-buffer
(python-tests-with-temp-buffer
@@ -4004,10 +4048,10 @@ if x:
(ert-deftest python-shell-make-comint-2 ()
"Check comint creation for internal shell buffer."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(let* ((python-shell-setup-codes nil)
(python-shell-interpreter
- (executable-find python-tests-shell-interpreter))
+ (python-tests-get-shell-interpreter))
(proc-name (python-shell-internal-get-process-name))
(shell-buffer
(python-tests-with-temp-buffer
@@ -4028,13 +4072,13 @@ if x:
The command passed to `python-shell-make-comint' as argument must
locally override global values set in `python-shell-interpreter'
and `python-shell-interpreter-args' in the new shell buffer."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(let* ((python-shell-setup-codes nil)
(python-shell-interpreter "interpreter")
(python-shell-interpreter-args "--some-args")
(proc-name (python-shell-get-process-name nil))
(interpreter-override
- (concat (executable-find python-tests-shell-interpreter) " " "-i"))
+ (concat (python-tests-get-shell-interpreter) " " "-i"))
(shell-buffer
(python-tests-with-temp-buffer
"" (python-shell-make-comint interpreter-override proc-name nil)))
@@ -4047,17 +4091,17 @@ and `python-shell-interpreter-args' in the new shell
buffer."
(should (eq major-mode 'inferior-python-mode))
(should (file-equal-p
python-shell-interpreter
- (executable-find python-tests-shell-interpreter)))
+ (python-tests-get-shell-interpreter)))
(should (string= python-shell-interpreter-args "-i"))))
(kill-buffer shell-buffer))))
(ert-deftest python-shell-make-comint-4 ()
"Check shell calculated prompts regexps are set."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(let* ((process-environment process-environment)
(python-shell-setup-codes nil)
(python-shell-interpreter
- (executable-find python-tests-shell-interpreter))
+ (python-tests-get-shell-interpreter))
(python-shell-interpreter-args "-i")
(python-shell--prompt-calculated-input-regexp nil)
(python-shell--prompt-calculated-output-regexp nil)
@@ -4099,12 +4143,12 @@ and `python-shell-interpreter-args' in the new shell
buffer."
(ert-deftest python-shell-get-process-1 ()
"Check dedicated shell process preference over global."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-file
""
(let* ((python-shell-setup-codes nil)
(python-shell-interpreter
- (executable-find python-tests-shell-interpreter))
+ (python-tests-get-shell-interpreter))
(global-proc-name (python-shell-get-process-name nil))
(dedicated-proc-name (python-shell-get-process-name t))
(global-shell-buffer
@@ -4132,12 +4176,12 @@ and `python-shell-interpreter-args' in the new shell
buffer."
(ert-deftest python-shell-internal-get-or-create-process-1 ()
"Check internal shell process creation fallback."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-file
""
(should (not (process-live-p (python-shell-internal-get-process-name))))
(let* ((python-shell-interpreter
- (executable-find python-tests-shell-interpreter))
+ (python-tests-get-shell-interpreter))
(internal-process-name (python-shell-internal-get-process-name))
(internal-process (python-shell-internal-get-or-create-process))
(internal-shell-buffer (process-buffer internal-process)))
@@ -4155,8 +4199,9 @@ and `python-shell-interpreter-args' in the new shell
buffer."
(ert-deftest python-shell-prompt-detect-1 ()
"Check prompt autodetection."
- (skip-unless (executable-find python-tests-shell-interpreter))
- (let ((process-environment process-environment))
+ (skip-unless (python-tests-get-shell-interpreter))
+ (let ((process-environment process-environment)
+ (python-shell-interpreter (python-tests-get-shell-interpreter)))
;; Ensure no startup file is enabled
(setenv "PYTHONSTARTUP" "")
(should python-shell-prompt-detect-enabled)
@@ -4164,8 +4209,9 @@ and `python-shell-interpreter-args' in the new shell
buffer."
(ert-deftest python-shell-prompt-detect-2 ()
"Check prompt autodetection with startup file. Bug#17370."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(let* ((process-environment process-environment)
+ (python-shell-interpreter (python-tests-get-shell-interpreter))
(startup-code (concat "import sys\n"
"sys.ps1 = 'py> '\n"
"sys.ps2 = '..> '\n"
@@ -4181,7 +4227,7 @@ and `python-shell-interpreter-args' in the new shell
buffer."
(ert-deftest python-shell-prompt-detect-3 ()
"Check prompts are not autodetected when feature is disabled."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(let ((process-environment process-environment)
(python-shell-prompt-detect-enabled nil))
;; Ensure no startup file is enabled
@@ -4190,7 +4236,7 @@ and `python-shell-interpreter-args' in the new shell
buffer."
(ert-deftest python-shell-prompt-detect-4 ()
"Check warning is shown when detection fails."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(let* ((process-environment process-environment)
;; Trigger failure by removing prompts in the startup file
(startup-code (concat "import sys\n"
@@ -4211,7 +4257,7 @@ and `python-shell-interpreter-args' in the new shell
buffer."
(ert-deftest python-shell-prompt-detect-5 ()
"Check disabled warnings are not shown when detection fails."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(let* ((process-environment process-environment)
(startup-code (concat "import sys\n"
"sys.ps1 = ''\n"
@@ -4232,7 +4278,7 @@ and `python-shell-interpreter-args' in the new shell
buffer."
(ert-deftest python-shell-prompt-detect-6 ()
"Warnings are not shown when detection is disabled."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(let* ((process-environment process-environment)
(startup-code (concat "import sys\n"
"sys.ps1 = ''\n"
@@ -4396,7 +4442,7 @@ and `python-shell-interpreter-args' in the new shell
buffer."
(ert-deftest python-shell-prompt-set-calculated-regexps-6 ()
"Check detected prompts are included `regexp-quote'd."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(let* ((python-shell-prompt-input-regexps '(""))
(python-shell-prompt-output-regexps '(""))
(python-shell-prompt-regexp "")
@@ -4406,6 +4452,7 @@ and `python-shell-interpreter-args' in the new shell
buffer."
(python-shell--prompt-calculated-input-regexp nil)
(python-shell--prompt-calculated-output-regexp nil)
(python-shell-prompt-detect-enabled t)
+ (python-shell-interpreter (python-tests-get-shell-interpreter))
(process-environment process-environment)
(startup-code (concat "import sys\n"
"sys.ps1 = 'p.> '\n"
@@ -4779,7 +4826,7 @@ def foo():
(should (python-shell-completion-native-interpreter-disabled-p))))
(ert-deftest python-shell-completion-at-point-1 ()
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
""
(python-shell-with-shell-buffer
@@ -4793,7 +4840,7 @@ def foo():
(should-not (nth 2 (python-shell-completion-at-point))))))
(ert-deftest python-shell-completion-at-point-native-1 ()
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
""
(python-shell-completion-native-turn-on)
@@ -4872,14 +4919,14 @@ def foo():
"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
+ (if (eql 0 (call-process (python-tests-get-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))
+ (skip-unless (python-tests-get-shell-interpreter))
(with-environment-variables
(("PYTHONSTARTUP" (python-tests--pythonstartup-file)))
(python-tests-with-temp-buffer-with-shell
@@ -4896,7 +4943,8 @@ def foo():
(ert-deftest python-shell-completion-at-point-ipython ()
"Check if Python shell completion works for IPython."
- (let ((python-shell-interpreter "ipython")
+ (let ((python-tests-shell-interpreter "ipython")
+ (python-shell-interpreter "ipython")
(python-shell-interpreter-args "-i --simple-prompt"))
(skip-unless
(and
@@ -4923,7 +4971,7 @@ def foo():
;;; Symbol completion
(ert-deftest python-completion-at-point-1 ()
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
"
import abc
@@ -4941,7 +4989,7 @@ import abc
(ert-deftest python-completion-at-point-2 ()
"Should work regardless of the point in the Shell buffer."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
"
import abc
@@ -4959,7 +5007,7 @@ import abc
(ert-deftest python-completion-at-point-pdb-1 ()
"Should not complete PDB commands in Python buffer."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
"
import pdb
@@ -4978,7 +5026,7 @@ print('Hello')
(ert-deftest python-completion-at-point-while-running-1 ()
"Should not try to complete when a program is running in the Shell buffer."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
"
import time
@@ -4994,7 +5042,7 @@ time.sleep(3)
(should-not (with-timeout (1 t) (completion-at-point))))))
(ert-deftest python-completion-at-point-native-1 ()
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
"
import abc
@@ -5013,7 +5061,7 @@ import abc
(ert-deftest python-completion-at-point-native-2 ()
"Should work regardless of the point in the Shell buffer."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
"
import abc
@@ -5031,7 +5079,7 @@ import abc
(should (completion-at-point)))))
(ert-deftest python-completion-at-point-native-with-ffap-1 ()
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
"
import abc
@@ -5049,7 +5097,7 @@ import abc
(should (completion-at-point)))))
(ert-deftest python-completion-at-point-native-with-eldoc-1 ()
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
"
import abc
@@ -5076,7 +5124,7 @@ import abc
;;; FFAP
(ert-deftest python-ffap-module-path-1 ()
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
"
import abc
@@ -5088,7 +5136,7 @@ import abc
(ert-deftest python-ffap-module-path-while-running-1 ()
"Should not get module path when a program is running in the Shell buffer."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
"
import abc
@@ -5164,7 +5212,7 @@ some_symbol some_other_symbol
"some_symbol"))))
(ert-deftest python-eldoc--get-doc-at-point-1 ()
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
"
import time
@@ -5177,7 +5225,7 @@ import time
(ert-deftest python-eldoc--get-doc-at-point-while-running-1 ()
"Should not get documentation when a program is running in the Shell buffer."
- (skip-unless (executable-find python-tests-shell-interpreter))
+ (skip-unless (python-tests-get-shell-interpreter))
(python-tests-with-temp-buffer-with-shell
"
import time
@@ -7395,8 +7443,9 @@ buffer with overlapping strings."
;; interpreter.
(ert-deftest python-tests--run-python-selects-window ()
"Test for bug#31398. See also bug#44421 and bug#52380."
- (skip-unless (executable-find python-tests-shell-interpreter))
- (let* ((buffer (process-buffer (run-python nil nil 'show)))
+ (skip-unless (python-tests-get-shell-interpreter))
+ (let* ((python-shell-interpreter (python-tests-get-shell-interpreter))
+ (buffer (process-buffer (run-python nil nil 'show)))
(window (get-buffer-window buffer)))
;; We look at `selected-window' rather than `current-buffer'
;; because as `(elisp)Current buffer' says, the latter will only
@@ -7465,6 +7514,33 @@ buffer with overlapping strings."
"Unused import a.b.c (unused-import)"
"W0611: Unused import a.b.c (unused-import)"))))))
+(ert-deftest python-test--shell-send-block ()
+ (skip-unless (python-tests-get-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "print('current 0')
+for x in range(1,3):
+ print('current %s' % x)
+print('current 3')"
+ (goto-char (point-min))
+ (should-error (python-shell-send-block) :type 'user-error)
+ (forward-line)
+ (python-shell-send-block)
+ (python-tests-shell-wait-for-prompt)
+ (python-shell-with-shell-buffer
+ (goto-char (point-min))
+ (should-not (re-search-forward "current 0" nil t))
+ (should (re-search-forward "current 1" nil t))
+ (should (re-search-forward "current 2" nil t))
+ (should-not (re-search-forward "current 3" nil t)))
+ (forward-line)
+ (python-shell-send-block t) ;; send block body only
+ (python-tests-shell-wait-for-prompt)
+ (python-shell-with-shell-buffer
+ ;; should only 1 line output from the block body
+ (should (re-search-forward "current"))
+ (should (looking-at " 2"))
+ (should-not (re-search-forward "current" nil t)))))
+
;;; python-ts-mode font-lock tests
(defmacro python-ts-tests-with-temp-buffer (contents &rest body)
@@ -7545,6 +7621,9 @@ always located at the beginning of buffer."
(ert-deftest python-ts-mode-types-face-1 ()
(python-ts-tests-with-temp-buffer
"def f(val: Callable[[Type0], (Type1, Type2)]):"
+ (search-forward "val")
+ (goto-char (match-beginning 0))
+ (should (eq (face-at-point) font-lock-variable-name-face))
(dolist (test '("Callable" "Type0" "Type1" "Type2"))
(search-forward test)
(goto-char (match-beginning 0))
diff --git a/test/lisp/progmodes/rust-ts-mode-resources/font-lock.rs
b/test/lisp/progmodes/rust-ts-mode-resources/font-lock.rs
new file mode 100644
index 00000000000..377cda0e3b9
--- /dev/null
+++ b/test/lisp/progmodes/rust-ts-mode-resources/font-lock.rs
@@ -0,0 +1,25 @@
+// -*- rust-ts-mode-indent-offset: 0 -*-
+// Trait with function signature
+trait Foo {
+ fn foo();
+// ^ font-lock-function-name-face
+}
+
+// Macros
+macro_rules! unsafe_foo {
+ ($env:expr, $name:ident $(, $args:expr)*) => {
+// ^ font-lock-variable-name-face
+// ^ font-lock-type-face
+// ^ font-lock-variable-name-face
+// ^ font-lock-type-face
+// ^ font-lock-operator-face
+// ^ font-lock-variable-name-face
+// ^ font-lock-type-face
+// ^ font-lock-operator-face
+ {
+ foo!($env, $name $(, $args)*);
+// ^ font-lock-variable-use-face
+// ^ font-lock-operator-face
+// ^ font-lock-operator-face
+ }
+ };
diff --git a/test/lisp/progmodes/csharp-mode-tests.el
b/test/lisp/progmodes/rust-ts-mode-tests.el
similarity index 61%
copy from test/lisp/progmodes/csharp-mode-tests.el
copy to test/lisp/progmodes/rust-ts-mode-tests.el
index f50fabf5836..f718a57fc9e 100644
--- a/test/lisp/progmodes/csharp-mode-tests.el
+++ b/test/lisp/progmodes/rust-ts-mode-tests.el
@@ -1,6 +1,6 @@
-;;; csharp-mode-tests.el --- Tests for CC Mode C# mode -*- lexical-binding:
t; -*-
+;;; rust-ts-mode-tests.el --- Tests for rust-ts-mode -*- lexical-binding: t;
-*-
-;; Copyright (C) 2024 Free Software Foundation, Inc.
+;; Copyright (C) 2023-2024 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -20,11 +20,15 @@
;;; Code:
(require 'ert)
+(require 'ert-font-lock)
(require 'ert-x)
-(require 'csharp-mode)
+(require 'treesit)
-(ert-deftest csharp-mode-test-indentation ()
- (ert-test-erts-file (ert-resource-file "indent.erts")))
+(ert-deftest rust-ts-test-font-lock ()
+ (skip-unless (treesit-ready-p 'rust))
+ (let ((treesit-font-lock-level 4))
+ (ert-font-lock-test-file (ert-resource-file "font-lock.rs")
'rust-ts-mode)))
-(provide 'csharp-mode-tests)
-;;; csharp-mode-tests.el ends here
+(provide 'rust-ts-mode-tests)
+
+;;; rust-ts-mode-tests.el ends here
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 4e3f743cc93..6f28e057342 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -744,7 +744,14 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350.";
(+ subr-tests-var1 subr-tests-var2)))
'(let* ((subr-tests-var1 1)
(subr-tests-var2 subr-tests-var1))
- (+ subr-tests-var1 subr-tests-var2)))))
+ (+ subr-tests-var1 subr-tests-var2))))
+ ;; Check that the init expression can be omitted, as in `let'/`let*'.
+ (should (equal (letrec ((a (lambda () (funcall c)))
+ (b)
+ (c (lambda () b)))
+ (setq b 'ok)
+ (funcall a))
+ 'ok)))
(defvar subr-tests--hook nil)
@@ -1323,5 +1330,53 @@ final or penultimate step during initialization."))
(t x) (:success (1+ x)))
'(error "")))))
+(ert-deftest subr--subst-char-in-string ()
+ ;; Cross-validate `subst-char-in-string' with `string-replace',
+ ;; which should produce the same results when there are no properties.
+ (dolist (str '("ananas" "na\x80ma\x80s" "hétérogénéité"
+ "Ω, Ω, Ω" "é-\x80-\x80"))
+ (dolist (mb '(nil t))
+ (unless (and (not mb) (multibyte-string-p str))
+ (let ((str (if (and mb (not (multibyte-string-p str)))
+ (string-to-multibyte str)
+ str)))
+ (dolist (inplace '(nil t))
+ (dolist (from '(?a ?é ?Ω #x80 #x3fff80))
+ (dolist (to '(?o ?á ?ƒ ?☃ #x1313f #xff #x3fffc9))
+ ;; Can't put a non-byte value in a non-ASCII unibyte string.
+ (unless (and (not mb) (> to #xff)
+ (not (string-match-p (rx bos (* ascii) eos) str)))
+ (let* ((in (copy-sequence str))
+ (ref (if (and (not mb) (> from #xff))
+ in ; nothing to replace
+ (string-replace
+ (if (and (not mb) (<= from #xff))
+ (unibyte-string from)
+ (string from))
+ (if (and (not mb) (<= to #xff))
+ (unibyte-string to)
+ (string to))
+ in)))
+ (out (subst-char-in-string from to in inplace)))
+ (should (equal out ref))
+ (if inplace
+ (should (eq out in))
+ (should (equal in str))))))))))))
+
+ ;; Verify that properties are preserved.
+ (dolist (str (list "cocoa" (string-to-multibyte "cocoa") "écalé"))
+ (dolist (from '(?a ?o ?c ?é))
+ (dolist (to '(?i ?à ?☃))
+ (let ((in (copy-sequence str)))
+ (put-text-property 0 5 'alpha 1 in)
+ (put-text-property 1 4 'beta 2 in)
+ (put-text-property 0 2 'gamma 3 in)
+ (put-text-property 1 4 'delta 4 in)
+ (put-text-property 2 3 'epsilon 5 in)
+ (let* ((props-in (copy-tree (object-intervals in)))
+ (out (subst-char-in-string from to in))
+ (props-out (object-intervals out)))
+ (should (equal props-out props-in))))))))
+
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el
index b40cd39d112..bafe575fdda 100644
--- a/test/lisp/tar-mode-tests.el
+++ b/test/lisp/tar-mode-tests.el
@@ -46,6 +46,20 @@
(when (buffer-live-p tar-buffer) (kill-buffer tar-buffer))
(when (buffer-live-p gz-buffer) (kill-buffer gz-buffer)))))
+(ert-deftest tar-mode-test-tar-extract-zip-and-gz ()
+ (skip-unless (executable-find "gzip"))
+ (require 'arc-mode)
+ (let* ((tar-file (expand-file-name "tzg.tar.gz"
tar-mode-tests-data-directory))
+ tar-buffer zip-buffer gz-buffer)
+ (unwind-protect
+ (with-current-buffer (setq tar-buffer (find-file-noselect tar-file))
+ (with-current-buffer (setq zip-buffer (tar-extract))
+ (setq gz-buffer (archive-extract))
+ (should (equal (char-after) ?\N{SNOWFLAKE}))))
+ (when (buffer-live-p tar-buffer) (kill-buffer tar-buffer))
+ (when (buffer-live-p zip-buffer) (kill-buffer zip-buffer))
+ (when (buffer-live-p gz-buffer) (kill-buffer gz-buffer)))))
+
(provide 'tar-mode-tests)
;;; tar-mode-tests.el ends here
diff --git a/test/lisp/textmodes/reftex-tests.el
b/test/lisp/textmodes/reftex-tests.el
index 456ee458865..eed00cbbbc3 100644
--- a/test/lisp/textmodes/reftex-tests.el
+++ b/test/lisp/textmodes/reftex-tests.el
@@ -197,10 +197,28 @@
journal = {Some Journal},
year = 2013,
pages = {1--333}
+}"))
+ (entry2 (reftex-parse-bibtex-entry "\
+@article{Abels:slice,
+author = {Abels, H.},
+title = {Parallelizability of proper actions, global
+ {$K$}-slices and maximal compact subgroups},
+journaltitle = {Math. Ann.},
+year = 1974,
+volume = 212,
+pages = {1--19}
}")))
(should (string= (reftex-format-citation entry nil) "\\cite{Foo13}"))
(should (string= (reftex-format-citation entry "%l:%A:%y:%t %j %P %a")
- "Foo13:Jane Roe:2013:Some Article Some Journal 1 Jane
Roe, John Doe \\& Jane Taxpayer"))))
+ "Foo13:Jane Roe:2013:Some Article Some Journal 1 Jane
Roe, John Doe \\& Jane Taxpayer"))
+ ;; Test for biblatex field journaltitle (bug#38762):
+ (should (string=
+ (reftex-format-citation entry2
+ "[%4a, \\textit{%t}, \
+%b %e, %u, %r %h %j \\textbf{%v} (%y), %p %<]")
+ "[Abels, \\textit{Parallelizability of proper actions, \
+global {$K$}-slices and maximal compact subgroups}, \
+Math. Ann. \\textbf{212} (1974), 1--19]"))))
(ert-deftest reftex-all-used-citation-keys ()
"Test `reftex-all-used-citation-keys'.
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index e50738f1122..cc51e3f5296 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -258,4 +258,93 @@ position to retrieve THING.")
(should (equal (test--number "0xf00" 2) 3840))
(should (equal (test--number "0xf00" 3) 3840)))
+(ert-deftest thing-at-point-providers ()
+ (with-temp-buffer
+ (setq-local
+ thing-at-point-provider-alist
+ `((url . ,(lambda () (thing-at-point-for-char-property 'foo-url)))
+ (url . ,(lambda () (thing-at-point-for-char-property 'bar-url)))))
+ (insert (propertize "hello" 'foo-url "foo.com") "\ngoodbye")
+ (overlay-put (make-overlay 7 14) 'bar-url "bar.com")
+ (goto-char (point-min))
+ ;; Get the URL using the first provider.
+ (should (equal (thing-at-point 'url) "foo.com"))
+ (should (equal (thing-at-point 'word) "hello"))
+ (goto-char 6) ; Go to the end of "hello".
+ (should (equal (thing-at-point 'url) "foo.com"))
+ (goto-char (point-max))
+ ;; Get the URL using the second provider.
+ (should (equal (thing-at-point 'url) "bar.com"))))
+
+(ert-deftest forward-thing-providers ()
+ (with-temp-buffer
+ (setq-local
+ forward-thing-provider-alist
+ `((url . ,(lambda (n) (forward-thing-for-char-property 'foo-url n)))
+ (url . ,(lambda (n) (forward-thing-for-char-property 'bar-url n)))))
+ (insert (propertize "hello" 'foo-url "foo.com") "there\ngoodbye")
+ (overlay-put (make-overlay 12 19) 'bar-url "bar.com")
+ (goto-char (point-min))
+ (forward-thing 'url) ; Move past the first URL.
+ (should (= (point) 6))
+ (forward-thing 'url) ; Move past the second URL.
+ (should (= (point) 19))
+ (forward-thing 'url -1) ; Move backwards past the second URL.
+ (should (= (point) 12))
+ (forward-thing 'url -1) ; Move backwards past the first URL.
+ (should (= (point) 1))
+ (forward-thing 'word) ; Move past the first word.
+ (should (= (point) 11))))
+
+(ert-deftest bounds-of-thing-at-point-providers ()
+ (with-temp-buffer
+ (setq-local
+ bounds-of-thing-at-point-provider-alist
+ `((url . ,(lambda ()
+ (bounds-of-thing-at-point-for-char-property 'foo-url)))
+ (url . ,(lambda ()
+ (bounds-of-thing-at-point-for-char-property 'bar-url)))))
+ (insert (propertize "hello" 'foo-url "foo.com") "there\ngoodbye")
+ (overlay-put (make-overlay 12 19) 'bar-url "bar.com")
+ (goto-char (point-min))
+ ;; Look for a URL, using the first provider above.
+ (should (equal (bounds-of-thing-at-point 'url) '(1 . 6)))
+ (should (eq (save-excursion (beginning-of-thing 'url)) 1))
+ (should (eq (save-excursion (end-of-thing 'url)) 6))
+ ;; Look for a word, which should *not* use our provider above.
+ (should (equal (bounds-of-thing-at-point 'word) '(1 . 11)))
+ (should (eq (save-excursion (beginning-of-thing 'word)) 1))
+ (should (eq (save-excursion (end-of-thing 'word)) 11))
+ (goto-char (point-max))
+ ;; Look for a URL, using the second provider above.
+ (should (equal (bounds-of-thing-at-point 'url) '(12 . 19)))
+ (should (eq (save-excursion (beginning-of-thing 'url)) 12))
+ (should (eq (save-excursion (end-of-thing 'url)) 19))))
+
+(ert-deftest consecutive-things-at-point ()
+ (with-temp-buffer
+ (setq-local
+ thing-at-point-provider-alist
+ `((url . ,(lambda () (thing-at-point-for-char-property 'url))))
+ forward-thing-provider-alist
+ `((url . ,(lambda (n) (forward-thing-for-char-property 'url n))))
+ bounds-of-thing-at-point-provider-alist
+ `((url . ,(lambda () (bounds-of-thing-at-point-for-char-property 'url)))))
+ (insert (propertize "one" 'url "foo.com")
+ (propertize "two" 'url "bar.com")
+ (propertize "three" 'url "baz.com"))
+ (goto-char 4) ; Go to the end of "one".
+ (should (equal (thing-at-point 'url) "bar.com"))
+ (should (equal (bounds-of-thing-at-point 'url) '(4 . 7)))
+ (forward-thing 'url)
+ (should (= (point) 7))
+ (should (equal (thing-at-point 'url) "baz.com"))
+ (should (equal (bounds-of-thing-at-point 'url) '(7 . 12)))
+ (forward-thing 'url)
+ (should (= (point) 12))
+ (forward-thing 'url -2)
+ (should (= (point) 4))
+ (should (equal (thing-at-point 'url) "bar.com"))
+ (should (equal (bounds-of-thing-at-point 'url) '(4 . 7)))))
+
;;; thingatpt-tests.el ends here
diff --git a/test/lisp/url/url-util-tests.el b/test/lisp/url/url-util-tests.el
index 133aa0ffd88..c6246d69a2a 100644
--- a/test/lisp/url/url-util-tests.el
+++ b/test/lisp/url/url-util-tests.el
@@ -32,7 +32,11 @@
("key1=val1;key2=val2;key3=val1;key3=val2;key4;key5"
((key1 "val1") (key2 val2) (key3 val1 val2) ("key4") (key5 "")) t)
("key1=val1;key2=val2;key3=val1;key3=val2;key4=;key5="
- ((key1 val1) (key2 val2) ("key3" val1 val2) (key4) (key5 "")) t
t)))
+ ((key1 val1) (key2 val2) ("key3" val1 val2) (key4) (key5 "")) t t)
+ ("key1=val/slash;key2=val%3Bsemi;key3=val%26amp;key4=val%3Deq"
+ ((key1 "val/slash") (key2 "val;semi") (key3 "val&") (key4
"val=eq")) t)
+ ("key%3Deq=val1;key%3Bsemi=val2;key%26amp=val3"
+ (("key=eq" val1) ("key;semi" val2) ("key&" val3)) t)))
test)
(while tests
(setq test (car tests)
diff --git a/test/lisp/use-package/use-package-tests.el
b/test/lisp/use-package/use-package-tests.el
index d1e68c2a790..76de29be471 100644
--- a/test/lisp/use-package/use-package-tests.el
+++ b/test/lisp/use-package/use-package-tests.el
@@ -2014,7 +2014,15 @@
(should (equal '(foo)
(use-package-normalize/:vc 'foo :vc nil)))
(should (equal '(bar)
- (use-package-normalize/:vc 'foo :vc '(bar)))))
+ (use-package-normalize/:vc 'foo :vc '(bar))))
+ (should (equal
+ '(foo (:ignored-files ("a" "b" "c")) :last-release)
+ (use-package-normalize/:vc 'foo :vc '((:ignored-files "a" "b"
"c")))))
+ (should (equal
+ (use-package-normalize/:vc 'foo :vc '((:ignored-files "a")))
+ (use-package-normalize/:vc 'foo :vc '((:ignored-files ("a"))))))
+ (should (equal (use-package-normalize/:vc 'foo :vc '((:ignored-files "a" "b"
"c")))
+ (use-package-normalize/:vc 'foo :vc '((:ignored-files ("a"
"b" "c")))))))
;; Local Variables:
;; no-byte-compile: t
diff --git a/test/lisp/vc/log-edit-tests.el b/test/lisp/vc/log-edit-tests.el
index 8373156587d..db60d21f137 100644
--- a/test/lisp/vc/log-edit-tests.el
+++ b/test/lisp/vc/log-edit-tests.el
@@ -344,4 +344,22 @@ next line instead.")
(let ((fill-column 20)) (log-edit-fill-entry))
(should (equal (buffer-string) wanted)))))
+(ert-deftest log-edit-fill-entry-no-defun-list-wrapping ()
+ ;; This test verifies that the opening defun list of an entry is never
+ ;; broken, even in the event its length in total exceeds the fill
+ ;; column.
+ (let (string wanted)
+ (setq string "
+* src/androidfns.c (Fxw_display_color_p):
+(Fx_display_grayscale_p): Report color and/or grayscale properly.
+"
+ wanted "
+* src/androidfns.c (Fxw_display_color_p, Fx_display_grayscale_p):
+Report color and/or grayscale properly.
+")
+ (with-temp-buffer
+ (insert string)
+ (let ((fill-column 64)) (log-edit-fill-entry))
+ (should (equal (buffer-string) wanted)))))
+
;;; log-edit-tests.el ends here
diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el
index 4b049478b29..d416eb99022 100644
--- a/test/lisp/wid-edit-tests.el
+++ b/test/lisp/wid-edit-tests.el
@@ -336,7 +336,13 @@ return nil, even with a non-nil bubblep argument."
(widget-forward 2)
(forward-char)
(widget-backward 1)
- (should (string= "Second" (widget-value (widget-at))))))
+ (should (string= "Second" (widget-value (widget-at))))
+ ;; Check that moving to a widget at beginning of buffer does not
+ ;; signal a beginning-of-buffer error (bug#69943).
+ (widget-backward 1) ; Should not signal beginning-of-buffer error.
+ (widget-forward 2)
+ (should (string= "Third" (widget-value (widget-at))))
+ (widget-forward 1))) ; Should not signal beginning-of-buffer error.
(ert-deftest widget-test-color-match ()
"Test that the :match function for the color widget works."
diff --git a/test/src/emacs-module-resources/mod-test.c
b/test/src/emacs-module-resources/mod-test.c
index 3aafae1b896..3abe2a4122b 100644
--- a/test/src/emacs-module-resources/mod-test.c
+++ b/test/src/emacs-module-resources/mod-test.c
@@ -46,6 +46,7 @@ uintptr_t _beginthread (void (__cdecl *) (void *), unsigned,
void *);
#include <gmp.h>
#include <emacs-module.h>
+extern int plugin_is_GPL_compatible;
int plugin_is_GPL_compatible;
#if INTPTR_MAX <= 0
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index 81eef37b903..750de8444c9 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -217,4 +217,10 @@ Also check that an encoding error can appear in a symlink."
(should (equal (expand-file-name file nil) file))
(file-name-case-insensitive-p file)))
+(ert-deftest fileio-tests-invalid-UNC ()
+ (skip-unless (eq system-type 'windows-nt))
+ ;; These should not crash, see bug#70914.
+ (should-not (file-exists-p "//"))
+ (should (file-attributes "//")))
+
;;; fileio-tests.el ends here
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 5ba7e49324a..ca5b10db705 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -1614,6 +1614,12 @@
;; strings
("" . "a") ("a" . "b") ("A" . "a") ("abc" . "abd")
("b" . "ba")
+ ;; strings again, but in a context where 3-way comparison
+ ;; matters
+ (("" . 2) . ("a" . 1))
+ (("å" . 2) . ("åü" . 1))
+ (("a" . 2) . ("aå" . 1))
+ (("\x80" . 2) . ("\x80å" . 1))
;; lists
((1 2 3) . (2 3 4)) ((2) . (2 1)) (() . (0))
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index 04b897045db..e968a19eadf 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -357,6 +357,13 @@ g .. h foo
"C-x <right>"))
(should (equal (key-description [M-H-right] [?\C-x])
"C-x M-H-<right>"))
+ ;; Treat latin-1 correctly vs meta. (Bug#59305)
+ (should (equal (key-description "olá")
+ "o l á"))
+ (should (equal (key-description (string ?o ?l ?á))
+ "o l á"))
+ (should (equal (key-description (unibyte-string ?o ?l ?á))
+ "o l M-a"))
(should (equal (single-key-description 'home)
"<home>"))
(should (equal (single-key-description 'home t)
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 4d7f8b71838..cc17f7eb3fa 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -174,6 +174,17 @@ literals (Bug#20852)."
(load "somelib" nil t)
(should (string-suffix-p "/somelib.el" (caar load-history)))))
+(ert-deftest lread-test-bug70702 ()
+ "Test for certain wholesome error messages from `read'."
+ (setq eval-expression-debug-on-error nil)
+ (setq ert-debug-on-error nil)
+ (with-temp-buffer
+ (goto-char (point-min))
+ (insert "#<symbol lambda at 10>")
+ (goto-char (point-min))
+ (should (equal (should-error (read (current-buffer)))
+ '(invalid-read-syntax "#<" 1 2)))))
+
(ert-deftest lread-lread--substitute-object-in-subtree ()
(let ((x (cons 0 1)))
(setcar x x)
diff --git a/test/src/textprop-tests.el b/test/src/textprop-tests.el
index d728b539955..7c2aa13bb34 100644
--- a/test/src/textprop-tests.el
+++ b/test/src/textprop-tests.el
@@ -68,5 +68,56 @@
(should (and (equal-including-properties (pop stack) string)
(null stack)))))
+(ert-deftest textprop-interval-immutability ()
+ "Test modification of text with properties affecting mutability."
+ (let ((template (concat
+ (propertize "12345" 'inhibit-read-only t) ; 1-5
+ (propertize "67890" 'read-only 'abcdefg) ; 6-10
+ (propertize "ABCDE" 'inhibit-read-only t) ; 11-15
+ (propertize "FGHIJ" 'inhibit-read-only 'yes) ; 16-20
+ "KLMNO" ; 21-25
+ (propertize "PQRST" 'inhibit-read-only 't) ; 26-30
+ (propertize "UVWXYZ" 'read-only 'not-suppressed)))
+ inhibit-read-only)
+ (with-temp-buffer
+ (insert template)
+ (setq buffer-read-only t)
+ ;; Delete an entire inhibit-read-only region.
+ (progn (should (equal (delete-and-extract-region 1 6)
+ "12345"))
+ (let ((inhibit-read-only t)) (erase-buffer)
+ (insert template)))
+ ;; Delete multiple characters inside an inhibit-read-only section.
+ (progn (should (equal (delete-and-extract-region 2 5)
+ "234"))
+ (let ((inhibit-read-only t)) (erase-buffer)
+ (insert template)))
+ ;; Attempt to delete characters across both an inhibit-read-only
+ ;; and a read only region.
+ (setq buffer-read-only nil)
+ (should-error (delete-and-extract-region 4 7))
+ (setq inhibit-read-only '(abcdefg))
+ ;; Attempt the same, but with the read-only property of the second
+ ;; section suppressed.
+ (progn (should (equal (delete-and-extract-region 4 7) "456"))
+ (let ((inhibit-read-only t)) (erase-buffer)
+ (insert template)))
+ (setq buffer-read-only t)
+ ;; Delete text across the suppressed read-only region and two
+ ;; other inhibit-read-only regions each with distinct intervals.
+ (progn (should (equal (delete-and-extract-region 7 17)
+ "7890ABCDEF"))
+ (let ((inhibit-read-only t)) (erase-buffer)
+ (insert template)))
+ (setq inhibit-read-only nil)
+ ;; Attempt to delete text spanning two inhibit-read-only sections
+ ;; separated by immutable text.
+ (should-error (delete-and-extract-region 17 27))
+ (setq inhibit-read-only '(abcdefg))
+ ;; Attempt to delete text from the start of an inhibit-read-only
+ ;; section extending into protected text exempt from
+ ;; `inhibit-read-only''s influence towards the end of the buffer.
+ (should-error (delete-and-extract-region 26 37)))))
+
(provide 'textprop-tests)
;;; textprop-tests.el ends here