[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/etags-regen 87ab046 2/4: Merge branch 'master' into scratch/etag
|
From: |
Dmitry Gutov |
|
Subject: |
scratch/etags-regen 87ab046 2/4: Merge branch 'master' into scratch/etags-regen |
|
Date: |
Mon, 6 Sep 2021 11:17:35 -0400 (EDT) |
branch: scratch/etags-regen
commit 87ab04638ea3da11a0adaf741256842c22055b72
Merge: 9cf8957 adab672
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: Dmitry Gutov <dgutov@yandex.ru>
Merge branch 'master' into scratch/etags-regen
---
Makefile.in | 1 +
admin/merge-gnulib | 2 +-
configure.ac | 36 +-
doc/emacs/back.texi | 102 +
doc/emacs/book-spine.texi | 20 +
doc/emacs/buffers.texi | 3 -
doc/emacs/custom.texi | 20 +-
doc/emacs/dired.texi | 9 +
doc/emacs/display.texi | 4 +-
doc/emacs/emacs.texi | 4 +-
doc/emacs/files.texi | 21 +-
doc/emacs/frames.texi | 7 +-
doc/emacs/maintaining.texi | 10 +-
doc/emacs/misc.texi | 14 +-
doc/emacs/modes.texi | 10 +-
doc/emacs/msdos.texi | 9 -
doc/emacs/mule.texi | 6 +-
doc/emacs/search.texi | 11 +
doc/emacs/text.texi | 9 +-
doc/lispref/buffers.texi | 4 +-
doc/lispref/commands.texi | 14 +-
doc/lispref/control.texi | 10 +
doc/lispref/display.texi | 9 +-
doc/lispref/errors.texi | 9 +-
doc/lispref/eval.texi | 3 +-
doc/lispref/files.texi | 91 +-
doc/lispref/functions.texi | 11 +-
doc/lispref/hooks.texi | 2 +-
doc/lispref/intro.texi | 2 +-
doc/lispref/lists.texi | 4 +-
doc/lispref/minibuf.texi | 12 +
doc/lispref/modes.texi | 33 +-
doc/lispref/objects.texi | 7 +
doc/lispref/os.texi | 5 +
doc/lispref/package.texi | 9 +-
doc/lispref/processes.texi | 10 +
doc/lispref/text.texi | 40 +-
doc/lispref/tips.texi | 11 +-
doc/lispref/variables.texi | 14 +
doc/misc/bovine.texi | 25 +-
doc/misc/efaq.texi | 34 +
doc/misc/erc.texi | 72 +-
doc/misc/gnus-faq.texi | 2 +-
doc/misc/gnus.texi | 33 +-
doc/misc/message.texi | 2 +-
doc/misc/mh-e.texi | 104 +-
doc/misc/modus-themes.org | 1291 ++++++----
doc/misc/pcl-cvs.texi | 2 +-
doc/misc/rcirc.texi | 41 +-
doc/misc/smtpmail.texi | 22 +-
doc/misc/srecode.texi | 2 +-
doc/misc/tramp.texi | 38 +-
doc/misc/trampver.texi | 2 +-
doc/misc/wisent.texi | 6 +-
etc/NEWS | 440 +++-
etc/NEWS.27 | 23 +
etc/refcards/pl-refcard.tex | 2 +-
etc/refcards/refcard.tex | 2 +-
etc/themes/modus-operandi-theme.el | 2 +-
etc/themes/modus-themes.el | 2523 +++++++++++++-------
etc/themes/modus-vivendi-theme.el | 2 +-
lib-src/emacsclient.c | 226 +-
lib-src/etags.c | 49 +-
lib-src/movemail.c | 14 +-
lib/file-has-acl.c | 510 ++++
lib/gnulib.mk.in | 11 +
lisp/ansi-color.el | 32 +
lisp/apropos.el | 42 +-
lisp/autorevert.el | 4 +
lisp/battery.el | 4 +-
lisp/bindings.el | 13 +-
lisp/bookmark.el | 34 +-
lisp/button.el | 1 +
lisp/calendar/cal-bahai.el | 2 +-
lisp/calendar/cal-coptic.el | 2 +-
lisp/calendar/cal-dst.el | 8 +-
lisp/calendar/cal-french.el | 192 +-
lisp/calendar/cal-persia.el | 2 +-
lisp/calendar/calendar.el | 14 +-
lisp/calendar/diary-lib.el | 18 +-
lisp/calendar/holidays.el | 2 +-
lisp/calendar/icalendar.el | 4 +-
lisp/calendar/solar.el | 2 +-
lisp/calendar/todo-mode.el | 8 +-
lisp/comint.el | 17 +-
lisp/completion.el | 104 +-
lisp/cus-edit.el | 13 +-
lisp/cus-start.el | 43 +-
lisp/custom.el | 2 +-
lisp/delsel.el | 2 +-
lisp/desktop.el | 10 +-
lisp/dired-x.el | 50 +-
lisp/dired.el | 82 +-
lisp/dnd.el | 1 +
lisp/emacs-lisp/autoload.el | 9 +-
lisp/emacs-lisp/bindat.el | 24 +-
lisp/emacs-lisp/byte-opt.el | 168 +-
lisp/emacs-lisp/bytecomp.el | 63 +-
lisp/emacs-lisp/cconv.el | 166 +-
lisp/emacs-lisp/cl-generic.el | 12 +-
lisp/emacs-lisp/cl-lib.el | 105 -
lisp/emacs-lisp/cl-macs.el | 8 +
lisp/emacs-lisp/comp.el | 4 +-
lisp/emacs-lisp/copyright.el | 15 +-
lisp/emacs-lisp/disass.el | 2 +
lisp/emacs-lisp/easy-mmode.el | 5 +-
lisp/emacs-lisp/edebug.el | 18 +-
lisp/emacs-lisp/eieio-core.el | 13 +-
lisp/emacs-lisp/eieio.el | 40 +-
lisp/emacs-lisp/gv.el | 100 +
lisp/emacs-lisp/macroexp.el | 43 +-
lisp/emacs-lisp/map.el | 8 +-
lisp/emacs-lisp/memory-report.el | 2 +
lisp/emacs-lisp/package.el | 44 +-
lisp/emacs-lisp/radix-tree.el | 2 +-
lisp/emacs-lisp/re-builder.el | 15 +-
lisp/emacs-lisp/seq.el | 15 +-
lisp/emacs-lisp/shadow.el | 9 +-
lisp/emacs-lisp/shortdoc.el | 64 +-
lisp/emacs-lisp/tabulated-list.el | 68 +-
lisp/erc/erc-backend.el | 2 +-
lisp/erc/erc-button.el | 5 +-
lisp/erc/erc-ibuffer.el | 2 +-
lisp/erc/erc-networks.el | 14 +-
lisp/erc/erc-services.el | 17 +-
lisp/erc/erc-stamp.el | 51 +-
lisp/erc/erc.el | 15 +-
lisp/eshell/em-dirs.el | 5 +-
lisp/eshell/em-hist.el | 5 +-
lisp/facemenu.el | 12 +-
lisp/faces.el | 49 +-
lisp/ffap.el | 55 +-
lisp/filecache.el | 35 +-
lisp/fileloop.el | 5 +-
lisp/files.el | 439 ++--
lisp/frame.el | 14 +-
lisp/gnus/gnus-art.el | 28 +-
lisp/gnus/gnus-group.el | 95 +-
lisp/gnus/gnus-msg.el | 4 +
lisp/gnus/gnus-search.el | 140 +-
lisp/gnus/gnus-srvr.el | 21 +-
lisp/gnus/gnus.el | 31 +-
lisp/gnus/message.el | 29 +-
lisp/gnus/mm-view.el | 27 +-
lisp/gnus/nnimap.el | 7 +
lisp/help-fns.el | 16 +-
lisp/help-mode.el | 18 +-
lisp/help.el | 7 +-
lisp/hi-lock.el | 2 +-
lisp/hilit-chg.el | 24 +-
lisp/icomplete.el | 18 +-
lisp/ido.el | 4 +
lisp/image.el | 4 +-
lisp/image/image-converter.el | 12 +-
lisp/info.el | 83 +-
lisp/isearch.el | 11 +-
lisp/jka-cmpr-hook.el | 29 +-
lisp/jka-compr.el | 123 +-
lisp/ldefs-boot.el | 69 +-
lisp/ls-lisp.el | 74 +-
lisp/mail/rmailsum.el | 3 +-
lisp/mail/smtpmail.el | 94 +-
lisp/menu-bar.el | 4 +-
lisp/mh-e/ChangeLog.1 | 2 +-
lisp/mh-e/mh-e.el | 40 +-
lisp/mh-e/mh-folder.el | 105 +-
lisp/mh-e/mh-funcs.el | 4 +-
lisp/mh-e/mh-junk.el | 197 +-
lisp/mh-e/mh-scan.el | 34 +-
lisp/mh-e/mh-search.el | 22 +-
lisp/mh-e/mh-show.el | 9 +-
lisp/minibuffer.el | 22 +-
lisp/mouse.el | 4 +-
lisp/mwheel.el | 48 +-
lisp/net/mailcap.el | 19 +-
lisp/net/rcirc.el | 1438 +++++++----
lisp/net/shr.el | 41 +-
lisp/net/tramp-adb.el | 39 +-
lisp/net/tramp-archive.el | 4 +
lisp/net/tramp-cache.el | 6 +-
lisp/net/tramp-compat.el | 24 +
lisp/net/tramp-crypt.el | 23 +
lisp/net/tramp-fuse.el | 17 +-
lisp/net/tramp-gvfs.el | 24 +-
lisp/net/tramp-rclone.el | 8 +
lisp/net/tramp-sh.el | 54 +-
lisp/net/tramp-smb.el | 34 +-
lisp/net/tramp-sshfs.el | 44 +-
lisp/net/tramp-sudoedit.el | 31 +-
lisp/net/tramp.el | 178 +-
lisp/net/trampver.el | 6 +-
lisp/newcomment.el | 20 +-
lisp/org/ol-irc.el | 6 +-
lisp/org/org-agenda.el | 2 +-
lisp/outline.el | 1 -
lisp/pcmpl-unix.el | 3 +-
lisp/progmodes/bug-reference.el | 57 +-
lisp/progmodes/cmacexp.el | 2 +-
lisp/progmodes/compile.el | 18 +-
lisp/progmodes/elisp-mode.el | 10 +-
lisp/progmodes/etags.el | 35 +-
lisp/progmodes/flymake.el | 14 +-
lisp/progmodes/gdb-mi.el | 98 +-
lisp/progmodes/grep.el | 9 +-
lisp/progmodes/gud.el | 147 +-
lisp/progmodes/inf-lisp.el | 8 +-
lisp/progmodes/make-mode.el | 4 +-
lisp/progmodes/perl-mode.el | 17 +-
lisp/progmodes/project.el | 31 +-
lisp/progmodes/prolog.el | 103 +-
lisp/progmodes/python.el | 18 +-
lisp/progmodes/sh-script.el | 4 +-
lisp/progmodes/verilog-mode.el | 1 -
lisp/progmodes/xref.el | 13 +-
lisp/ps-print.el | 5 +-
lisp/repeat.el | 10 +-
lisp/replace.el | 361 ++-
lisp/saveplace.el | 12 +-
lisp/select.el | 16 +-
lisp/shadowfile.el | 21 +-
lisp/shell.el | 10 +
lisp/simple.el | 56 +-
lisp/so-long.el | 231 +-
lisp/speedbar.el | 4 +-
lisp/startup.el | 1 +
lisp/subr.el | 25 +-
lisp/tab-bar.el | 7 +-
lisp/tab-line.el | 5 +-
lisp/term.el | 30 +-
lisp/textmodes/enriched.el | 4 +-
lisp/textmodes/fill.el | 11 +-
lisp/textmodes/ispell.el | 6 +-
lisp/textmodes/remember.el | 18 +-
lisp/textmodes/tex-mode.el | 31 +-
lisp/thingatpt.el | 35 +-
lisp/time.el | 3 +-
lisp/url/url-util.el | 7 +-
lisp/url/url.el | 135 +-
lisp/userlock.el | 2 +-
lisp/vc/ediff-util.el | 5 +-
lisp/vc/smerge-mode.el | 3 +
lisp/vc/vc-git.el | 4 +-
lisp/wdired.el | 122 +-
lisp/whitespace.el | 2 +-
lisp/window.el | 12 +-
lisp/woman.el | 6 +-
m4/gnulib-comp.m4 | 3 +
nt/gnulib-cfg.mk | 1 +
oldXMenu/Create.c | 2 +
oldXMenu/Internal.c | 31 +-
oldXMenu/XMakeAssoc.c | 2 +
src/Makefile.in | 7 +-
src/alloc.c | 44 +-
src/buffer.c | 38 +-
src/callint.c | 5 +-
src/callproc.c | 25 +-
src/chartab.c | 104 +-
src/cmds.c | 2 +-
src/coding.c | 2 +-
src/data.c | 10 +-
src/dispnew.c | 12 +-
src/editfns.c | 9 +-
src/emacs.c | 4 +-
src/eval.c | 18 +-
src/fileio.c | 127 +-
src/filelock.c | 213 +-
src/fns.c | 12 +-
src/fontset.c | 6 +-
src/frame.c | 20 +-
src/frame.h | 8 +-
src/ftfont.c | 21 +
src/gtkutil.c | 2 +-
src/image.c | 19 +-
src/insdel.c | 11 +-
src/json.c | 25 +-
src/keyboard.c | 91 +-
src/lisp.h | 9 +-
src/macros.c | 2 +-
src/minibuf.c | 24 +-
src/nsfns.m | 4 -
src/nsfont.m | 44 +-
src/nsimage.m | 49 +-
src/nsmenu.m | 20 +-
src/nsterm.h | 84 +-
src/nsterm.m | 1401 +++++------
src/process.c | 7 +-
src/process.h | 2 +-
src/search.c | 6 +-
src/sysdep.c | 136 +-
src/thread.c | 17 +
src/window.c | 16 +-
src/xdisp.c | 115 +-
src/xfaces.c | 83 +-
src/xfns.c | 10 +-
src/xfont.c | 5 +-
src/xftfont.c | 6 +
test/Makefile.in | 7 +-
test/lisp/autorevert-tests.el | 6 +
test/lisp/calendar/cal-french-tests.el | 113 +
test/lisp/dired-x-tests.el | 13 +
.../bytecomp-resources/warn-callargs-defsubst.el | 5 +
test/lisp/emacs-lisp/bytecomp-tests.el | 36 +
test/lisp/emacs-lisp/checkdoc-tests.el | 8 +-
test/lisp/emacs-lisp/cl-generic-tests.el | 6 +-
test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | 16 +-
test/lisp/emacs-lisp/package-tests.el | 68 +
test/lisp/emacs-lisp/pcase-tests.el | 10 +
test/lisp/ffap-tests.el | 19 +
test/lisp/filenotify-tests.el | 2 +-
test/lisp/files-resources/.dir-locals.el | 5 +
test/lisp/files-resources/auto-test.zot1 | 1 +
test/lisp/files-resources/auto-test.zot2 | 1 +
test/lisp/files-resources/auto-test.zot3 | 1 +
test/lisp/files-resources/whatever.quux | 2 +
test/lisp/files-tests.el | 71 +-
test/lisp/gnus/gnus-search-tests.el | 4 +-
test/lisp/net/tramp-archive-tests.el | 4 +-
test/lisp/net/tramp-tests.el | 211 +-
test/lisp/progmodes/compile-tests.el | 47 +-
test/lisp/progmodes/perl-mode-tests.el | 7 +
test/lisp/replace-tests.el | 20 +-
test/lisp/shadowfile-tests.el | 19 +-
test/lisp/shell-tests.el | 19 +
test/lisp/so-long-tests/so-long-tests-helpers.el | 32 +-
test/lisp/so-long-tests/so-long-tests.el | 265 +-
test/lisp/so-long-tests/spelling-tests.el | 2 +-
test/lisp/subr-tests.el | 2 +-
test/lisp/thingatpt-tests.el | 33 +
test/lisp/time-stamp-tests.el | 11 +-
test/lisp/time-tests.el | 1 +
test/src/buffer-tests.el | 42 +-
test/src/emacs-module-resources/mod-test.c | 4 +
test/src/fileio-tests.el | 22 +
test/src/process-tests.el | 32 +
test/src/search-tests.el | 42 +
335 files changed, 12163 insertions(+), 5768 deletions(-)
diff --git a/Makefile.in b/Makefile.in
index 97d954b..235b707 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -789,6 +789,7 @@ install-etc:
### Install native compiled Lisp files.
install-eln: lisp
ifeq ($(HAVE_NATIVE_COMP),yes)
+ umask 022 ; \
find native-lisp -type d -exec $(MKDIR_P) "$(ELN_DESTDIR){}" \; ; \
find native-lisp -type f -exec ${INSTALL_DATA} "{}" "$(ELN_DESTDIR){}"
\;
endif
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index 1c8b442..c12e83d 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -33,7 +33,7 @@ GNULIB_MODULES='
crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer
crypto/sha512-buffer
d-type diffseq double-slash-root dtoastr dtotimespec dup2
environ execinfo explicit_bzero faccessat
- fchmodat fcntl fcntl-h fdopendir
+ fchmodat fcntl fcntl-h fdopendir file-has-acl
filemode filename filevercmp flexmember fpieee
free-posix fstatat fsusage fsync futimens
getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog
diff --git a/configure.ac b/configure.ac
index c924634..be97d9c 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1334,6 +1334,9 @@ if test -n "$BREW"; then
[`$BREW --prefix texinfo 2>/dev/null`/bin$PATH_SEPARATOR$PATH])
fi
+# Check MacPorts on macOS.
+AC_PATH_PROG(HAVE_MACPORTS, port)
+
## Require makeinfo >= 4.13 (last of the 4.x series) to build the manuals.
: ${MAKEINFO:=makeinfo}
case `($MAKEINFO --version) 2>/dev/null` in
@@ -3807,7 +3810,8 @@ source on this site:
<https://gcc.gnu.org/wiki/JIT>.])])
HAVE_NATIVE_COMP=no
-LIBGCCJIT_LIB=
+LIBGCCJIT_LIBS=
+LIBGCCJIT_CFLAGS=
if test "${with_native_compilation}" != "no"; then
if test "${HAVE_PDUMPER}" = no; then
AC_MSG_ERROR(['--with-nativecomp' requires '--with-dumping=pdumper'])
@@ -3827,6 +3831,20 @@ if test "${with_native_compilation}" != "no"; then
fi
fi
+ # Ensure libgccjit installed by MacPorts can be found.
+ if test -n "$HAVE_MACPORTS"; then
+ # Determine which gcc version has been installed (gcc11, for
+ # instance).
+ PORT_PACKAGE=$(port installed active | grep '^ *gcc@<:@0-9@:>@* ' | \
+ awk '{ print $1; }')
+ MACPORTS_LIBGCCJIT_INCLUDE=$(dirname $(port contents $PORT_PACKAGE | \
+ grep libgccjit.h))
+ MACPORTS_LIBGCCJIT_LIB=$(dirname $(port contents $PORT_PACKAGE | \
+ grep libgccjit.dylib))
+ CFLAGS="$CFLAGS -I${MACPORTS_LIBGCCJIT_INCLUDE}"
+ LDFLAGS="$LDFLAGS -L${MACPORTS_LIBGCCJIT_LIB}"
+ fi
+
# Check if libgccjit is available.
AC_CHECK_LIB(gccjit, gcc_jit_context_acquire, [], [libgccjit_not_found])
AC_CHECK_HEADERS(libgccjit.h, [], [libgccjit_dev_not_found])
@@ -3841,17 +3859,24 @@ if test "${with_native_compilation}" != "no"; then
mingw32) ;;
# OpenBSD doesn't have libdl, all the functions are in libc
netbsd|openbsd)
- LIBGCCJIT_LIB="-lgccjit" ;;
+ LIBGCCJIT_LIBS="-lgccjit" ;;
*)
- LIBGCCJIT_LIB="-lgccjit -ldl" ;;
+ LIBGCCJIT_LIBS="-lgccjit -ldl" ;;
esac
NEED_DYNLIB=yes
AC_DEFINE(HAVE_NATIVE_COMP, 1, [Define to 1 if native compiler is
available.])
+
+ # Ensure libgccjit installed by MacPorts can be found.
+ if test -n "$HAVE_MACPORTS"; then
+ LIBGCCJIT_CFLAGS="$LIBGCCJIT_CFLAGS -I${MACPORTS_LIBGCCJIT_INCLUDE}"
+ LIBGCCJIT_LIBS="-L${MACPORTS_LIBGCCJIT_LIB} $LIBGCCJIT_LIBS"
+ fi
fi
AC_DEFINE_UNQUOTED(NATIVE_ELISP_SUFFIX, ".eln",
[System extension for native compiled elisp])
AC_SUBST(HAVE_NATIVE_COMP)
-AC_SUBST(LIBGCCJIT_LIB)
+AC_SUBST(LIBGCCJIT_CFLAGS)
+AC_SUBST(LIBGCCJIT_LIBS)
DYNLIB_OBJ=
if test "${NEED_DYNLIB}" = yes; then
@@ -5660,7 +5685,8 @@ case "$opsys" in
if test "$HAVE_NS" = "yes"; then
libs_nsgui="-framework AppKit"
if test "$NS_IMPL_COCOA" = "yes"; then
- libs_nsgui="$libs_nsgui -framework IOKit -framework Carbon -framework
IOSurface"
+ libs_nsgui="$libs_nsgui -framework IOKit -framework Carbon \
+ -framework IOSurface -framework QuartzCore"
fi
else
libs_nsgui=
diff --git a/doc/emacs/back.texi b/doc/emacs/back.texi
new file mode 100644
index 0000000..dc4e218
--- /dev/null
+++ b/doc/emacs/back.texi
@@ -0,0 +1,102 @@
+\input texinfo @c -*-texinfo-*-
+@c This is part of the Emacs manual.
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
+@c Foundation, Inc.
+@c See file emacs.texi for copying conditions.
+@c
+@c %**start of header
+@setfilename back-cover
+@settitle GNU Emacs Manual
+@include docstyle.texi
+@c %**end of header
+.
+@sp 7
+@center @titlefont {GNU Emacs Manual}
+@sp 1
+
+@quotation
+GNU Emacs is much @strong{more than a text editor;} over the years, it
+has expanded to become @strong{an entire workflow environment,}
+impressing programmers with its integrated debugging and
+project-management features. It is also a multi-lingual word
+processor, can handle all your email and Usenet news needs, display
+web pages, and even has a diary and a calendar for your appointments!
+
+Features include:
+
+@itemize @bullet
+@item
+Special editing modes for @strong{27 programming languages,} including C,
+C@t{++}, Fortran, Java, JavaScript, Lisp, Objective C, Pascal, Perl,
+and Scheme.
+
+@item
+Special @strong{scripting language modes} for Bash, other common shells,
+and creating Makefiles for GNU/Linux, UNIX, Windows/DOS, and VMS
+systems.
+
+@item
+Support for typing and displaying in @strong{60 non-English languages,}
+including Arabic, Chinese, Czech, Hebrew, Hindi, Japanese, Korean,
+Russian, Vietnamese, and all Western European languages.
+
+@item
+The ability to:
+
+@itemize @minus
+@item
+Create @strong{PostScript output} from plain-text files (special
+editing modes for @LaTeX{} and @TeX{} are included).
+
+
+@item
+@strong{Compile} and @strong{debug} from inside Emacs.
+
+@item
+Maintain program @strong{ChangeLogs.}
+
+@item
+Flag, move, and delete files and sub-directories recursively
+@strong{(directory navigation).}
+
+@item
+Run @strong{shell commands} from inside Emacs, or even use Emacs itself
+as a shell (Eshell).
+
+@item
+Enjoy the use of extensive @strong{merge} and @strong{diff} functions.
+
+@item
+Take advantage of built-in support for many @strong{version control
+systems,} including Git, Mercurial, Bazaar, Subversion, and CVS.
+
+@item
+And much more!
+@end itemize
+@end itemize
+
+Emacs comes with an introductory online tutorial available in many
+languages, and this nineteenth edition of the manual picks up where
+that tutorial ends. It explains the full range of the power of Emacs,
+now up to @strong[version 27.2,} and contains reference material
+useful to expert users. It also includes appendices with specific
+material about X and GTK resources, and with details for users of
+macOS and Microsoft Windows.
+
+And when you tire of all the work you can accomplish with Emacs, enjoy
+the games that come with it.
+
+@strong{About the original and principal author:}
+
+Richard M.@: Stallman developed the first Emacs in 1976 and wrote GNU
+Emacs in 1984/85. He has received the ACM Grace Hopper Award, a
+MacArthur Foundation fellowship, the Electronic Frontier Foundation's
+Pioneer award, the Takeda Award for Social/Economic Betterment, and
+the ACM Software and System Award, as well as several doctorates
+@emph{honoris causa.}
+@end quotation
+
+@hfil
+@bye
+
++++++++++++++++++++++++++++++++++++++++++++++++++++++++
diff --git a/doc/emacs/book-spine.texi b/doc/emacs/book-spine.texi
new file mode 100644
index 0000000..9634cce
--- /dev/null
+++ b/doc/emacs/book-spine.texi
@@ -0,0 +1,20 @@
+\input texinfo @c -*-texinfo-*-
+@c %**start of header
+@setfilename book-spine
+@settitle book-spine
+@include docstyle.texi
+@c %**end of header
+
+@include emacsver.texi
+
+@c need dot in text so first space command works!
+.
+@sp 7
+
+@center @titlefont{GNU Emacs Manual}
+@sp 5
+@center @value{EDITION} edition, for Emacs version @value{EMACSVER}
+@sp 5
+
+@center by Richard M.@: Stallman et al.
+@bye
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index bec7f37..c4e5bc3 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -586,9 +586,6 @@ every @code{auto-revert-interval} seconds if you enable
Auto Revert
mode in this buffer, as long as it is not marked modified. Global
Auto Revert mode applies to the @file{*Buffer List*} buffer only if
@code{global-auto-revert-non-file-buffers} is non-@code{nil}.
-@iftex
-@inforef{Auto Reverting the Buffer Menu,, emacs-xtra}, for details.
-@end iftex
@ifnottex
@xref{Auto Reverting the Buffer Menu, global-auto-revert-non-file-buffers},
for details.
@end ifnottex
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index bd505d2..999234e 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -623,7 +623,7 @@ button.
the theme file and asks if you really want to load it. Because
loading a Custom theme can execute arbitrary Lisp code, you should
only say yes if you know that the theme is safe; in that case, Emacs
-offers to remember in the future that the theme is safe (this is done
+offers to remember in the future that the theme is safe(this is done
by saving the theme file's SHA-256 hash to the variable
@code{custom-safe-themes}; if you want to treat all themes as safe,
change its value to @code{t}). Themes that come with Emacs (in the
@@ -1271,7 +1271,13 @@ confirmation prompt. When Emacs encounters these
variable/value pairs
subsequently, in the same file or others, it will assume they are
safe.
+ You can also tell Emacs to permanently ignore all the variable/value
+pairs in the file, by typing @kbd{i} at the confirmation prompt --
+these pairs will thereafter be ignored in this file and in all other
+files.
+
@vindex safe-local-variable-values
+@vindex ignored-local-variable-values
@cindex risky variable
Some variables, such as @code{load-path}, are considered
particularly @dfn{risky}: there is seldom any reason to specify them
@@ -1283,6 +1289,8 @@ can enter @kbd{!} at the prompt. It applies all the
variables, but only
marks the non-risky ones as safe for the future. If you really want to
record safe values for risky variables, do it directly by customizing
@samp{safe-local-variable-values} (@pxref{Easy Customization}).
+Similarly, if you want to record values of risky variables that should
+be permanently ignored, customize @code{ignored-local-variable-values}.
@vindex enable-local-variables
The variable @code{enable-local-variables} allows you to change the
@@ -1407,6 +1415,16 @@ meanings as they would have in file local variables.
@code{coding}
cannot be specified as a directory local variable. @xref{File
Variables}.
+The special key @code{auto-mode-alist} in a @file{.dir-locals.el} lets
+you set a file's major mode. It works much like the variable
+@code{auto-mode-alist} (@pxref{Choosing Modes}). For example, here is
+how you can tell Emacs that @file{.def} source files in this directory
+should be in C mode:
+
+@example
+((auto-mode-alist . (("\\.def\\'" . c-mode))))
+@end example
+
@findex add-dir-local-variable
@findex delete-dir-local-variable
@findex copy-file-locals-to-dir-locals
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 3625703..3fbaf8b 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -457,6 +457,15 @@ Visit the parent directory of the current directory
for @file{..} and typing @kbd{f} there.
@end table
+@defopt dired-kill-when-opening-new-dired-buffer
+ When visiting a new sub-directory in Dired, Emacs will (by default)
+open a new buffer to display this new directory, and leave the old
+Dired buffer as is. If this user option is non-@code{nil}, the old
+Dired buffer will be killed after selecting the new directory. This
+means that if you're traversing a directory structure in Dired, you
+won't end up with more than a single Dired buffer.
+@end defopt
+
@node Marks vs Flags
@section Dired Marks vs.@: Flags
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index f6c422a..ae345c1 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -1189,8 +1189,8 @@ that has some special meaning for formatting the source
code of a
program.
To activate the fill-column indication display, use the minor modes
-@kbd{M-x display-fill-@-column-indicator-mode} and
-@kbd{M-x global-display-fill-column-indicator-mode}, which enable
+@code{display-fill-@-column-indicator-mode} and
+@code{global-display-fill-column-indicator-mode}, which enable
the indicator locally or globally, respectively.
Alternatively, you can set the two buffer-local variables
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 9f64456..d2011eb 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -92,10 +92,10 @@ developing GNU and promoting software freedom.''
Published by the Free Software Foundation @*
51 Franklin Street, Fifth Floor @*
Boston, MA 02110-1301 USA @*
-ISBN 978-0-9831592-5-4
+ISBN 978-0-9831592-8-5
@sp 2
-Cover art by Etienne Suvasa; cover design by Matt Lee.
+Cover art by Etienne Suvasa; cover design by FSF staff.
@end titlepage
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 912980b..7edf4d2 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -227,6 +227,15 @@ File Names}, for information on how to visit a file whose
name
actually contains wildcard characters. You can disable the wildcard
feature by customizing @code{find-file-wildcards}.
+@vindex query-about-changed-file
+ If you're asking to visit a file that's already visited in a buffer,
+but the file has changed externally, Emacs normally asks you whether
+you want to re-read the file from disk. But if you set
+@code{query-about-changed-file} to @code{nil}, Emacs won't query you,
+but will instead just display the buffer's contents before the
+changes, and show an echo-area message telling you how to revert the
+buffer from the file.
+
@kindex C-x C-v
@findex find-alternate-file
If you visit the wrong file unintentionally by typing its name
@@ -789,7 +798,9 @@ Emacs buffer visiting it has unsaved changes.
@vindex create-lockfiles
You can prevent the creation of lock files by setting the variable
@code{create-lockfiles} to @code{nil}. @strong{Caution:} by
-doing so you will lose the benefits that this feature provides.
+doing so you will lose the benefits that this feature provides. You
+can also control where lock files are written by using the
+@code{lock-file-name-transforms} variable.
@cindex collision
If you begin to modify the buffer while the visited file is locked by
@@ -834,6 +845,14 @@ warning message and asks for confirmation before saving;
answer
place, one way to compare the buffer to its file is the @kbd{M-x
diff-buffer-with-file} command. @xref{Comparing Files}.
+@vindex remote-file-name-inhibit-locks
+ You can prevent the creation of remote lock files by setting the
+variable @code{remote-file-name-inhibit-locks} to @code{t}.
+
+@cindex lock-file-mode
+ The minor mode @code{lock-file-mode}, called interactively, toggles
+the local value of @code{create-lockfiles} in the current buffer.
+
@node File Shadowing
@subsection Shadowing Files
@cindex shadow files
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index 70615f6..951e090 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -480,9 +480,10 @@ frame. This runs @code{find-file-read-only-other-frame}.
@xref{Visiting}.
@item C-x 5 5
-A more general prefix command affects the buffer displayed by the next
-command invoked immediately after this prefix command. It requests
-the buffer of the next command to be displayed in another frame.
+A more general prefix command that affects the buffer displayed by the
+next command invoked immediately after this prefix command
+(@code{other-frame-prefix}). It requests the buffer of the next
+command to be displayed in another frame.
@end table
You can control the appearance and behavior of the newly-created
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index a91bfac..3205e6d 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -3132,10 +3132,12 @@ one is able to set the variables.
Setup for version-controlled files configurable by the variable
@code{bug-reference-setup-from-vc-alist}. The default is able to
setup GNU projects where @url{https://debbugs.gnu.org} is used as
-issue tracker, Github projects where both bugs and pull requests are
-referenced using the @code{#42} notation, and GitLab projects where
-bugs are references with @code{#17}, too, but merge requests use the
-@code{!18} notation.
+issue tracker and issues are usually referenced as @code{bug#13} (but
+many different notations are considered, too), Sourcehut projects
+where issues are referenced using the notation @code{#17}, Codeberg
+and Github projects where both bugs and pull requests are referenced
+using the same notation, and GitLab projects where bugs are referenced
+with @code{#17}, too, but merge requests use the @code{!18} notation.
@item
Setup for email guessing from mail folder/mbox names, and mail header
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 3c11a39..8bf1032 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -163,14 +163,13 @@ List killed groups (@code{gnus-group-list-killed}).
List zombie groups (@code{gnus-group-list-zombies}).
@kindex u @r{(Gnus Group mode)}
-@findex gnus-group-unsubscribe-current-group
+@findex gnus-group-toggle-subscription
@cindex subscribe groups
@cindex unsubscribe groups
@item u
Toggle the subscription status of the group
-(@code{gnus-group-unsubscribe-current-group}) on the current line
-(i.e., turn a subscribed group into an unsubscribed group, or vice
-versa). Invoking this on a killed or zombie group turns it into an
+(@code{gnus-group-toggle-subscription}) on the current line.
+Invoking this on a killed or zombie group turns it into an
unsubscribed group.
@kindex C-k @r{(Gnus Group mode)}
@@ -1021,7 +1020,10 @@ pending in the shell buffer and not yet sent.
@findex comint-delete-output
Delete the last batch of output from a shell command
(@code{comint-delete-output}). This is useful if a shell command spews
-out lots of output that just gets in the way.
+out lots of output that just gets in the way. With a prefix argument,
+this command saves the deleted text in the @code{kill-ring}
+(@pxref{Kill Ring}), so that you could later yank it (@pxref{Yanking})
+elsewhere.
@item C-c C-s
@kindex C-c C-s @r{(Shell mode)}
@@ -2031,7 +2033,7 @@ evaluation performed is for side-effect rather than
result.
Connect to the Emacs server named @var{server-name}. (This option is
not supported on MS-Windows.) The server name is given by the
variable @code{server-name} on the Emacs server. If this option is
-omitted, @command{emacsclient} connects to the first server it finds.
+omitted, @command{emacsclient} connects to the default socket.
If you set @code{server-name} of the Emacs server to an absolute file
name, give the same absolute file name as @var{server-name} to this
option to instruct @command{emacsclient} to connect to that server.
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
index cc25d3e..9014221 100644
--- a/doc/emacs/modes.texi
+++ b/doc/emacs/modes.texi
@@ -357,8 +357,12 @@ preferences. If you personally want to use a minor mode
for a
particular file type, it is better to enable the minor mode via a
major mode hook (@pxref{Major Modes}).
+ Second, Emacs checks whether the file's extension matches an entry
+in any directory-local @code{auto-mode-alist}. These are found using
+the @file{.dir-locals.el} facility (@pxref{Directory Variables}).
+
@vindex interpreter-mode-alist
- Second, if there is no file variable specifying a major mode, Emacs
+ Third, if there is no file variable specifying a major mode, Emacs
checks whether the file's contents begin with @samp{#!}. If so, that
indicates that the file can serve as an executable shell command,
which works by running an interpreter named on the file's first line
@@ -376,7 +380,7 @@ same is true for man pages which start with the magic string
@samp{'\"} to specify a list of troff preprocessors.
@vindex magic-mode-alist
- Third, Emacs tries to determine the major mode by looking at the
+ Fourth, Emacs tries to determine the major mode by looking at the
text at the start of the buffer, based on the variable
@code{magic-mode-alist}. By default, this variable is @code{nil} (an
empty list), so Emacs skips this step; however, you can customize it
@@ -404,7 +408,7 @@ where @var{match-function} is a Lisp function that is
called at the
beginning of the buffer; if the function returns non-@code{nil}, Emacs
set the major mode with @var{mode-function}.
- Fourth---if Emacs still hasn't found a suitable major mode---it
+ Fifth---if Emacs still hasn't found a suitable major mode---it
looks at the file's name. The correspondence between file names and
major modes is controlled by the variable @code{auto-mode-alist}. Its
value is a list in which each element has this form,
diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi
index 4b58f6a..33d389a 100644
--- a/doc/emacs/msdos.texi
+++ b/doc/emacs/msdos.texi
@@ -549,10 +549,6 @@ meanings by enabling CUA Mode (@pxref{CUA Bindings}).
Another
optional feature which will make Emacs behave like other Windows
applications is Delete Selection mode (@pxref{Using Region}).
-@iftex
-@inforef{Windows Keyboard, , emacs}, for information about additional
-Windows-specific variables in this category.
-@end iftex
@ifnottex
@vindex w32-alt-is-meta
@cindex @code{Alt} key (MS-Windows)
@@ -1176,11 +1172,6 @@ the default when such software is detected when running
Emacs.
When this variable is non-@code{nil}, other variables affecting the
cursor display have no effect.
-@iftex
-@inforef{Windows Misc, , emacs}, for information about additional
-Windows-specific variables in this category.
-@end iftex
-
@ifnottex
@vindex w32-grab-focus-on-raise
@cindex frame focus policy, MS-Windows
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index 922eec7..22b3677 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -174,8 +174,10 @@ characters in the range @code{#x0080..#x00FF}.
@cindex font of character at point
@cindex text properties at point
@cindex face at point
- With a prefix argument (@kbd{C-u C-x =}), this command displays a
-detailed description of the character in a window:
+@findex describe-char
+ With a prefix argument (@kbd{C-u C-x =}), this command additionally
+calls the command @code{describe-char}, which displays a detailed
+description of the character:
@itemize @bullet
@item
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index e6b066e..a1760ad 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -1971,6 +1971,17 @@ it never deletes lines that are only partially contained
in the region
(a newline that ends a line counts as part of that line).
If a match is split across lines, this command keeps all those lines.
+
+@findex kill-matching-lines
+@item M-x kill-matching-lines
+Like @code{flush-lines}, but also add the matching lines to the kill
+ring. The command adds the matching lines to the kill ring as a
+single string, including the newlines that separated the lines.
+
+@findex copy-matching-lines
+@item M-x copy-matching-lines
+Like @code{kill-matching-lines}, but the matching lines are not
+removed from the buffer.
@end table
@node Search Customizations
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index f2fe248..3b9d5c2 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -61,7 +61,7 @@ use Picture mode, a special major mode for editing such
pictures.
@cindex autotyping
@cindex automatic typing
The automatic typing features may be useful when writing text.
-@inforef{Top,The Autotype Manual,autotype}.
+@xref{Top, Autotyping, The Autotype Manual, autotype}.
@end ifinfo
@menu
@@ -997,6 +997,13 @@ specific file (@pxref{File Variables}).
major mode's special commands. (The variable
@code{outline-minor-mode-prefix} controls the prefix used.)
+@vindex outline-minor-mode-cycle
+ If the @code{outline-minor-mode-cycle} user option is
+non-@code{nil}, the @kbd{TAB} and @kbd{S-TAB} keys are enabled on the
+outline heading lines. @kbd{TAB} cycles hiding, showing the
+sub-heading, and showing all for the current section. @kbd{S-TAB}
+does the same for the entire buffer.
+
@menu
* Outline Format:: What the text of an outline looks like.
* Outline Motion:: Special commands for moving through outlines.
diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi
index 0d31b0b..55e9d00 100644
--- a/doc/lispref/buffers.texi
+++ b/doc/lispref/buffers.texi
@@ -1183,7 +1183,7 @@ buffer.
the base buffer effectively kills the indirect buffer in that it cannot
ever again be the current buffer.
-@deffn Command make-indirect-buffer base-buffer name &optional clone
+@deffn Command make-indirect-buffer base-buffer name &optional clone
inhibit-buffer-hooks
This creates and returns an indirect buffer named @var{name} whose
base buffer is @var{base-buffer}. The argument @var{base-buffer} may
be a live buffer or the name (a string) of an existing buffer. If
@@ -1199,6 +1199,8 @@ If @var{base-buffer} is an indirect buffer, its base
buffer is used as
the base for the new buffer. If, in addition, @var{clone} is
non-@code{nil}, the initial state is copied from the actual base
buffer, not from @var{base-buffer}.
+
+@xref{Creating Buffers}, for the meaning of @var{inhibit-buffer-hooks}.
@end deffn
@deffn Command clone-indirect-buffer newname display-flag &optional norecord
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index f30419c..b4a8b73 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -3381,6 +3381,12 @@ nil)}. This is the same thing that quitting does. (See
@code{signal}
in @ref{Errors}.)
@end deffn
+ To quit without aborting a keyboard macro definition or execution,
+you can signal the @code{minibuffer-quit} condition. This has almost
+the same effect as the @code{quit} condition except that the error
+handling in the command loop handles it without exiting keyboard macro
+definition or execution.
+
You can specify a character other than @kbd{C-g} to use for quitting.
See the function @code{set-input-mode} in @ref{Input Modes}.
@@ -3565,12 +3571,14 @@ commands.
@code{recursive-edit}. This function contains the command loop; it also
contains a call to @code{catch} with tag @code{exit}, which makes it
possible to exit the recursive editing level by throwing to @code{exit}
-(@pxref{Catch and Throw}). If you throw a value other than @code{t},
-then @code{recursive-edit} returns normally to the function that called
-it. The command @kbd{C-M-c} (@code{exit-recursive-edit}) does this.
+(@pxref{Catch and Throw}). If you throw a @code{nil} value, then
+@code{recursive-edit} returns normally to the function that called it.
+The command @kbd{C-M-c} (@code{exit-recursive-edit}) does this.
Throwing a @code{t} value causes @code{recursive-edit} to quit, so that
control returns to the command loop one level up. This is called
@dfn{aborting}, and is done by @kbd{C-]} (@code{abort-recursive-edit}).
+You can also throw a function value. In that case,
+@code{recursive-edit} will call it without arguments before returning.
Most applications should not use recursive editing, except as part of
using the minibuffer. Usually it is more convenient for the user if you
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 22b665b..5026d0a 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -555,6 +555,16 @@ Two symbols to avoid are @code{t}, which behaves like
@code{_}
Likewise, it makes no sense to bind keyword symbols
(@pxref{Constant Variables}).
+@item (cl-type @var{type})
+Matches if @var{expval} is of type @var{type}, which is a type
+descriptor as accepted by @code{cl-typep} (@pxref{cl-typep,,,cl,Common
+Lisp Extensions}). Examples:
+
+@lisp
+(cl-type integer)
+(cl-type (integer 0 10))
+@end lisp
+
@item (pred @var{function})
Matches if the predicate @var{function} returns non-@code{nil}
when called on @var{expval}. The test can be negated with the syntax
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 3336338..13d0a1b 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -1861,9 +1861,12 @@ from the buffer.
@item keymap
@cindex keymap of character (and overlays)
@kindex keymap @r{(overlay property)}
-If this property is non-@code{nil}, it specifies a keymap for a portion of the
-text. This keymap is used when the character after point is within the
-overlay, and takes precedence over most other keymaps. @xref{Active Keymaps}.
+If this property is non-@code{nil}, it specifies a keymap for a
+portion of the text. This keymap takes precedence over most other
+keymaps (@pxref{Active Keymaps}), and it is used when point is within
+the overlay, where the front-
+and rear-advance properties define whether the boundaries are
+considered as being @emph{within} or not.
@item local-map
@kindex local-map @r{(overlay property)}
diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index fb393b9..f848218 100644
--- a/doc/lispref/errors.texi
+++ b/doc/lispref/errors.texi
@@ -20,8 +20,9 @@ the errors in accessing files have the condition
@code{file-error}. If
we do not say here that a certain error symbol has additional error
conditions, that means it has none.
- As a special exception, the error symbol @code{quit} does not have the
-condition @code{error}, because quitting is not considered an error.
+ As a special exception, the error symbols @code{quit} and
+@code{minibuffer-quit} don't have the condition @code{error}, because
+quitting is not considered an error.
Most of these error symbols are defined in C (mainly @file{data.c}),
but some are defined in Lisp. For example, the file @file{userlock.el}
@@ -40,6 +41,10 @@ The message is @samp{error}. @xref{Errors}.
@item quit
The message is @samp{Quit}. @xref{Quitting}.
+@item minibuffer-quit
+The message is @samp{Quit}. This is a subcategory of @code{quit}.
+@xref{Quitting}.
+
@item args-out-of-range
The message is @samp{Args out of range}. This happens when trying to
access an element beyond the range of a sequence, buffer, or other
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index 448b8ae..7893895 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -350,7 +350,8 @@ Here is how you could define @code{indirect-function} in
Lisp:
@example
(defun indirect-function (function)
- (if (symbolp function)
+ (if (and function
+ (symbolp function))
(indirect-function (symbol-function function))
function))
@end example
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 5238597..266501d 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -772,6 +772,20 @@ and otherwise ignores the error.
If this variable is @code{nil}, Emacs does not lock files.
@end defopt
+@defopt lock-file-name-transforms
+By default, Emacs creates the lock files in the same directory as the
+files that are being locked. This can be changed by customizing this
+variable. Is has the same syntax as
+@code{auto-save-file-name-transforms} (@pxref{Auto-Saving}). For
+instance, to make Emacs write all the lock files to @file{/var/tmp/},
+you could say something like:
+
+@lisp
+(setq lock-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
+@end lisp
+@end defopt
+
@defun ask-user-about-lock file other-user
This function is called when the user tries to modify @var{file}, but it
is locked by another user named @var{other-user}. The default
@@ -807,6 +821,16 @@ If you wish, you can replace the
@code{ask-user-about-lock} function
with your own version that makes the decision in another way.
@end defun
+@defopt remote-file-name-inhibit-locks
+You can prevent the creation of remote lock files by setting the
+variable @code{remote-file-name-inhibit-locks} to @code{t}.
+@end defopt
+
+@deffn Command lock-file-mode
+This command, called interactively, toggles the local value of
+@code{create-lockfiles} in the current buffer.
+@end deffn
+
@node Information about Files
@section Information about Files
@cindex file, information about
@@ -2319,49 +2343,26 @@ entirely of directory separators.
@end example
@end defun
- Given a directory name, you can combine it with a relative file name
-using @code{concat}:
-
-@example
-(concat @var{dirname} @var{relfile})
-@end example
-
-@noindent
-Be sure to verify that the file name is relative before doing that.
-If you use an absolute file name, the results could be syntactically
-invalid or refer to the wrong file.
-
- If you want to use a directory file name in making such a
-combination, you must first convert it to a directory name using
-@code{file-name-as-directory}:
+@defun file-name-concat directory &rest components
+Concatenate @var{components} to @var{directory}, inserting a slash
+before the components if @var{directory} or the preceding component
+didn't end with a slash.
@example
-(concat (file-name-as-directory @var{dirfile}) @var{relfile})
-@end example
-
-@noindent
-Don't try concatenating a slash by hand, as in
-
-@example
-;;; @r{Wrong!}
-(concat @var{dirfile} "/" @var{relfile})
+@group
+(file-name-concat "/tmp" "foo")
+ @result{} "/tmp/foo"
+@end group
@end example
-@noindent
-because this is not portable. Always use
-@code{file-name-as-directory}.
-
- To avoid the issues mentioned above, or if the @var{dirname} value
-might be @code{nil} (for example, from an element of @code{load-path}),
-use:
+A @var{directory} or components that are @code{nil} or the empty
+string are ignored---they are filtered out first and do not affect the
+results in any way.
-@example
-(expand-file-name @var{relfile} @var{dirname})
-@end example
-
-However, @code{expand-file-name} expands leading @samp{~} in
-@var{relfile}, which may not be what you want. @xref{File Name
-Expansion}.
+This is almost the same as using @code{concat}, but @var{dirname} (and
+the non-final components) may or may not end with slash characters,
+and this function will not double those characters.
+@end defun
To convert a directory name to its abbreviation, use this
function:
@@ -3273,7 +3274,7 @@ first, before handlers for jobs such as remote file
access.
@code{file-equal-p},
@code{file-executable-p}, @code{file-exists-p},
@code{file-in-directory-p},
-@code{file-local-copy},
+@code{file-local-copy}, @code{file-locked-p},
@code{file-modes}, @code{file-name-all-completions},
@code{file-name-as-directory},
@code{file-name-case-insensitive-p},
@@ -3292,10 +3293,11 @@ first, before handlers for jobs such as remote file
access.
@code{get-file-buffer},
@code{insert-directory},
@code{insert-file-contents},@*
-@code{load},
+@code{load}, @code{lock-file},
@code{make-auto-save-file-name},
@code{make-directory},
@code{make-directory-internal},
+@code{make-lock-file-name},
@code{make-nearby-temp-file},
@code{make-process},
@code{make-symbolic-link},@*
@@ -3307,6 +3309,7 @@ first, before handlers for jobs such as remote file
access.
@code{substitute-in-file-name},@*
@code{temporary-file-directory},
@code{unhandled-file-name-directory},
+@code{unlock-file},
@code{vc-registered},
@code{verify-visited-file-modtime},@*
@code{write-region}.
@@ -3331,7 +3334,7 @@ first, before handlers for jobs such as remote file
access.
@code{file-equal-p},
@code{file-executable-p}, @code{file-exists-p},
@code{file-in-directory-p},
-@code{file-local-copy},
+@code{file-local-copy}, @code{file-locked-p},
@code{file-modes}, @code{file-name-all-completions},
@code{file-name-as-directory},
@code{file-name-case-insensitive-p},
@@ -3350,10 +3353,12 @@ first, before handlers for jobs such as remote file
access.
@code{get-file-buffer},
@code{insert-directory},
@code{insert-file-contents},
-@code{load},
+@code{load}, @code{lock-file},
@code{make-auto-save-file-name},
@code{make-direc@discretionary{}{}{}tory},
@code{make-direc@discretionary{}{}{}tory-internal},
+@code{make-lock-file-name},
+@code{make-nearby-temp-file},
@code{make-process},
@code{make-symbolic-link},
@code{process-file},
@@ -3362,7 +3367,9 @@ first, before handlers for jobs such as remote file
access.
@code{set-visited-file-modtime}, @code{shell-command},
@code{start-file-process},
@code{substitute-in-file-name},
+@code{temporary-file-directory},
@code{unhandled-file-name-directory},
+@code{unlock-file},
@code{vc-regis@discretionary{}{}{}tered},
@code{verify-visited-file-modtime},
@code{write-region}.
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 64883bf..77d1465 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -2421,11 +2421,12 @@ opposed to an unspecified one).
@cindex safety of functions
Some major modes, such as SES, call functions that are stored in user
-files. (@inforef{Top, ,ses}, for more information on SES@.) User
-files sometimes have poor pedigrees---you can get a spreadsheet from
-someone you've just met, or you can get one through email from someone
-you've never met. So it is risky to call a function whose source code
-is stored in a user file until you have determined that it is safe.
+files. (@xref{Top, Simple Emacs Spreadsheet,,ses}, for more
+information on SES@.) User files sometimes have poor pedigrees---you
+can get a spreadsheet from someone you've just met, or you can get one
+through email from someone you've never met. So it is risky to call a
+function whose source code is stored in a user file until you have
+determined that it is safe.
@defun unsafep form &optional unsafep-vars
Returns @code{nil} if @var{form} is a @dfn{safe} Lisp expression, or
diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi
index b1c7e61..3949284 100644
--- a/doc/lispref/hooks.texi
+++ b/doc/lispref/hooks.texi
@@ -184,7 +184,7 @@ The command loop runs this soon after
@code{post-command-hook} (q.v.).
@item mouse-leave-buffer-hook
@vindex mouse-leave-buffer-hook
-Hook run when about to switch windows with a mouse command.
+Hook run when the user mouse-clicks in a window.
@item mouse-position-function
@xref{Mouse Position}.
diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi
index 35f852b..c2ed964 100644
--- a/doc/lispref/intro.texi
+++ b/doc/lispref/intro.texi
@@ -89,7 +89,7 @@ you are criticizing.
@cindex suggestions
Please send comments and corrections using @kbd{M-x
report-emacs-bug}. If you wish to contribute new code (or send a
-patch to fix a problem), use @kbd{M-x submit-emacs-patch}).
+patch to fix a problem), use @kbd{M-x submit-emacs-patch}.
@node Lisp History
@section Lisp History
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 2805b1f..ac99835 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1804,7 +1804,7 @@ through a simple example:
(let-alist colors
(if (eq .rose 'red)
.lily))
-=> white
+ @result{} white
@end lisp
The @var{body} is inspected at compilation time, and only the symbols
@@ -1820,7 +1820,7 @@ Nested association lists is supported:
(let-alist colors
(if (eq .rose 'red)
.lily.belladonna))
-=> yellow
+ @result{} yellow
@end lisp
Nesting @code{let-alist} inside each other is allowed, but the code in
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 196dd99..d54c654 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -469,6 +469,18 @@ If @var{default} is a non-@code{nil} list, the first
element of the
list is used in the prompt.
@end defun
+@defvar read-minibuffer-restore-windows
+If this option is non-@code{nil} (the default), getting input from the
+minibuffer will restore, on exit, the window configurations of the frame
+where the minibuffer was entered from and, if it is different, the frame
+that owns the minibuffer window. This means that if, for example, a
+user splits a window while getting input from the minibuffer on the same
+frame, that split will be undone when exiting the minibuffer.
+
+If this option is @code{nil}, no such restorations are done. Hence, the
+window split mentioned above will persist after exiting the minibuffer.
+@end defvar
+
@node Object from Minibuffer
@section Reading Lisp Objects with the Minibuffer
@cindex minibuffer input, reading lisp objects
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 5869f53..d48c9cc 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -2251,16 +2251,15 @@ number.
The format used to display column numbers when
@code{column-number-mode} (@pxref{Optional Mode Line,,, emacs, The GNU
Emacs Manual}) is switched on. @samp{%c} in the format will be
-replaced with the column number, and this is zero-based if
-@code{column-number-indicator-zero-based} is non-@code{nil}, and
-one-based if @code{column-number-indicator-zero-based} is @code{nil}.
+replaced with a zero-based column number, and @samp{%C} will be
+replaced with a one-based column number.
@end defvar
@defvar mode-line-position-column-line-format
The format used to display column numbers when both
@code{line-number-mode} and @code{column-number-mode} are switched on.
-See the previous two variables for the meaning of the @samp{%l} and
-@samp{%c} format specs.
+See the previous two variables for the meaning of the @samp{%l},
+@samp{%c} and @samp{%C} format specs.
@end defvar
@defvar minor-mode-alist
@@ -2287,11 +2286,14 @@ enabled separately in each buffer.
@defvar global-mode-string
This variable holds a mode line construct that, by default, appears in
-the mode line just after the @code{which-function-mode} minor mode if set,
-else after @code{mode-line-modes}. The command @code{display-time} sets
+the mode line just after the @code{which-function-mode} minor mode if
+set, else after @code{mode-line-modes}. Elements that are added to
+this construct should normally end in a space (to ensure that
+consecutive @code{global-mode-string} elements display properly). For
+instance, the command @code{display-time} sets
@code{global-mode-string} to refer to the variable
-@code{display-time-string}, which holds a string containing the time and
-load information.
+@code{display-time-string}, which holds a string containing the time
+and load information.
The @samp{%M} construct substitutes the value of
@code{global-mode-string}, but that is obsolete, since the variable is
@@ -3551,7 +3553,7 @@ which will instruct font-lock not to start or end the
scan in the
middle of the construct.
@end itemize
- There are three ways to do rehighlighting of multiline constructs:
+ There are several ways to do rehighlighting of multiline constructs:
@itemize
@item
@@ -3573,6 +3575,17 @@ This works only if @code{jit-lock-contextually} is used,
and with the
same delay before rehighlighting, but like @code{font-lock-multiline},
it also handles the case where highlighting depends on
subsequent lines.
+@item
+If parsing the @emph{syntax} of a construct depends on it being parsed in one
+single chunk, you can add the @code{syntax-multiline} text property
+over the construct in question. The most common use for this is when
+the syntax property to apply to @samp{FOO} depend on some later text
+@samp{BAR}: By placing this text property over the whole of
+@samp{FOO...BAR}, you make sure that any change of @samp{BAR} will
+also cause the syntax property of @samp{FOO} to be recomputed.
+Note: For this to work, the mode needs to add
+@code{syntax-propertize-multiline} to
+@code{syntax-propertize-extend-region-functions}.
@end itemize
@menu
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index d8091f1..365d5ac 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -1001,6 +1001,13 @@ It looks like this:
@end example
@end ifnottex
+ As a somewhat peculiar side effect of @code{(a b . c)} and
+@code{(a . (b . c))} being equivalent, for consistency this means
+that if you replace @code{b} here with the empty sequence, then it
+follows that @code{(a . c)} and @code{(a . ( . c))} are equivalent,
+too. This also means that @code{( . c)} is equivalent to @code{c},
+but this is seldom used.
+
@node Association List Type
@subsubsection Association List Type
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 242c5ed..12ddaf0 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -2167,6 +2167,11 @@ if @var{time} is @code{t}, then the timer runs whenever
the time is a
multiple of @var{repeat} seconds after the epoch. This is useful for
functions like @code{display-time}.
+If Emacs didn't get any CPU time when the timer would have run (for
+example if the system was busy running another process or if the
+computer was sleeping or in a suspended state), the timer will run as
+soon as Emacs resumes and is idle.
+
The function @code{run-at-time} returns a timer value that identifies
the particular scheduled future action. You can use this value to call
@code{cancel-timer} (see below).
diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi
index e8aaa3a..9c033fe 100644
--- a/doc/lispref/package.texi
+++ b/doc/lispref/package.texi
@@ -283,11 +283,14 @@ variable @code{load-file-name} (@pxref{Loading}). Here
is an example:
@section Creating and Maintaining Package Archives
@cindex package archive
+@cindex GNU ELPA
+@cindex non-GNU ELPA
Via the Package Menu, users may download packages from @dfn{package
archives}. Such archives are specified by the variable
-@code{package-archives}, whose default value contains a single entry:
-the archive hosted by the GNU project at @url{https://elpa.gnu.org}. This
-section describes how to set up and maintain a package archive.
+@code{package-archives}, whose default value lists the archives
+hosted on @url{https://elpa.gnu.org, GNU ELPA} and
+@url{https://elpa.nongnu.org, non-GNU ELPA}. This section describes
+how to set up and maintain a package archive.
@cindex base location, package archive
@defopt package-archives
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 0dfdac7..90c4215 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -247,6 +247,16 @@ protected by @code{shell-quote-argument};
@code{combine-and-quote-strings} is @emph{not} intended to protect
special characters from shell evaluation.
+@defun split-string-shell-command string
+This function splits @var{string} into substrings, respecting double
+and single quotes, as well as backslash quoting.
+
+@smallexample
+(split-string-shell-command "ls /tmp/'foo bar'")
+ @result{} ("ls" "/tmp/foo bar")
+@end smallexample
+@end defun
+
@defun split-string-and-unquote string &optional separators
This function splits @var{string} into substrings at matches for the
regular expression @var{separators}, like @code{split-string} does
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 0c87a19..9e0401f 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -315,10 +315,11 @@ word on the same line is acceptable.
@defun thing-at-point thing &optional no-properties
Return the @var{thing} around or next to point, as a string.
-The argument @var{thing} is a symbol which specifies a kind of syntactic
-entity. Possibilities include @code{symbol}, @code{list}, @code{sexp},
-@code{defun}, @code{filename}, @code{url}, @code{word}, @code{sentence},
-@code{whitespace}, @code{line}, @code{page}, and others.
+The argument @var{thing} is a symbol which specifies a kind of
+syntactic entity. Possibilities include @code{symbol}, @code{list},
+@code{sexp}, @code{defun}, @code{filename}, @code{existing-filename},
+@code{url}, @code{word}, @code{sentence}, @code{whitespace},
+@code{line}, @code{page}, and others.
When the optional argument @var{no-properties} is non-@code{nil}, this
function strips text properties from the return value.
@@ -502,6 +503,15 @@ This is like @code{insert-buffer-substring} except that it
does not
copy any text properties.
@end defun
+@defun insert-into-buffer to-buffer &optional start end
+This is like @code{insert-buffer-substring}, but works in the opposite
+direction: The text is copied from the current buffer into
+@var{to-buffer}. The block of text is copied to the current point in
+@var{to-buffer}, and point (in that buffer) is advanced to after the
+end of the copied text. Is @code{start}/@code{end} is @code{nil}, the
+entire text in the current buffer is copied over.
+@end defun
+
@xref{Sticky Properties}, for other insertion functions that inherit
text properties from the nearby text in addition to inserting it.
Whitespace inserted by indentation functions also inherits text
@@ -4399,7 +4409,8 @@ based on their character codes.
@cindex replace characters
This function replaces all occurrences of the character @var{old-char}
with the character @var{new-char} in the region of the current buffer
-defined by @var{start} and @var{end}.
+defined by @var{start} and @var{end}. Both characters must have the
+same length of their multibyte form.
@cindex undo avoidance
If @var{noundo} is non-@code{nil}, then @code{subst-char-in-region} does
@@ -4428,6 +4439,16 @@ ThXs Xs the contents of the buffer before.
@end example
@end defun
+
+@defun subst-char-in-string fromchar tochar string &optional inplace
+@cindex replace characters in string
+This function replaces all occurrences of the character @var{fromchar}
+with @var{tochar} in @var{string}. By default, substitution occurs in
+a copy of @var{string}, but if the optional argument @var{inplace} is
+non-@code{nil}, the function modifies the @var{string} itself. In any
+case, the function returns the resulting string.
+@end defun
+
@deffn Command translate-region start end table
This function applies a translation table to the characters in the
buffer between positions @var{start} and @var{end}.
@@ -5281,11 +5302,20 @@ represents @code{@{@}}, the empty JSON object; not
@code{null},
@code{false}, or an empty array, all of which are different JSON
values.
+@defun json-available-p
+This predicate returns non-@code{nil} if Emacs has been built with
+@acronym{JSON} support, and the library is available on the current
+system.
+@end defun
+
If some Lisp object can't be represented in JSON, the serialization
functions will signal an error of type @code{wrong-type-argument}.
The parsing functions can also signal the following errors:
@table @code
+@item json-unavailable
+Signaled when the parsing library isn't available.
+
@item json-end-of-file
Signaled when encountering a premature end of the input text.
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index 54cafff..8aa225a 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -168,11 +168,12 @@ follow the naming conventions for hooks. @xref{Hooks}.
@item
@cindex unloading packages, preparing for
-If loading the file adds functions to hooks, define a function
-@code{@var{feature}-unload-function}, where @var{feature} is the name
-of the feature the package provides, and make it undo any such
-changes. Using @code{unload-feature} to unload the file will run this
-function. @xref{Unloading}.
+Using @code{unload-feature} will undo the changes usually done by
+loading a feature (like adding functions to hooks). However, if
+loading @var{feature} does something unusual and more complex, you can
+define a function named @code{@var{feature}-unload-function}, and make
+it undo any such special changes. @code{unload-feature} will then
+automatically run this function if it exists. @xref{Unloading}.
@item
It is a bad idea to define aliases for the Emacs primitives. Normally
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 62c76f0..9356fb9 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -1995,6 +1995,20 @@ Doing so adds those variable/value pairs to
file.
@end defopt
+@defopt ignored-local-variable-values
+If there are some values of particular local variables that you always
+want to ignore completely, you can use this variable. Its value has
+the same form as @code{safe-local-variable-values}; a file-local
+variable setting to the value that appears in the list will always be
+ignored when processing the local variables specified by the file. As
+with that variable, when Emacs queries the user about whether to obey
+file-local variables, the user can choose to ignore their particular
+values permanently, and that will alter this variable and save it to
+the user's custom file. Variable-value pairs that appear in this
+variable take precedence over the same pairs in
+@code{safe-local-variable-values}.
+@end defopt
+
@defun safe-local-variable-p sym val
This function returns non-@code{nil} if it is safe to give @var{sym}
the value @var{val}, based on the above criteria.
diff --git a/doc/misc/bovine.texi b/doc/misc/bovine.texi
index 780f0ad..9bfb117 100644
--- a/doc/misc/bovine.texi
+++ b/doc/misc/bovine.texi
@@ -78,13 +78,13 @@ The @dfn{bovine} parser is the original @semantic{} parser,
and is an
implementation of an @acronym{LL} parser. It is good for simple
languages. It has many conveniences making grammar writing easy. The
conveniences make it less powerful than a Bison-like @acronym{LALR}
-parser. For more information, @inforef{Top, The Wisent Parser Manual,
+parser. For more information, @pxref{Top,, Wisent Parser Development,
wisent}.
Bovine @acronym{LL} grammars are stored in files with a @file{.by}
extension. When compiled, the contents is converted into a file of
the form @file{NAME-by.el}. This, in turn is byte compiled.
-@inforef{top, Grammar Framework Manual, grammar-fw}.
+@xref{top,, Grammar Framework Manual, grammar-fw}.
@ifnottex
@insertcopying
@@ -105,7 +105,8 @@ the form @file{NAME-by.el}. This, in turn is byte compiled.
In Bison, one and only one nonterminal is designated as the ``start''
symbol. In @semantic{}, one or more nonterminals can be designated as
the ``start'' symbol. They are declared following the @code{%start}
-keyword separated by spaces. @inforef{start Decl, ,grammar-fw}.
+keyword separated by spaces. @xref{start Decl,, Grammar Framework
+Manual, grammar-fw}.
If no @code{%start} keyword is used in a grammar, then the very first
is used. Internally the first start nonterminal is targeted by the
@@ -115,7 +116,8 @@ parser harness.
To find locally defined variables, the local context handler needs to
parse the body of functional code. The @code{scopestart} declaration
specifies the name of a nonterminal used as the goal to parse a local
-context, @inforef{scopestart Decl, ,grammar-fw}. Internally the
+context, @pxref{scopestart Decl,, Grammar Framework Manual,
+grammar-fw}. Internally the
scopestart nonterminal is targeted by the reserved symbol
@code{bovine-inner-scope}, so it can be found by the parser harness.
@@ -124,7 +126,7 @@ scopestart nonterminal is targeted by the reserved symbol
The rules are what allow the compiler to create tags from a language
file. Once the setup is done in the prologue, you can start writing
-rules. @inforef{Grammar Rules, ,grammar-fw}.
+rules. @xref{Grammar Rules,, Grammar Framework Manual, grammar-fw}.
@example
@var{result} : @var{components1} @var{optional-semantic-action1})
@@ -146,8 +148,8 @@ A particular @var{result} written into your grammar becomes
the parser's goal. It is designated by a @code{%start} statement
(@pxref{Starting Rules}). The value returned by the associated
@var{optional-semantic-action} is the parser's result. It should be
-a tree of @semantic{} @dfn{tags}, @inforef{Semantic Tags, ,
-semantic-appdev}.
+a tree of @semantic{} @dfn{tags}, @pxref{Semantic Tags,, Semantic
+Application Development, semantic-appdev}.
@var{components} is made up of symbols. A symbol such as @code{FOO}
means that a syntactic token of class @code{FOO} must be matched.
@@ -170,8 +172,9 @@ For instance:
@end example
Means that @code{FOO} is a reserved language keyword, matched as such
-by looking up into a keyword table, @inforef{keyword Decl,
-,grammar-fw}. This is because @code{"foo"} will be converted to
+by looking up into a keyword table, @pxref{keyword Decl,, Grammar
+Framework Manual, grammar-fw}. This is because @code{"foo"} will be
+converted to
@code{FOO} in the lexical analysis stage. Thus the symbol @code{FOO}
won't be available any other way.
@@ -383,8 +386,8 @@ Is an optional set of labeled values such as
@code{:constant-flag t :parent
Create a tag with @var{name} of respectively the class
@code{variable}, @code{function}, @code{type}, @code{include},
@code{package}, and @code{code}.
-See @inforef{Creating Tags, , semantic-appdev} for the lisp
-functions these translate into.
+See @ref{Creating Tags,, Semantic Application Development,
+semantic-appdev}, for the lisp functions these translate into.
@end table
If the symbol @code{%quotemode backquote} is specified, then use
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 53a3af4..d66c12f 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -1519,6 +1519,7 @@ of files from Macintosh, Microsoft, and Unix platforms.
* Documentation for etags::
* Disabling backups::
* Disabling auto-save-mode::
+* Not writing files to the current directory::
* Going to a line by number::
* Modifying pull-down menus::
* Deleting menus and menu options::
@@ -2620,6 +2621,39 @@ such as @file{/tmp}.
To disable or change how @code{auto-save-mode} works,
@pxref{Auto Save,,, emacs, The GNU Emacs Manual}.
+@node Not writing files to the current directory
+@section Making Emacs write all auxiliary files somewhere else
+@cindex Writing all auxiliary files to the same directory
+
+By default, Emacs may create many new files in the directory where
+you're editing a file. If you're editing the file
+@file{/home/user/foo.txt}, Emacs will create the lock file
+@file{/home/user/.#foo.txt}, the auto-save file
+@file{/home/user/#foo.txt#}, and when you save the file, Emacs will
+create the backup file @file{/home/user/foo.txt~}. (The first two
+files are deleted when you save the file.)
+
+This may be inconvenient in some setups, so Emacs has mechanisms for
+changing the locations of all these files.
+
+@table @code
+@item auto-save-file-name-transforms (@pxref{Auto-Saving,,,elisp, GNU Emacs
Lisp Reference Manual}).
+@item lock-file-name-transforms (@pxref{File Locks,,,elisp, GNU Emacs Lisp
Reference Manual}).
+@item backup-directory-alist (@pxref{Making Backups,,,elisp, GNU Emacs Lisp
Reference Manual}).
+@end table
+
+For instance, to write all these things to
+@file{~/.emacs.d/aux/}:
+
+@lisp
+(setq lock-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "~/.emacs.d/aux/\\1" t)))
+(setq auto-save-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "~/.emacs.d/aux/\\1" t)))
+(setq backup-directory-alist
+ '((".*" . "~/.emacs.d/aux/")))
+@end lisp
+
@node Going to a line by number
@section How can I go to a certain line given its number?
@cindex Going to a line by number
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 77a19a4..10ced67 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -131,21 +131,30 @@ customize-variable @key{RET} erc-modules @key{RET}}.
@node Sample Session
@section Sample Session
-This is an example ERC session which shows how to connect to the #emacs
-channel on Freenode. Another IRC channel on Freenode that may be of
-interest is #erc, which is a channel where ERC users and developers hang
-out.
+This is an example ERC session which shows how to connect to the
+#emacs channel on Libera.Chat. Another IRC channel on Libera.Chat
+that may be of interest is #erc, which is a channel where ERC users
+and developers hang out. These channels used to live on the Freenode
+IRC network until June 2021, when they---along with the official IRC
+channels of the GNU Project, the Free Software Foundation, and many
+other free software communities---relocated to the Libera.Chat network
+in the aftermath of changes in governance and policies of Freenode in
+May and June 2021. GNU and FSF's announcements about this are at
+@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html},
+@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html},
+and
+@uref{https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html}.
@itemize @bullet
-@item Connect to Freenode
+@item Connect to Libera.Chat
-Run @kbd{M-x erc}. Use ``chat.freenode.net'' as the IRC server,
-``6667'' as the port, and choose a nickname.
+Run @kbd{M-x erc}. Use ``irc.libera.chat as the IRC server, ``6667''
+as the port, and choose a nickname.
@item Get used to the interface
-Switch to the ``chat.freenode.net:6667'' buffer, if you're not already
+Switch to the ``irc.libera.chat:6667'' buffer, if you're not already
there. You will see first some messages about checking for ident, and
then a bunch of other messages that describe the current IRC server.
@@ -158,13 +167,13 @@ background. If the latter, switch to the ``#emacs''
buffer. You will
see the channel topic and a list of the people who are currently on the
channel.
-@item Register your nickname with Freenode
+@item Register your nickname with Libera.Chat
If you would like to be able to talk with people privately on the
-Freenode network, you will have to ``register'' your nickname. To do
-so, switch to the ``chat.freenode.net:6667'' buffer and type ``/msg
-NickServ register <password>'', replacing ``<password>'' with your
-desired password. It should tell you that the operation was
+Libera.Chat network, you will have to ``register'' your nickname.
+To do so, switch to the ``irc.libera.chat:6667'' buffer and type
+``/msg NickServ register <password>'', replacing ``<password>'' with
+your desired password. It should tell you that the operation was
successful.
@item Talk to people in the channel
@@ -518,7 +527,7 @@ That is, if called with the following arguments,
@var{server} and
for the values of the other parameters.
@example
-(erc :server "chat.freenode.net" :full-name "J. Random Hacker")
+(erc :server "irc.libera.chat" :full-name "J. Random Hacker")
@end example
@end defun
@@ -545,7 +554,7 @@ for the values of the other parameters, and
@code{client-certificate}
will be @code{nil}.
@example
-(erc-tls :server "chat.freenode.net" :full-name "J. Random Hacker")
+(erc-tls :server "irc.libera.chat" :full-name "J. Random Hacker")
@end example
To use a certificate with @code{erc-tls}, specify the optional
@@ -563,21 +572,21 @@ various IRC networks.
Examples of use:
@example
-(erc-tls :server "chat.freenode.net" :port 6697
+(erc-tls :server "irc.libera.chat" :port 6697
:client-certificate
'("/home/bandali/my-cert.key"
"/home/bandali/my-cert.crt"))
@end example
@example
-(erc-tls :server "chat.freenode.net" :port 6697
+(erc-tls :server "irc.libera.chat" :port 6697
:client-certificate
- `(,(expand-file-name "~/cert-freenode.key")
- ,(expand-file-name "~/cert-freenode.crt")))
+ `(,(expand-file-name "~/cert-libera.key")
+ ,(expand-file-name "~/cert-libera.crt")))
@end example
@example
-(erc-tls :server "chat.freenode.net" :port 6697
+(erc-tls :server "irc.libera.chat" :port 6697
:client-certificate t)
@end example
@@ -586,7 +595,7 @@ line like the following to your authinfo file
(e.g. @file{~/.authinfo.gpg}):
@example
-machine chat.freenode.net key /home/bandali/my-cert.key cert
/home/bandali/my-cert.crt
+machine irc.libera.chat key /home/bandali/my-cert.key cert
/home/bandali/my-cert.crt
@end example
@xref{Help for users,,,auth, Emacs auth-source Library}, for more on the
@@ -762,11 +771,10 @@ stuff, to the current ERC buffer."
(erc-send-message
(concat "@{Uptime@} [" uname-output "]"))))
-;; This causes ERC to connect to the Freenode network upon hitting
+;; This causes ERC to connect to the Libera.Chat network upon hitting
;; C-c e f. Replace MYNICK with your IRC nick.
(global-set-key "\C-cef" (lambda () (interactive)
- (erc :server "chat.freenode.net"
- :port "6667"
+ (erc :server "irc.libera.chat" :port "6667"
:nick "MYNICK")))
;; This causes ERC to connect to the IRC server on your own machine (if
@@ -786,13 +794,15 @@ stuff, to the current ERC buffer."
;;; Options
-;; Join the #emacs and #erc channels whenever connecting to Freenode.
-(setq erc-autojoin-channels-alist '(("freenode.net" "#emacs" "#erc")))
+;; Join the #emacs and #erc channels whenever connecting to
+;; Libera.Chat.
+(setq erc-autojoin-channels-alist
+ '(("Libera.Chat" "#emacs" "#erc")))
;; Rename server buffers to reflect the current network name instead
-;; of SERVER:PORT (e.g., "freenode" instead of "chat.freenode.net:6667").
-;; This is useful when using a bouncer like ZNC where you have multiple
-;; connections to the same server.
+;; of SERVER:PORT (e.g., "Libera.Chat" instead of
+;; "irc.libera.chat:6667"). This is useful when using a bouncer like
+;; ZNC where you have multiple connections to the same server.
(setq erc-rename-buffers t)
;; Interpret mIRC-style color commands in IRC chats
@@ -832,7 +842,7 @@ If non, @code{nil}, this is a list of IRC networks and
message types
to hide, e.g.:
@example
-(setq erc-network-hide-list (("freenode" "JOIN" "PART" "QUIT")
+(setq erc-network-hide-list (("Libera.Chat" "JOIN" "PART" "QUIT")
("OFTC" "JOIN" "PART""))
@end example
@end defopt
@@ -881,7 +891,7 @@ You can ask questions about using ERC on the Emacs mailing
list,
@uref{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs}.
@item
-You can visit the IRC Freenode channel @samp{#emacs}. Many of the
+You can visit the IRC Libera.Chat channel @samp{#emacs}. Many of the
contributors are frequently around and willing to answer your
questions.
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi
index d3db940..28bee11 100644
--- a/doc/misc/gnus-faq.texi
+++ b/doc/misc/gnus-faq.texi
@@ -2138,7 +2138,7 @@ I need real-time help, where to find it?
@subsubheading Answer
-Point your IRC client to chat.freenode.net, channel #gnus.
+Point your IRC client to irc.libera.chat, channel #gnus.
@node FAQ 9 - Tuning Gnus
@subsection Tuning Gnus
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index c9b5b2d..17da507 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -2318,19 +2318,18 @@ commands listed in @ref{Browse Foreign Server} at hand.
@itemx u
@kindex S t @r{(Group)}
@kindex u @r{(Group)}
-@findex gnus-group-unsubscribe-current-group
-@c @icon{gnus-group-unsubscribe}
-Toggle subscription to the current group
-(@code{gnus-group-unsubscribe-current-group}).
+@findex gnus-group-toggle-subscription-at-point
+@c @icon{gnus-group-toggle-subscription-at-point}
+Toggle subscription to group under point
+(@code{gnus-group-toggle-subscription-at-point}).
@item S s
@itemx U
@kindex S s @r{(Group)}
@kindex U @r{(Group)}
-@findex gnus-group-unsubscribe-group
-Prompt for a group to subscribe, and then subscribe it. If it was
-subscribed already, unsubscribe it instead
-(@code{gnus-group-unsubscribe-group}).
+@findex gnus-group-toggle-subscription
+Prompt for group, and toggle its subscription.
+(@code{gnus-group-toggle-subscription}).
@item S k
@itemx C-k
@@ -3736,10 +3735,10 @@ Enter the current group
(@code{gnus-browse-select-group}).
@item u
@kindex u @r{(Browse)}
-@findex gnus-browse-unsubscribe-current-group
+@findex gnus-browse-toggle-subscription
@vindex gnus-browse-subscribe-newsgroup-method
-Unsubscribe to the current group, or, as will be the case here,
-subscribe to it (@code{gnus-browse-unsubscribe-current-group}). You
+Toggle subscription of the current group
+(@code{gnus-browse-toggle-subscription}). You
can affect the way the new group is entered into the Group buffer
using the variable @code{gnus-browse-subscribe-newsgroup-method}. See
@pxref{Subscription Methods} for available options.
@@ -14517,7 +14516,8 @@ this should be set to @code{anonymous}. If this
variable isn't set,
the normal login methods will be used. If you wish to specify a
specific login method to be used, you can set this variable to either
@code{login} (the traditional @acronym{IMAP} login method),
-@code{plain} or @code{cram-md5}.
+@code{plain}, @code{cram-md5} or @code{xoauth2}. (The latter method
+requires using the @file{oauth2.el} library.)
@item nnimap-expunge
When to expunge deleted messages. If @code{never}, deleted articles
@@ -16288,7 +16288,7 @@ cleaning up the headers. Functions that can be used
include:
Clear leading white space that ``helpful'' listservs have added to the
headers to make them look nice. Aaah.
-(Note that this function works on both the header on the body of all
+(Note that this function works on both the header and the body of all
messages, so it is a potentially dangerous function to use (if a body
of a message contains something that looks like a header line). So
rather than fix the bug, it is of course the right solution to make it
@@ -26861,9 +26861,10 @@ but at the common table.@*
If you want to investigate the person responsible for this outrage,
you can point your (feh!) web browser to
-@uref{https://quimby.gnus.org/}. This is also the primary
-distribution point for the new and spiffy versions of Gnus, and is
-known as The Site That Destroys Newsrcs And Drives People Mad.
+@uref{https://quimby.gnus.org/}. This used to be the primary
+distribution point for the new and spiffy versions of Gnus, and was
+known as The Site That Destroys Newsrcs And Drives People Mad, but
+these days Gnus is developed in the Emacs repository.
During the first extended alpha period of development, the new Gnus was
called ``(ding) Gnus''. @dfn{(ding)} is, of course, short for
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index d2353e6..c0e3dfa 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -2084,7 +2084,7 @@ This optional header will be computed by Message.
@vindex user-mail-address
@findex system-name
@cindex Sun
-@cindex i-did-not-set--mail-host-address--so-tickle-me
+@cindex mail-host-address-is-not-set
This required header will be generated by Message. A unique ID will be
created based on the date, time, user name (for the local part) and the
domain part. For the domain part, message will look (in this order) at
diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi
index 6254028..a7c1fed 100644
--- a/doc/misc/mh-e.texi
+++ b/doc/misc/mh-e.texi
@@ -7383,8 +7383,8 @@ The name of the MH sequence for ticked messages (default:
@samp{'tick}).
@item mh-update-sequences-after-mh-show-flag
On means flush MH sequences to disk after message is shown (default:
@samp{on}).
-@item mh-whitelist-preserves-sequences-flag
-On means that sequences are preserved when messages are whitelisted
+@item mh-allowlist-preserves-sequences-flag
+On means that sequences are preserved when messages are allowlisted
(default: @samp{on}).
@end vtable
@@ -7540,17 +7540,17 @@ Marshall Rose once wrote a paper on MH entitled,
@cite{How to process
could be entitled, @cite{How to process 1000 spams a day and still get
some real work done}.
-@cindex blacklisting
+@cindex blocklisting
@cindex ham
@cindex viruses
-@cindex whitelisting
+@cindex allowlisting
@cindex worms
We use the terms @dfn{junk mail} and @dfn{spam} interchangeably for
any unwanted message which includes spam, @dfn{viruses}, and
@dfn{worms}. The opposite of spam is @dfn{ham}. The act of classifying
-a sender as one who sends junk mail is called @dfn{blacklisting}; the
-opposite is called @dfn{whitelisting}.
+a sender as one who sends junk mail is called @dfn{blocklisting}; the
+opposite is called @dfn{allowlisting}.
@table @kbd
@kindex J ?
@@ -7560,14 +7560,14 @@ Display cheat sheet for the commands of the current
prefix in
minibuffer (@code{mh-prefix-help}).
@c -------------------------
@kindex J b
-@findex mh-junk-blacklist
+@findex mh-junk-blocklist
@item J b
-Blacklist range as spam (@code{mh-junk-blacklist}).
+Blocklist range as spam (@code{mh-junk-blocklist}).
@c -------------------------
-@kindex J w
-@findex mh-junk-whitelist
-@item J w
-Whitelist range as ham (@code{mh-junk-whitelist}).
+@kindex J a
+@findex mh-junk-allowlist
+@item J a
+Allowlist range as ham (@code{mh-junk-allowlist}).
@c -------------------------
@item @code{mh-spamassassin-identify-spammers}
Identify spammers who are repeat offenders.
@@ -7597,31 +7597,31 @@ The following option in the @samp{mh-sequences}
customization group is
also available.
@vtable @code
-@item mh-whitelist-preserves-sequences-flag
-On means that sequences are preserved when messages are whitelisted
+@item mh-allowlist-preserves-sequences-flag
+On means that sequences are preserved when messages are allowlisted
(default: @samp{on}).
@end vtable
The following hooks are available.
@vtable @code
-@item mh-blacklist-msg-hook
-Hook run by @kbd{J b} (@code{mh-junk-blacklist}) after marking each
-message for blacklisting (default: @code{nil}).
+@item mh-blocklist-msg-hook
+Hook run by @kbd{J b} (@code{mh-junk-blocklist}) after marking each
+message for blocklisting (default: @code{nil}).
@c -------------------------
-@item mh-whitelist-msg-hook
-Hook run by @kbd{J w} (@code{mh-junk-whitelist}) after marking each
-message for whitelisting (default @samp{nil}).
+@item mh-allowlist-msg-hook
+Hook run by @kbd{J a} (@code{mh-junk-allowlist}) after marking each
+message for allowlisting (default @samp{nil}).
@end vtable
The following faces are available.
@vtable @code
-@item mh-folder-blacklisted
-Blacklisted message face.
+@item mh-folder-blocklisted
+Blocklisted message face.
@c -------------------------
-@item mh-folder-whitelisted
-Whitelisted message face
+@item mh-folder-allowlisted
+Allowlisted message face
@end vtable
@cindex SpamProbe
@@ -7647,21 +7647,21 @@ example, you have both SpamAssassin and bogofilter
installed and you
want to use bogofilter, then you can set this option to
@samp{Bogofilter}.
-@findex mh-junk-blacklist
+@findex mh-junk-blocklist
@kindex J b
@vindex mh-junk-disposition
-The command @kbd{J b} (@code{mh-junk-blacklist}) trains the spam
+The command @kbd{J b} (@code{mh-junk-blocklist}) trains the spam
program in use with the content of the range (@pxref{Ranges}) and then
handles the message(s) as specified by the option
@code{mh-junk-disposition}. By default, this option is set to
@samp{Delete Spam} but you can also specify the name of the folder
which is useful for building a corpus of spam for training purposes.
-@findex mh-junk-whitelist
-@kindex J w
+@findex mh-junk-allowlist
+@kindex J a
-In contrast, the command @kbd{J w} (@code{mh-junk-whitelist})
+In contrast, the command @kbd{J a} (@code{mh-junk-allowlist})
reclassifies a range of messages (@pxref{Ranges}) as ham if it were
incorrectly classified as spam. It then refiles the message into the
@file{+inbox} folder.
@@ -7671,12 +7671,12 @@ incorrectly classified as spam. It then refiles the
message into the
@cindex @samp{Previous-Sequence} MH profile component
@cindex sequence, @samp{cur}
@cindex sequence, @samp{Previous-Sequence}
-@vindex mh-whitelist-preserves-sequences-flag
+@vindex mh-allowlist-preserves-sequences-flag
If a message is in any sequence (except @samp{Previous-Sequence:} and
-@samp{cur}) when it is whitelisted, then it will still be in those
+@samp{cur}) when it is allowlisted, then it will still be in those
sequences in the destination folder. If this behavior is not desired,
-then turn off the option @code{mh-whitelist-preserves-sequences-flag}.
+then turn off the option @code{mh-allowlist-preserves-sequences-flag}.
@cindex @file{*MH-E Log*}
@cindex buffers, @file{*MH-E Log*}
@@ -7687,7 +7687,7 @@ By default, the programs are run in the foreground, but
this can be
slow when junking large numbers of messages. If you have enough memory
or don't junk that many messages at the same time, you might try
turning on the option @code{mh-junk-background}. @footnote{Note that
-the option @code{mh-junk-background} is used as the @code{display}
+the option @code{mh-junk-background} is used as the @code{destination}
argument in the call to @code{call-process}. Therefore, turning on
this option means setting its value to @samp{0}. You can also set its
value to @samp{t} to direct the programs' output to the @file{*MH-E
@@ -7756,33 +7756,33 @@ the @samp{+spam} folder for later review. The major
weakness of
rules-based filters is a plethora of false positives so it is
worthwhile to check.
-@findex mh-junk-blacklist
-@findex mh-junk-whitelist
+@findex mh-junk-blocklist
+@findex mh-junk-allowlist
@kindex J b
-@kindex J w
+@kindex J a
If SpamAssassin classifies a message incorrectly, or is unsure, you can
-use the MH-E commands @kbd{J b} (@code{mh-junk-blacklist}) and
-@kbd{J w} (@code{mh-junk-whitelist}).
+use the MH-E commands @kbd{J b} (@code{mh-junk-blocklist}) and
+@kbd{J a} (@code{mh-junk-allowlist}).
@cindex @command{sa-learn}
@cindex @file{.spamassassin/user_prefs}
@cindex files, @file{.spamassassin/user_prefs}
-The command @kbd{J b} (@code{mh-junk-blacklist}) adds a
+The command @kbd{J b} (@code{mh-junk-blocklist}) adds a
@samp{blacklist_from} entry to @file{~/spamassassin/user_prefs},
deletes the message, and sends the message to the Razor, so that
others might not see this spam. If the @command{sa-learn} command is
available, the message is also recategorized as spam.
-The command@kbd{J w} (@code{mh-junk-whitelist}) adds a
+The command@kbd{J a} (@code{mh-junk-allowlist}) adds a
@samp{whitelist_from} rule to @samp{~/.spamassassin/user_prefs}. If
the @command{sa-learn} command is available, the message is also
recategorized as ham.
Over time, you'll observe that the same host or domain occurs
repeatedly in the @samp{blacklist_from} entries, so you might think
-that you could avoid future spam by blacklisting all mail from a
+that you could avoid future spam by blocklisting all mail from a
particular domain. The utility function
@code{mh-spamassassin-identify-spammers} helps you do precisely that.
This function displays a frequency count of the hosts and domains in
@@ -7796,7 +7796,7 @@ blacklist_from *@@*amazingoffersdirect2u.com
@end smallexample
In versions of SpamAssassin (2.50 and on) that support a Bayesian
-classifier, @kbd{J b} @code{(mh-junk-blacklist}) uses the program
+classifier, @kbd{J b} @code{(mh-junk-blocklist}) uses the program
@command{sa-learn} to recategorize the message as spam. Neither MH-E,
nor SpamAssassin, rebuilds the database after adding words, so you
will need to run @samp{sa-learn --rebuild} periodically. This can be
@@ -7856,14 +7856,14 @@ spam/.
spam/unsure/.
@end smallexample
-@findex mh-junk-blacklist
-@findex mh-junk-whitelist
+@findex mh-junk-blocklist
+@findex mh-junk-allowlist
@kindex J b
-@kindex J w
+@kindex J a
If bogofilter classifies a message incorrectly, or is unsure, you can
-use the MH-E commands @kbd{J b} (@code{mh-junk-blacklist}) and @kbd{J
-w} (@code{mh-junk-whitelist}) to update bogofilter's training.
+use the MH-E commands @kbd{J b} (@code{mh-junk-blocklist}) and
+@kbd{J a} (@code{mh-junk-allowlist}) to update bogofilter's training.
The @cite{Bogofilter FAQ} suggests that you run the following
occasionally to shrink the database:
@@ -7908,14 +7908,14 @@ SCORE=| spamprobe receive
spam/.
@end smallexample
-@findex mh-junk-blacklist
-@findex mh-junk-whitelist
+@findex mh-junk-blocklist
+@findex mh-junk-allowlist
@kindex J b
-@kindex J w
+@kindex J a
If SpamProbe classifies a message incorrectly, you can use the MH-E
-commands @kbd{J b} (@code{mh-junk-blacklist}) and @kbd{J w}
-(@code{mh-junk-whitelist}) to update SpamProbe's training.
+commands @kbd{J b} (@code{mh-junk-blocklist}) and @kbd{J a}
+(@code{mh-junk-allowlist}) to update SpamProbe's training.
@subheading Other Things You Can Do
diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org
index 9b1a001..5bb230f 100644
--- a/doc/misc/modus-themes.org
+++ b/doc/misc/modus-themes.org
@@ -2,12 +2,12 @@
#+author: Protesilaos Stavrou
#+email: info@protesilaos.com
#+language: en
-#+options: ':t toc:nil author:t email:t
+#+options: ':t toc:nil author:t email:t num:t
#+startup: content
-#+macro: stable-version 1.4.0
-#+macro: release-date 2021-05-25
-#+macro: development-version 1.5.0-dev
+#+macro: stable-version 1.5.0
+#+macro: release-date 2021-07-15
+#+macro: development-version 1.6.0-dev
#+macro: file @@texinfo:@file{@@$1@@texinfo:}@@
#+macro: space @@texinfo:@: @@
#+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@
@@ -245,8 +245,11 @@ a theme with either of the following expressions:
#+end_src
Changes to the available customization options must always be evaluated
-before loading a theme
([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]). This is
how a basic
-setup could look like:
+before loading a theme
([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]). An
exception to this
+norm is when using the various Custom interfaces or with commands like
+{{{kbd(M-x customize-set-variable)}}}, which automatically reload the theme by
+default ([[#h:9001527a-4e2c-43e0-98e8-3ef72d770639][Option for inhibiting
theme reload]]). This is how a basic setup
+could look like:
#+begin_src emacs-lisp
(require 'modus-themes)
@@ -294,9 +297,9 @@ package configurations in their setup. We use this as an
example:
:ensure ; omit this to use the built-in themes
:init
;; Add all your customizations prior to loading the themes
- (setq modus-themes-slanted-constructs t
+ (setq modus-themes-italic-constructs t
modus-themes-bold-constructs nil
- modus-themes-region 'no-extend)
+ modus-themes-region '(bg-only no-extend))
;; Load the theme files before enabling a theme (else you get an error).
(modus-themes-load-themes)
@@ -366,7 +369,7 @@ configure custom faces, where ~load-theme~ is expected,
though
The Modus themes are highly configurable, though they should work well
without any further tweaks. By default, all customization options are
-set to nil.
+set to nil, unless otherwise noted in this manual.
Remember that all customization options must be evaluated before loading
a theme ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]).
@@ -375,68 +378,78 @@ Below is a summary of what you will learn in the
subsequent sections of
this manual.
#+begin_src emacs-lisp
-(setq modus-themes-slanted-constructs t
+(setq modus-themes-italic-constructs t
modus-themes-bold-constructs nil
modus-themes-no-mixed-fonts nil
modus-themes-subtle-line-numbers nil
modus-themes-success-deuteranopia t
+ modus-themes-inhibit-reload t ; only applies to `customize-set-variable'
and related
modus-themes-fringes nil ; {nil,'subtle,'intense}
- ;; Options for `modus-themes-lang-checkers': nil,
- ;; 'straight-underline, 'subtle-foreground,
- ;; 'subtle-foreground-straight-underline, 'intense-foreground,
- ;; 'intense-foreground-straight-underline, 'colored-background
+ ;; Options for `modus-themes-lang-checkers' are either nil (the
+ ;; default), or a list of properties that may include any of those
+ ;; symbols: `straight-underline', `text-also', `background',
+ ;; `intense'
modus-themes-lang-checkers nil
- ;; Options for `modus-themes-mode-line': nil, '3d, 'moody,
- ;; 'borderless, 'borderless-3d, 'borderless-moody, 'accented,
- ;; 'accented-3d, 'accented-moody, 'borderless-accented,
- ;; 'borderless-accented-3d, 'borderless-accented-moody
- modus-themes-mode-line '3d
+ ;; Options for `modus-themes-mode-line' are either nil, or a list
+ ;; that can combine any of `3d' OR `moody', `borderless',
+ ;; `accented'. The variable's doc string shows all possible
+ ;; combinations.
+ modus-themes-mode-line '(3d accented)
- ;; Options for `modus-themes-syntax': nil, 'faint,
- ;; 'yellow-comments, 'green-strings,
- ;; 'yellow-comments-green-strings, 'alt-syntax,
- ;; 'alt-syntax-yellow-comments, 'faint-yellow-comments
+ ;; Options for `modus-themes-syntax' are either nil (the default),
+ ;; or a list of properties that may include any of those symbols:
+ ;; `faint', `yellow-comments', `green-strings', `alt-syntax'
modus-themes-syntax nil
- ;; Options for `modus-themes-hl-line': nil, 'intense-background,
- ;; 'accented-background, 'underline-neutral,
- ;; 'underline-accented, 'underline-only-neutral,
- ;; 'underline-only-accented
- modus-themes-hl-line 'underline-neutral
+ ;; Options for `modus-themes-hl-line' are either nil (the default),
+ ;; or a list of properties that may include any of those symbols:
+ ;; `accented', `underline', `intense'
+ modus-themes-hl-line '(underline accented)
- modus-themes-paren-match 'subtle-bold ;
{nil,'subtle-bold,'intense,'intense-bold}
+ ;; Options for `modus-themes-paren-match' are either nil (the
+ ;; default), or a list of properties that may include any of those
+ ;; symbols: `bold', `intense', `underline'
+ modus-themes-paren-match '(bold intense)
- ;; Options for `modus-themes-links': nil, 'faint,
- ;; 'neutral-underline, 'faint-neutral-underline, 'no-underline,
- ;; 'underline-only, 'neutral-underline-only
- modus-themes-links 'neutral-underline
+ ;; Options for `modus-themes-links' are either nil (the default),
+ ;; or a list of properties that may include any of those symbols:
+ ;; `neutral-underline' OR `no-underline', `faint' OR `no-color',
+ ;; `bold', `italic', `background'
+ modus-themes-links '(neutral-underline background)
- ;; Options for `modus-themes-prompts': nil, 'subtle-accented,
- ;; 'intense-accented, 'subtle-gray, 'intense-gray
- modus-themes-prompts 'subtle-gray
+ ;; Options for `modus-themes-prompts' are either nil (the
+ ;; default), or a list of properties that may include any of those
+ ;; symbols: `background', `bold', `gray', `intense', `italic'
+ modus-themes-prompts '(intense bold)
modus-themes-completions 'moderate ; {nil,'moderate,'opinionated}
modus-themes-mail-citations nil ; {nil,'faint,'monochrome}
- ;; Options for `modus-themes-region': nil, 'no-extend, 'bg-only,
- ;; 'bg-only-no-extend, 'accent, 'accent-no-extend
- modus-themes-region 'bg-only-no-extend
+ ;; Options for `modus-themes-region' are either nil (the default),
+ ;; or a list of properties that may include any of those symbols:
+ ;; `no-extend', `bg-only', `accented'
+ modus-themes-region '(bg-only no-extend)
;; Options for `modus-themes-diffs': nil, 'desaturated,
;; 'bg-only, 'deuteranopia, 'fg-only-deuteranopia
modus-themes-diffs 'fg-only-deuteranopia
modus-themes-org-blocks 'gray-background ;
{nil,'gray-background,'tinted-background}
- modus-themes-org-habit nil ; {nil,'simplified,'traffic-light}
+
+ modus-themes-org-agenda ; this is an alist: read the manual or its doc
string
+ '((header-block . (variable-pitch scale-title))
+ (header-date . (grayscale workaholic bold-today))
+ (scheduled . uniform)
+ (habit . traffic-light-deuteranopia))
modus-themes-headings ; this is an alist: read the manual or its doc
string
- '((1 . line)
- (2 . rainbow-line-no-bold)
- (t . no-bold))
+ '((1 . (overline background))
+ (2 . (rainbow overline))
+ (t . (no-bold)))
modus-themes-variable-pitch-ui nil
modus-themes-variable-pitch-headings t
@@ -445,9 +458,30 @@ this manual.
modus-themes-scale-2 1.15
modus-themes-scale-3 1.21
modus-themes-scale-4 1.27
- modus-themes-scale-5 1.33)
+ modus-themes-scale-title 1.33)
#+end_src
+** Option for inhibiting theme reload
+:properties:
+:alt_title: Custom reload theme
+:description: Toggle auto-reload of the theme when setting custom variables
+:custom_id: h:9001527a-4e2c-43e0-98e8-3ef72d770639
+:end:
+#+vindex: modus-themes-inhibit-reload
+
+Symbol: ~modus-themes-inhibit-reload~
+
+Possible values:
+
+1. ~nil~
+2. ~t~ (default)
+
+By default, customizing a theme-related user option through the Custom
+interfaces or with {{{kbd(M-x customize-set-variable)}}} will not reload the
+currently active Modus theme.
+
+Enable this behaviour by setting this variable to ~nil~.
+
** Option for color-coding success state (deuteranopia)
:properties:
:alt_title: Success' color-code
@@ -501,26 +535,36 @@ weight. This concerns keywords and other important
aspects of code
syntax. It also affects certain mode line indicators and command-line
prompts.
-** Option for more slanted constructs
+Advanced users may also want to configure the exact attributes of the
+~bold~ face.
+
+[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]].
+
+** Option for more italic constructs
:properties:
-:alt_title: Slanted constructs
-:description: Toggle slanted constructs (italics) in code
+:alt_title: Italic constructs
+:description: Toggle italic font constructs in code
:custom_id: h:977c900d-0d6d-4dbb-82d9-c2aae69543d6
:end:
-#+vindex: modus-themes-slanted-constructs
+#+vindex: modus-themes-italic-constructs
-Symbol: ~modus-themes-slanted-constructs~
+Symbol: ~modus-themes-italic-constructs~
Possible values:
1. ~nil~ (default)
2. ~t~
-The default is to not use slanted text (italics) unless it is absolutely
-necessary.
+The default is to not use slanted text forms (italics) unless it is
+absolutely necessary.
-With a non-nil value (~t~) choose to render more faces in slanted text.
-This typically affects documentation strings and code comments.
+With a non-nil value (~t~) choose to render more faces in italics. This
+typically affects documentation strings and code comments.
+
+Advanced users may also want to configure the exact attributes of the
+~italic~ face.
+
+[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]].
** Option for syntax highlighting
:properties:
@@ -532,44 +576,57 @@ This typically affects documentation strings and code
comments.
Symbol: ~modus-themes-syntax~
-Possible values:
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
-1. ~nil~ (default)
-2. ~faint~
-3. ~yellow-comments~
-4. ~green-strings~
-5. ~yellow-comments-green-strings~
-6. ~alt-syntax~
-7. ~alt-syntax-yellow-comments~
-8. ~faint-yellow-comments~
-
-The default style (nil) for code syntax highlighting is a balanced
++ ~faint~
++ ~yellow-comments~
++ ~green-strings~
++ ~alt-syntax~
+
+The default (a ~nil~ value or an empty list) is to use a balanced
combination of colors on the cyan-blue-magenta side of the spectrum.
-There is little to no use of greens, yellows, or reds, except when it is
-necessary.
+There is little to no use of greens, yellows, and reds. Comments are
+gray, strings are blue colored, doc strings are a shade of cyan, while
+color combinations are designed to avoid exaggerations.
+
+The property ~faint~ fades the saturation of all applicable colors, where
+that is possible or appropriate.
+
+The property ~yellow-comments~ applies a yellow color to comments.
-Option ~faint~ is like the default in terms of the choice of palette but
-applies desaturated color values.
+The property ~green-strings~ applies a green color to strings and a green
+tint to doc strings.
-Option ~yellow-comments~ adds a yellow tint to comments. The rest of the
-syntax is the same as the default.
+The property ~alt-syntax~ changes the combination of colors beyond strings
+and comments, so that the effective palette is broadened to provide
+greater variety relative to the default.
-Option ~green-strings~ replaces the blue/cyan/cold color variants in
-strings with greener alternatives. The rest of the syntax remains the
-same.
+Combinations of any of those properties are expressed as a list, like in
+these examples:
-Option ~yellow-comments-green-strings~ combines yellow comments with green
-strings and the rest of the default syntax highlighting style.
+#+begin_src emacs-lisp
+(faint)
+(green-strings yellow-comments)
+(alt-syntax green-strings yellow-comments)
+(faint alt-syntax green-strings yellow-comments)
+#+end_src
-Option ~alt-syntax~ expands the active spectrum by applying color
-combinations with more contrasting hues between them. Expect to find
-red and green variants in addition to cyan, blue, magenta.
+The order in which the properties are set is not significant.
-Option ~alt-syntax-yellow-comments~ combines ~alt-syntax~ with
-~yellow-comments~.
+In user configuration files the form may look like this:
-Option ~faint-yellow-comments~ combines the ~faint~ style with
-~yellow-comments~.
+#+begin_src emacs-lisp
+(setq modus-themes-syntax '(faint alt-syntax))
+#+end_src
+
+Independent of this variable, users may also control the use of a bold
+weight or italic text: ~modus-themes-bold-constructs~ and
+~modus-themes-italic-constructs~.
+
+[[#h:b25714f6-0fbe-41f6-89b5-6912d304091e][Option for more bold constructs]].
+
+[[#h:977c900d-0d6d-4dbb-82d9-c2aae69543d6][Option for more italic constructs]].
** Option for no font mixing
:properties:
@@ -611,43 +668,66 @@ are ~org-variable-pitch~ and ~mixed-pitch~.
Symbol: ~modus-themes-links~
-Possible values:
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
-1. ~nil~ (default)
-2. ~faint~
-3. ~neutral-underline~
-4. ~faint-neutral-underline~
-5. ~no-underline~
-6. ~underline-only~
-7. ~neutral-underline-only~
++ Underline style:
+ - ~neutral-underline~
+ - ~no-underline~
++ Text coloration:
+ - ~faint~
+ - ~no-color~
++ ~bold~
++ ~italic~
++ ~background~
+
+The default (a ~nil~ value or an empty list) is a prominent text color,
+typically blue, with an underline of the same color.
-The default style (nil) for links is to apply an underline and a
-saturated color to the affected text. The color of the two is the same,
-which makes the link fairly prominent.
+For the style of the underline, a ~neutral-underline~ property turns the
+color of the line into a subtle gray, while the ~no-underline~ property
+removes the line altogether. If both of those are set, the latter takes
+precedence.
-Option ~faint~ follows the same approach as the default, but uses less
-intense colors.
+For text coloration, a ~faint~ property desaturates the color of the text
+and the underline, unless the underline is affected by the
+aforementioned properties. While a ~no-color~ property removes the color
+from the text. If both of those are set, the latter takes precedence.
-Option ~neutral-underline~ changes the underline's color to a subtle gray,
-while retaining the default text color.
+A ~bold~ property applies a heavy typographic weight to the text of the
+link.
-Option ~faint-neutral-underline~ combines a desaturated text color with a
-subtle gray underline.
+An ~italic~ property adds a slant to the link's text (italic or oblique
+forms, depending on the typeface).
-Option ~no-underline~ removes link underlines altogether, while retaining
-their original fairly vivid color.
+A ~background~ property applies a subtle tinted background color.
-Option ~underline-only~ applies a prominent underline while making the
-affected text colorless (it uses the same foreground as the theme's
-default).
+In case both ~no-underline~ and ~no-color~ are set, then a subtle gray
+background is applied to all links. This can still be combined with the
+~bold~ and ~italic~ properties.
-Option ~neutral-underline-only~ makes the text colorless while using a
-subtle gray underline below it.
+Combinations of any of those properties are expressed as a list,
+like in these examples:
-NOTE: The placement of the underline, i.e. its proximity to the affected
-text, is controlled by the built-in ~x-underline-at-descent-line~,
-~x-use-underline-position-properties~, ~underline-minimum-offset~. Please
-refer to their documentation strings.
+#+begin_src emacs-lisp
+(faint)
+(no-underline faint)
+(no-color no-underline bold)
+(italic bold background no-color no-underline)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-links '(neutral-underline background))
+#+end_src
+
+The placement of the underline, meaning its proximity to the text, is
+controlled by ~x-use-underline-position-properties~,
+~x-underline-at-descent-line~, ~underline-minimum-offset~. Please refer to
+their documentation strings.
** Option for command prompt styles
:properties:
@@ -659,27 +739,51 @@ refer to their documentation strings.
Symbol: ~modus-themes-prompts~
-Possible values:
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
-1. ~nil~ (default)
-2. ~subtle-accented~ (~subtle~ exists for backward compatibility)
-3. ~intense-accented~ (~intense~ exists for backward compatibility)
-4. ~subtle-gray~
-5. ~intense-gray~
++ ~background~
++ ~bold~
++ ~gray~
++ ~intense~
++ ~italic~
+
+The default (a ~nil~ value or an empty list) means to only use a subtle
+accented foreground color.
+
+The property ~background~ applies a background color to the prompt's text.
+By default, this is a subtle accented value.
-The default does not use any background for minibuffer and command line
-prompts. It relies exclusively on an accented foreground color.
+The property ~intense~ makes the foreground color more prominent. If the
+~background~ property is also set, it amplifies the value of the
+background as well.
-Options ~subtle-accented~ and ~intense-accented~ will change both the
-background and the foreground values to use accented color combinations
-that follow the hue of the default styles' foreground (e.g. the default
-minibuffer prompt is cyan text, so these combinations will involved a
-cyan background and an appropriate cyan foreground). The difference
-between the two is that the latter has a more pronounced/noticeable
-effect than the former.
+The property ~gray~ changes the prompt's colors to grayscale. This
+affects the foreground and, if the ~background~ property is also set, the
+background. Its effect is subtle, unless it is combined with the
+~intense~ property.
-Options ~subtle-gray~, ~intense-gray~ are like their accented counterparts,
-except they use grayscale values.
+The property ~bold~ makes the text use a bold typographic weight.
+Similarly, ~italic~ adds a slant to the font's forms (italic or oblique
+forms, depending on the typeface).
+
+Combinations of any of those properties are expressed as a list, like in
+these examples:
+
+#+begin_src emacs-lisp
+(intense)
+(bold intense)
+(intense bold gray)
+(intense background gray bold)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-prompts '(background gray))
+#+end_src
** Option for mode line presentation
:properties:
@@ -691,83 +795,78 @@ except they use grayscale values.
Symbol: ~modus-themes-mode-line~
-Possible values:
+Possible values, which can be expressed as a list of combinations of box
+effect, color, and border visibility:
-1. ~nil~ (default)
-2. ~3d~
-3. ~moody~
-4. ~borderless~
-5. ~borderless-3d~
-6. ~borderless-moody~
-7. ~accented~
-8. ~accented-3d~
-9. ~accented-moody~
-10. ~borderless-accented~
-11. ~borderless-accented-3d~
-12. ~borderless-accented-moody~
-
-The default produces a two-dimensional effect both for the active and
-inactive mode lines. The differences between the two are limited to
-distinct shades of grayscale values, with the active being more intense
-than the inactive.
-
-Option ~3d~ will make the active mode line look like a three-dimensional
-rectangle. Inactive mode lines remain 2D, though they are slightly
-toned down relative to the default. This aesthetic is virtually the
-same as what you get when you run Emacs without any customizations
-(=emacs -Q= on the command line).
-
-While ~moody~ removes all box effects from the mode lines and applies
-underline and overline properties instead. It also tones down a bit the
-inactive mode lines. This is meant to optimize things for use with the
-[[https://github.com/tarsius/moody][moody package]] (hereinafter referred to
as "Moody"), though it can work
-fine even without it.
-
-The ~borderless~ option uses the same colors as the default (nil value),
-but removes the border effect. This is done by making the box property
-use the same color as the background, effectively blending the two and
-creating some padding.
-
-The ~borderless-3d~ and ~borderless-moody~ approximate the ~3d~ and ~moody~
-options respectively, while removing the borders. However, to ensure
-that the inactive mode lines remain visible, they apply a slightly more
-prominent background to them than what their counterparts do (same
-inactive background as with the default).
-
-Similarly, ~accented~, ~accented-3d~, and ~accented-moody~ correspond to the
-default (~nil~), ~3d~, and ~moody~ styles respectively, except that the active
-mode line uses a colored background instead of the standard shade of
-gray.
-
-Same principle for ~borderless-accented~, ~borderless-accented-3d~, and
-~borderless-accented-moody~ which use a colored background for the active
-mode line and have no discernible borders around both the active and
-inactive the mode lines.
++ Overall style:
+ - ~3d~
+ - ~moody~
++ ~accented~
++ ~borderless~
+
+The default (a nil value or an empty list) is a two-dimensional
+rectangle with a border around it. The active and the inactive
+mode lines use different shades of grayscale values for the
+background, foreground, border.
+
+The ~3d~ property applies a three-dimensional effect to the
+active mode line. The inactive mode lines remain two-dimensional
+and are toned down a bit, relative to the default style.
+
+The ~moody~ property optimizes the mode line for use with the
+library of the same name (hereinafter referred to as 'Moody').
+In practice, it removes the box effect and replaces it with
+underline and overline properties. It also tones down the
+inactive mode lines. Despite its intended purpose, this option
+can also be used without the Moody library (please consult the
+themes' manual on this point for more details). If both ~3d~ and
+~moody~ properties are set, the latter takes precedence.
+
+The ~borderless~ property removes the color of the borders. It
+does not actually remove the borders, but only makes their color
+the same as the background, effectively creating some padding.
+
+The ~accented~ property ensures that the active mode line uses a
+colored background instead of the standard shade of gray.
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
+
+#+begin_src emacs-lisp
+(accented)
+(borderless 3d)
+(moody accented borderless)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-prompts '(borderless accented))
+#+end_src
Note that Moody does not expose any faces that the themes could style
directly. Instead it re-purposes existing ones to render its tabs and
ribbons. As such, there may be cases where the contrast ratio falls
below the 7:1 target that the themes conform with (WCAG AAA). To hedge
-against this, we configure a fallback foreground for the ~moody~ option,
+against this, we configure a fallback foreground for the ~moody~ property,
which will come into effect when the background of the mode line changes
to something less accessible, such as Moody ribbons (read the doc string
of ~set-face-attribute~, specifically ~:distant-foreground~). This fallback
is activated when Emacs determines that the background and foreground of
the given construct are too close to each other in terms of color
-distance. In effect, users would need to experiment with the variable
+distance. In practice, users will need to experiment with the variable
~face-near-same-color-threshold~ to trigger the effect. We find that a
-value of =45000= will suffice, contrary to the default =30000=. Though for
-the ~accented-moody~ value mentioned above, that should be raised up to
-=70000=. Do not set it too high, because it has the adverse effect of
-always overriding the default colors (which have been carefully designed
-to be highly accessible).
+value of =45000= shall suffice, contrary to the default =30000=. Though for
+the combinations that involve the ~accented~ and ~moody~ properties, as
+mentioned above, that should be raised up to =70000=. Do not set it too
+high, because it has the adverse effect of always overriding the default
+colors (which have been carefully designed to be highly accessible).
Furthermore, because Moody expects an underline and overline instead of
-a box style, it is advised you include this in your setup:
-
-#+begin_src emacs-lisp
-(setq x-underline-at-descent-line t)
-#+end_src
+a box style, it is advised to set ~x-underline-at-descent-line~ to a
+non-nil value.
** Option for completion framework aesthetics
:properties:
@@ -877,43 +976,55 @@ names imply.
Symbol: ~modus-themes-lang-checkers~
-Possible values:
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
-1. ~nil~ (default)
-2. ~subtle-foreground~
-3. ~intense-foreground~
-4. ~straight-underline~
-5. ~subtle-foreground-straight-underline~
-6. ~intense-foreground-straight-underline~
-7. ~colored-background~
-
-Nil (the default) applies a color-coded underline to the affected text,
-while it leaves the original foreground in tact. If the display spec
-where Emacs runs in has support for it (e.g. Emacs GUI), the underline's
-style is that of a wave, otherwise it is a straight line.
-
-Options ~subtle-foreground~ and ~intense-foreground~ follow the same
-color-coding pattern and wavy underline of the default, while extending
-it with a corresponding foreground value for the affected text. The
-difference between the two options is one of degree, as their names
-suggest.
-
-Option ~straight-underline~ is like the default but always applies a
-straight line under the affected text. Same principle for
-~subtle-foreground-straight-underline~ and its counterpart
-~intense-foreground-straight-underline~.
-
-Option ~colored-background~ uses a straight underline, a tinted
-background, and a suitable foreground. All are color-coded. This is
-the most intense combination of face properties.
-
-The present variable affects packages and/or face groups such as those
-of =flyspell=, =flymake=, =flycheck=, ~artbollocks-mode~, and ~writegood-mode~.
++ ~straight-underline~
++ ~text-also~
++ ~background~
++ ~intense~
+
+The default (a ~nil~ value or an empty list) applies a color-coded
+underline to the affected text, while it leaves the original foreground
+intact. If the display spec of Emacs has support for it, the
+underline's style is that of a wave, otherwise it is a straight line.
+
+The property ~straight-underline~ ensures that the underline under the
+affected text is always drawn as a straight line.
+
+The property ~text-also~ applies the same color of the underline to the
+affected text.
+
+The property ~background~ adds a color-coded background.
+
+The property ~intense~ amplifies the applicable colors if ~background~
+and/or ~text-only~ are set. If ~intense~ is set on its own, then it implies
+~text-only~.
+
+To disable fringe indicators for Flymake or Flycheck, refer to variables
+~flymake-fringe-indicator-position~ and ~flycheck-indication-mode~,
+respectively.
+
+Combinations of any of those properties can be expressed in a
+list, as in those examples:
+
+#+begin_src emacs-lisp
+(background)
+(straight-underline intense)
+(background text-also straight-underline)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-lang-checkers '(text-also background))
+#+end_src
NOTE: The placement of the straight underline, though not the wave
-style, is controlled by the built-in ~x-underline-at-descent-line~,
-~x-use-underline-position-properties~, ~underline-minimum-offset~. Please
-refer to their documentation strings.
+style, is controlled by the built-in variables ~underline-minimum-offset~,
+~x-underline-at-descent-line~, ~x-use-underline-position-properties~.
** Option for line highlighting (hl-line-mode)
:properties:
@@ -925,43 +1036,47 @@ refer to their documentation strings.
Symbol: ~modus-themes-hl-line~
-Possible values:
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
-1. ~nil~ (default)
-2. ~intense-background~
-3. ~accented-background~
-4. ~underline-neutral~
-5. ~underline-accented~
-6. ~underline-only-neutral~
-7. ~underline-only-accented~
++ ~accented~
++ ~intense~
++ ~underline~
-The default is to use a subtle gray background for the current line when
-~hl-line-mode~ is enabled.
+The default (a ~nil~ value or an empty list) is a subtle gray background
+color.
-The ~intense-background~ applies a more prominent gray to the background
-of the current line.
+The property ~accented~ changes the background to a colored variant.
-With ~accented-background~ the background gets a colored hint and is more
-prominent than the default.
+An ~underline~ property draws a line below the highlighted area. Its
+color is similar to the background, so gray by default or an accent
+color when ~accented~ is also set.
-The ~underline-neutral~ combines the default subtle neutral background
-with a gray underline.
+An ~intense~ property amplifies the colors in use, which may be both the
+background and the underline.
-Similarly, the ~underline-accented~ renders the background of the current
-line in a subtle colored background, while it also draws an accented
-underline.
+Combinations of any of those properties are expressed as a list, like in
+these examples:
-Option ~underline-only-neutral~ produces a neutral underline, but does not
-use any background.
+#+begin_src emacs-lisp
+(intense)
+(underline intense)
+(accented intense underline)
+#+end_src
-While ~underline-only-accented~ also uses just an underline, only this one
-is colored.
+The order in which the properties are set is not significant.
-Consider setting the variable ~x-underline-at-descent-line~ to a non-nil
-value for better results with underlines.
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-hl-line '(underline accented))
+#+end_src
+
+Set ~x-underline-at-descent-line~ to a non-nil value for better results
+with underlines.
This style affects several packages that enable ~hl-line-mode~, such as
-=elfeed= and =mu4e=.
+=elfeed=, =notmuch=, and =mu4e=.
** Option for line numbers (display-line-numbers-mode)
:properties:
@@ -1002,26 +1117,42 @@ updated to accommodate this aesthetic.
Symbol: ~modus-themes-paren-match~
-Possible values:
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
-1. ~nil~ (default)
-2. ~subtle-bold~
-3. ~intense~
-4. ~intense-bold~
++ ~bold~
++ ~intense~
++ ~underline~
-Nil means to use a subtle tinted background color for the matching
+The default (a ~nil~ value or an empty list) is a subtle background color.
+
+The ~bold~ property adds a bold weight to the characters of the matching
delimiters.
-Option ~intense~ applies a saturated background color.
+The ~intense~ property applies a more prominent background color to the
+delimiters.
-Option ~subtle-bold~ is the same as the default, but also makes use of
-bold typographic weight (inherits the ~bold~ face).
+The ~underline~ property draws a straight line under the affected text.
-Option ~intense-bold~ is the same as ~intense~, while it also uses a bold
-weight.
+Combinations of any of those properties are expressed as a list, like in
+these examples:
+
+#+begin_src emacs-lisp
+(bold)
+(underline intense)
+(bold intense underline)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-paren-match '(bold intense))
+#+end_src
-This customization variable affects tools such as the built-in
-~show-paren-mode~ and the =smartparens= package.
+This customization variable affects the built-in ~show-paren-mode~ and the
+=smartparens= package.
** Option for active region
:properties:
@@ -1033,33 +1164,41 @@ This customization variable affects tools such as the
built-in
Symbol: ~modus-themes-region~
-Possible values:
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
-1. ~nil~ (default)
-2. ~no-extend~
-3. ~bg-only~
-4. ~bg-only-no-extend~
-5. ~accent~
-6. ~accent-no-extend~
++ ~no-extend~
++ ~bg-only~
++ ~accented~
-Nil means to only use a prominent gray background with a neutral
-foreground. The foreground overrides all syntax highlighting. The
-region extends to the edge of the window.
+The default (a ~nil~ value or an empty list) is a prominent gray
+background that overrides all foreground colors in the area it
+encompasses. Its reach extends to the edge of the window.
-Option ~no-extend~ preserves the default aesthetic but prevents the region
-from extending to the edge of the window.
+The ~no-extend~ property limits the region to the end of the line, so that
+it does not reach the edge of the window.
-Option ~bg-only~ applies a faint tinted background that is distinct from
-all others used in the theme, while it does not override any existing
-colors. It extends to the edge of the window.
+The ~bg-only~ property makes the region's background color more subtle to
+allow the underlying text to retain its foreground colors.
-Option ~bg-only-no-extend~ is a combination of the ~bg-only~ and ~no-extend~
-options.
+The ~accented~ property applies a more colorful background to the region.
+
+Combinations of any of those properties are expressed as a list, like in
+these examples:
-Option ~accent~ is like the default, though it uses a more colorful
-background, while ~accent-no-extend~ is the same except it draws the
-region only up to the end of each line instead of extending to the edge
-of the window.
+#+begin_src emacs-lisp
+(no-extend)
+(bg-only accented)
+(accented bg-only no-extend)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-region '(bg-only no-extend))
+#+end_src
** Option for diff buffer looks
:properties:
@@ -1148,169 +1287,238 @@ Older versions of the themes provided options
~grayscale~ (or ~greyscale~)
and ~rainbow~. Those will continue to work as they are aliases for
~gray-background~ and ~tinted-background~, respectively.
-** Option for org-habit graph styles
+** Option for Org agenda constructs
:properties:
-:alt_title: Org agenda habits
-:description: Choose among standard, simplified, or traffic light styles
-:custom_id: h:b7e328c0-3034-4db7-9cdf-d5ba12081ca2
+:alt_title: Org agenda
+:description: Control each element in the presentation of the agenda
+:custom_id: h:68f481bc-5904-4725-a3e6-d7ecfa7c3dbc
:end:
-#+vindex: modus-themes-org-habit
+#+vindex: modus-themes-org-agenda
-Symbol: ~modus-themes-org-habit~
+Symbol: ~modus-themes-org-agenda~
-Possible values:
+This is an alist that accepts a =(key . value)= combination. Some values
+are specified as a list. Here is a sample, followed by a description of
+all possible combinations:
-1. ~nil~ (default)
-2. ~simplified~
-3. ~traffic-light~
-
-The default is meant to conform with the original aesthetic of
-=org-habit=. It employs all four color codes that correspond to the
-org-habit states---clear, ready, alert, and overdue---while
-distinguishing between their present and future variants. This results
-in a total of eight colors in use: red, yellow, green, blue, in tinted
-and shaded versions. They cover the full set of information provided by
-the =org-habit= consistency graph.
-
-Option ~simplified~ is like the default except that it removes the
-dichotomy between current and future variants by applying uniform
-color-coded values. It applies a total of four colors: red, yellow,
-green, blue. They produce a simplified consistency graph that is more
-legible (or less "busy") than the default. The intent is to shift focus
-towards the distinction between the four states of a habit task, rather
-than each state's present/future outlook.
-
-Option ~traffic-light~ further reduces the available colors to red,
-yellow, and green. As in ~simplified~, present and future variants appear
-uniformly, but differently from it, the 'clear' state is rendered in a
-green hue, instead of the original blue. This is meant to capture the
-use-case where a habit task being "too early" is less important than it
-being "too late". The difference between ready and clear states is
-attenuated by painting both of them using shades of green. This option
-thus highlights the alert and overdue states.
+#+begin_src emacs-lisp
+(setq modus-themes-org-agenda
+ '((header-block . (variable-pitch scale-title))
+ (header-date . (grayscale workaholic bold-today))
+ (scheduled . uniform)
+ (habit . traffic-light)))
+#+end_src
-** Option for the headings' overall style
-:properties:
-:alt_title: Heading styles
-:description: Choose among several styles, also per heading level
-:custom_id: h:271eff19-97aa-4090-9415-a6463c2f9ae1
-:end:
-#+vindex: modus-themes-headings
+A ~header-block~ key applies to elements that concern the headings which
+demarcate blocks in the structure of the agenda. By default (a ~nil~
+value) those are rendered in a bold typographic weight, plus a height
+that is slightly taller than the default font size. Acceptable values
+come in the form of a list that can include either or both of those
+properties:
-This is defined as an alist and, therefore, uses a different approach
-than other customization options documented in this manual.
+- ~variable-pitch~ to use a proportionately spaced typeface;
+- ~scale-title~ to increase the size to the number assigned to
+ ~modus-themes-scale-title~
([[#h:6868baa1-beba-45ed-baa5-5fd68322ccb3][Control the scale of headings]]) or
~no-scale~
+ to make the font use the same height as the rest of the buffer.
-Symbol: ~modus-themes-headings~
+In case both ~scale-title~ and ~no-scale~ are in the list, the latter takes
+precedence.
-Possible values, which can be specified for each heading level N
-(examples further below):
+Example usage:
-+ ~nil~ (~t~ is also available for backward compatibility)
-+ ~no-bold~
-+ ~line~
-+ ~line-no-bold~
-+ ~rainbow~
-+ ~rainbow-line~
-+ ~rainbow-line-no-bold~
-+ ~highlight~
-+ ~highlight-no-bold~
-+ ~rainbow-highlight~
-+ ~rainbow-highlight-no-bold~
-+ ~section~
-+ ~section-no-bold~
-+ ~rainbow-section~
-+ ~rainbow-section-no-bold~
-+ ~no-color~
-+ ~no-color-no-bold~
-
-To control faces per level from 1-8, use something like this:
+#+begin_src emacs-lisp
+(header-block . nil)
+(header-block . (scale-title))
+(header-block . (no-scale))
+(header-block . (variable-pitch scale-title))
+#+end_src
+
+A ~header-date~ key covers date headings. Dates use only a foreground
+color by default (a ~nil~ value), with weekdays and weekends having a
+slight difference in hueness. The current date has an added gray
+background. This key accepts a list of values that can include any of
+the following properties:
+
+- ~grayscale~ to make weekdays use the main foreground color and
+ weekends a more subtle gray;
+- ~workaholic~ to make weekdays and weekends look the same in
+ terms of color;
+- ~bold-today~ to apply a bold typographic weight to the current
+ date;
+- ~bold-all~ to render all date headings in a bold weight.
+
+For example:
#+begin_src emacs-lisp
-(setq modus-themes-headings
- '((1 . section)
- (2 . section-no-bold)
- (3 . rainbow-line)
- (t . rainbow-line-no-bold)))
+(header-date . nil)
+(header-date . (workaholic))
+(header-date . (grayscale bold-all))
+(header-date . (grayscale workaholic))
+(header-date . (grayscale workaholic bold-today))
#+end_src
-The above uses the ~section~ value for heading levels 1, ~section-no-bold~
-for headings 2, ~rainbow-line~ for 3. All other levels fall back to
-~rainbow-line-no-bold~.
+A ~scheduled~ key applies to tasks with a scheduled date. By default (a
+~nil~ value), those use varying shades of yellow to denote (i) a past or
+current date and (ii) a future date. Valid values are symbols:
+
+- nil (default);
+- ~uniform~ to make all scheduled dates the same color;
+- ~rainbow~ to use contrasting colors for past, present, future
+ scheduled dates.
-To set a uniform value for all heading levels, use this pattern:
+For example:
#+begin_src emacs-lisp
-;; A given style for every heading
-(setq modus-themes-headings
- '((t . section)))
+(scheduled . nil)
+(scheduled . uniform)
+(scheduled . rainbow)
+#+end_src
-;; Default aesthetic for every heading
-(setq modus-themes-headings nil)
+A ~habit~ key applies to the ~org-habit~ graph. All possible value are
+passed as a symbol. Those are:
+
+- The default (~nil~) is meant to conform with the original aesthetic of
+ ~org-habit~. It employs all four color codes that correspond to the
+ org-habit states---clear, ready, alert, and overdue---while
+ distinguishing between their present and future variants. This
+ results in a total of eight colors in use: red, yellow, green, blue,
+ in tinted and shaded versions. They cover the full set of information
+ provided by the ~org-habit~ consistency graph.
+- ~simplified~ is like the default except that it removes the dichotomy
+ between current and future variants by applying uniform color-coded
+ values. It applies a total of four colors: red, yellow, green, blue.
+ They produce a simplified consistency graph that is more legible (or
+ less busy) than the default. The intent is to shift focus towards the
+ distinction between the four states of a habit task, rather than each
+ state's present/future outlook.
+- ~traffic-light~ further reduces the available colors to red, yellow, and
+ green. As in ~simplified~, present and future variants appear
+ uniformly, but differently from it, the ~clear~ state is rendered in a
+ green hue, instead of the original blue. This is meant to capture the
+ use-case where a habit task being too early is less important than it
+ being too late. The difference between ready and clear states is
+ attenuated by painting both of them using shades of green. This
+ option thus highlights the alert and overdue states.
+- ~traffic-light-deuteranopia~ is like the ~traffic-light~ except its three
+ colors are red, yellow, and blue to be suitable for users with
+ red-green color deficiency (deuteranopia).
+
+For example:
+
+#+begin_src emacs-lisp
+(habit . nil)
+(habit . simplified)
+(habit . traffic-light)
#+end_src
-The default style for headings uses a fairly desaturated foreground
-color in combination with bold typographic weight. To specify this
-style for a given level N, assuming you wish to have another fallback
-option, just assign the value ~nil~ like this:
+Putting it all together, the alist can look like this:
+
+#+begin_src emacs-lisp
+'((header-block . (scale-title variable-pitch))
+ (header-date . (grayscale workaholic bold-today))
+ (scheduled . uniform)
+ (habit . traffic-light))
+
+;; Or else:
+(setq modus-themes-org-agenda
+ '((header-block . (scale-title variable-pitch))
+ (header-date . (grayscale workaholic bold-today))
+ (scheduled . uniform)
+ (habit . traffic-light)))
+#+end_src
+
+** Option for the headings' overall style
+:properties:
+:alt_title: Heading styles
+:description: Choose among several styles, also per heading level
+:custom_id: h:271eff19-97aa-4090-9415-a6463c2f9ae1
+:end:
+#+vindex: modus-themes-headings
+
+Symbol: ~modus-themes-headings~
+
+This is an alist that accepts a =(key . list-of-values)= combination. The
+key is either a number, representing the heading's level or ~t~, which
+pertains to the fallback style. The list of values covers symbols that
+refer to properties, as described below. Here is a sample, followed by
+a presentation of all available properties:
#+begin_src emacs-lisp
(setq modus-themes-headings
- '((1 . nil)
- (2 . line)
- (3) ; same as nil
- (t . rainbow-line-no-bold)))
+ '((1 . (background overline))
+ (2 . (overline rainbow))
+ (t . (monochrome))))
#+end_src
-A description of all other possible styles beyond the default:
+Properties:
-+ ~no-bold~ retains the default text color while removing the bold
- typographic weight.
++ ~rainbow~
++ ~overline~
++ ~background~
++ ~no-bold~
++ ~monochrome~
-+ ~line~ is the same as the default plus an overline across the
- heading's length.
+By default (a ~nil~ value for this variable), all headings have a bold
+typographic weight and use a desaturated text color.
-+ ~line-no-bold~ is the same as ~line~ without bold weight.
+A ~rainbow~ property makes the text color more saturated.
-+ ~rainbow~ uses a more colorful foreground in combination with bold
- typographic weight.
+An ~overline~ property draws a line above the area of the heading.
-+ ~rainbow-line~ is the same as ~rainbow~ plus an overline.
+A ~background~ property adds a subtle tinted color to the background of
+the heading.
-+ ~rainbow-line-no-bold~ is the same as ~rainbow-line~ without the bold
- weight.
+A ~no-bold~ property removes the bold weight from the heading's text.
-+ ~highlight~ retains the default style of a fairly desaturated
- foreground combined with a bold weight and adds to it a subtle
- accented background.
+A ~monochrome~ property makes all headings the same base color, which is
+that of the default for the active theme (black/white). When ~background~
+is also set, ~monochrome~ changes its color to gray. If both ~monochrome~
+and ~rainbow~ are set, the former takes precedence.
-+ ~highlight-no-bold~ is the same as ~highlight~ without a bold weight.
+Combinations of any of those properties are expressed as a list, like in
+these examples:
-+ ~rainbow-highlight~ is the same as ~highlight~ but with a more
- colorful foreground.
+#+begin_src emacs-lisp
+(no-bold)
+(rainbow background)
+(overline monochrome no-bold)
+#+end_src
-+ ~rainbow-highlight-no-bold~ is the same as ~rainbow-highlight~ without
- a bold weight.
+The order in which the properties are set is not significant.
-+ ~section~ retains the default looks and adds to them both an overline
- and a slightly accented background. It is, in effect, a combination
- of the ~line~ and ~highlight~ values.
+In user configuration files the form may look like this:
-+ ~section-no-bold~ is the same as ~section~ without a bold weight.
+#+begin_src emacs-lisp
+(setq modus-themes-headings
+ '((1 . (background overline rainbow))
+ (2 . (background overline))
+ (t . (overline no-bold))))
+#+end_src
-+ ~rainbow-section~ is the same as ~section~ but with a more colorful
- foreground.
+When defining the styles per heading level, it is possible to pass a
+non-nil value (~t~) instead of a list of properties. This will retain the
+original aesthetic for that level. For example:
-+ ~rainbow-section-no-bold~ is the same as ~rainbow-section~ without a
- bold weight.
+#+begin_src emacs-lisp
+(setq modus-themes-headings
+ '((1 . t) ; keep the default style
+ (2 . (background overline))
+ (t . (rainbow)))) ; style for all other headings
-+ ~no-color~ does not apply any color to the heading, meaning that it
- uses the foreground of the ~default~ face. It still renders the text
- with a bold typographic weight.
+(setq modus-themes-headings
+ '((1 . (background overline))
+ (2 . (rainbow no-bold))
+ (t . t))) ; default style for all other levels
+#+end_src
-+ ~no-color-no-bold~ is like ~no-color~ but without the bold weight.
+For Org users, the extent of the heading depends on the variable
+~org-fontify-whole-heading-line~. This affects the ~overline~ and
+~background~ properties. Depending on the version of Org, there may be
+others, such as ~org-fontify-done-headline~.
-Remember to also inspect relevant variables that Org provides, such as:
-~org-fontify-whole-heading-line~ and ~org-fontify-done-headline~.
+[[#h:075eb022-37a6-41a4-a040-cc189f6bfa1f][Option for scaled headings]].
+
+[[#h:97caca76-fa13-456c-aef1-a2aa165ea274][Option for variable-pitch font in
headings]].
** Option for scaled headings
:properties:
@@ -1366,7 +1574,7 @@ resource for finding a consistent scale:
modus-themes-scale-2 1.1
modus-themes-scale-3 1.15
modus-themes-scale-4 1.2
- modus-themes-scale-5 1.3)
+ modus-themes-scale-title 1.3)
#+end_src
As for the application of that scale, the variables that range from
@@ -1376,19 +1584,20 @@ smallest, while the latter is the largest. "Regular
headings" are those
that have a standard syntax for their scale, such as Org mode's eight
levels of asterisks or Markdown's six columns.
-Whereas ~modus-themes-scale-5~ is applied to special headings that do not
-conform with the aforementioned syntax, yet which are expected to be
-larger than the largest value on that implied scale. Put concretely,
-Org's =#+title= meta datum is not part of the eight levels of headings in
-an Org file, yet is supposed to signify the primary header. Similarly,
-the Org Agenda's structure headings are not part of a recognisable scale
-and so they also get ~modus-themes-scale-5~.
+Whereas ~modus-themes-scale-title~ is applied to special headings that do
+not conform with the aforementioned syntax, yet which are expected to be
+larger than the largest value on that implied scale or at least have
+some unique purpose in the buffer. Put concretely, Org's =#+title= meta
+datum is not part of the eight levels of headings in an Org file, yet is
+supposed to signify the primary header. Similarly, the Org Agenda's
+structure headings are not part of a recognisable scale and so they also
+get ~modus-themes-scale-title~
([[#h:68f481bc-5904-4725-a3e6-d7ecfa7c3dbc][Option for Org agenda constructs]]).
Users who wish to maintain scaled headings for the normal syntax while
preventing special headings from standing out, can assign a value of =1.0=
-to ~modus-themes-scale-5~ to make it the same as body text (or whatever
-value would render it indistinguishable from the desired point of
-reference).
+to ~modus-themes-scale-title~ to make it the same as body text (or
+whatever value would render it indistinguishable from the desired point
+of reference).
Note that in earlier versions of Org, scaling would only increase the
size of the heading, but not of keywords that were added to it, like
@@ -1727,7 +1936,7 @@ activates ~hl-line-mode~, but we wish to keep it distinct
from other
buffers. This is where ~face-remap-add-relative~ can be applied and may
be combined with ~modus-themes-with-colors~ to deliver consistent results.
-[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the
themes' palette (DIY)]].
+[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the
themes' palette]].
In this example we will write a simple interactive function that adjusts
the background color of the ~region~ face. This is the sample code:
@@ -2216,6 +2425,11 @@ reading the doc string of ~set-face-attribute~):
(set-face-attribute 'fixed-pitch nil :family "DejaVu Sans Mono" :height 1.0)
#+end_src
+The next section shows how to make those work in a more elaborate setup
+that is robust to changes between the Modus themes.
+
+[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]].
+
Note the differences in the ~:height~ property. The ~default~ face must
specify an absolute value, which is the point size × 10. So if you want
to use a font at point size =11=, you set the height to =110=.[fn:: ~:height~
@@ -2230,6 +2444,98 @@ base font size (i.e. the ~default~ face's absolute
height).
[[#h:e6c5451f-6763-4be7-8fdb-b4706a422a4c][Note for EWW and Elfeed fonts (SHR
fonts)]].
+** Configure bold and italic faces (DIY)
+:properties:
+:custom_id: h:2793a224-2109-4f61-a106-721c57c01375
+:end:
+#+cindex: Bold and italic fonts
+
+The Modus themes do not hardcode a ~:weight~ or ~:slant~ attribute in the
+thousands of faces they cover. Instead, they configure the generic
+faces called ~bold~ and ~italic~ to use the appropriate styles and then
+instruct all relevant faces that require emphasis to inherit from them.
+
+This practically means that users can change the particularities of what
+it means for a construct to be bold/italic, by tweaking the ~bold~ and
+~italic~ faces. Cases where that can be useful include:
+
++ The default typeface does not have a variant with slanted glyphs
+ (e.g. Fira Mono/Code as of this writing on 2021-07-07), so the user
+ wants to add another family for the italics, such as Hack.
+
++ The typeface of choice provides a multitude of weights and the user
+ prefers the light one by default. To prevent the bold weight from
+ being too heavy compared to the light one, they opt to make ~bold~ use a
+ semibold weight.
+
++ The typeface distinguishes between oblique and italic forms by
+ providing different font variants (the former are just slanted
+ versions of the upright forms, while the latter have distinguishing
+ features as well). In this case, the user wants to specify the font
+ that applies to the ~italic~ face.
+
+To achieve those effects, one must first be sure that the fonts they use
+have support for those features. It then is a matter of following the
+instructions for all face tweaks.
+
+[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and
others]].
+
+In this example, we set the default font family to Fira Code, while we
+choose to render italics in the Hack typeface (obviously you need to
+pick fonts that work well together):
+
+#+begin_src emacs-lisp
+(set-face-attribute 'default nil :family "Fira Code" :height 110)
+(set-face-attribute 'italic nil :family "Hack")
+#+end_src
+
+And here we play with different weights, using Source Code Pro:
+
+#+begin_src emacs-lisp
+(set-face-attribute 'default nil :family "Source Code Pro" :height 110 :weight
'light)
+(set-face-attribute 'bold nil :weight 'semibold)
+#+end_src
+
+To reset the font family, one can use this:
+
+#+begin_src emacs-lisp
+(set-face-attribute 'italic nil :family 'unspecified)
+#+end_src
+
+To ensure that the effects persist after switching between the Modus
+themes (such as with {{{kbd(M-x modus-themes-toggle)}}}), the user needs to
+write their configurations to a function and hook it up to the
+~modus-themes-after-load-theme-hook~. This is necessary because the
+themes set the default styles of faces (otherwise changing themes would
+not be possible).
+
+[[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme
loading]].
+
+This is a minimal setup to preserve font configurations across theme
+load phases. For a more permanent setup, it is better to employ the
+~custom-set-faces~ function: ~set-face-attribute~ works just fine, though it
+is more convenient for quick previews or for smaller scale operations
+(~custom-set-faces~ follows the format used in the source code of the
+themes).
+
+#+begin_src emacs-lisp
+;; our generic function
+(defun my-modes-themes-bold-italic-faces ()
+ (set-face-attribute 'default nil :family "Source Code Pro" :height 110)
+ (set-face-attribute 'bold nil :weight 'semibold))
+
+;; or use this if you configure a lot of face and attributes and
+;; especially if you plan to use `modus-themes-with-colors', as shown
+;; elsewhere in the manual
+(defun my-modes-themes-bold-italic-faces ()
+ (custom-set-faces
+ '(default ((t :family "Source Code Pro" :height 110)))
+ '(bold ((t :weight semibold)))))
+
+;; and here is the hook
+(add-hook 'modus-themes-after-load-theme-hook
#'my-modes-themes-bold-italic-faces)
+#+end_src
+
** Custom Org user faces (DIY)
:properties:
:custom_id: h:89f0678d-c5c3-4a57-a526-668b2bb2d7ad
@@ -2263,7 +2569,8 @@ have something like this:
You could then use a variant of the following to inherit from a face
that uses the styles you want and also to preserve the properties
-applied by the ~org-todo~ face:
+applied by the ~org-todo~ face (in case there is a difference between the
+two):
#+begin_src emacs-lisp
(setq org-todo-keyword-faces
@@ -2286,9 +2593,14 @@ If you want back the defaults, try specifying just the
~org-todo~ face:
#+end_src
When you inherit from multiple faces, you need to quote the list as
-shown further above. The order is important: the last item is applied
-over the previous ones. If you do not want to blend multiple faces, you
-do not need a quoted list. A pattern of =keyword . face= will suffice.
+shown further above. The order is significant: the first entry is
+applied on top of the second, overriding any properties that are
+explicitly set for both of them: any property that is not specified is
+not overridden, so, for example, if ~org-todo~ has a background and a
+foreground, while ~font-lock-type-face~ only has a foreground, the merged
+face will include the background of the former and the foreground of the
+latter. If you do not want to blend multiple faces, you do not need a
+quoted list. A pattern of =keyword . face= will suffice.
Both approaches can be used simultaneously, as illustrated in this
configuration of the priority cookies:
@@ -2470,7 +2782,7 @@ the case for the time being. We must thus employ the
face remapping
technique that is documented elsewhere in this document to change the
buffer-local value of the ~default~ face.
-[[#h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f][Remap face with local value (DIY)]].
+[[#h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f][Remap face with local value]].
To remap the buffer's backdrop, we start with a function like this one:
@@ -2628,6 +2940,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ counsel-org-capture-string
+ cov
+ cperl-mode
++ css-mode
+ csv-mode
+ ctrlf
+ custom (what you get with {{{kbd(M-x customize)}}})
@@ -2708,6 +3021,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ git-timemachine
+ git-walktree
+ gnus
++ gotest
+ golden-ratio-scroll-screen
+ helm*
+ helm-ls-git
@@ -2751,6 +3065,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ jupyter
+ kaocha-runner
+ keycast
++ ledger-mode
+ line numbers (~display-line-numbers-mode~ and global variant)
+ lsp-mode
+ lsp-ui
@@ -2814,6 +3129,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ prism ([[#h:a94272e0-99da-4149-9e80-11a7e67a2cf2][Note for prism.el]])
+ proced
+ prodigy
++ pulse
+ quick-peek
+ racket-mode
+ rainbow-blocks
@@ -2929,6 +3245,93 @@ supported by the themes.
This section covers information that may be of interest to users of
individual packages.
+** Note on avy hints
+:properties:
+:custom_id: h:2fdce705-6de7-44e6-ab7f-18f59af99e01
+:end:
+
+Hints can appear everywhere, in wildly varying contexts, hence, their
+appearance, by necessity, is a compromise. However, there are various
+options for making them stand out. First is dimming the surroundings:
+
+#+begin_src emacs-lisp
+(setq avy-background t)
+#+end_src
+
+Dimming works well when you find it difficult to spot hints, any hint.
+Second is limiting the number of faces used by hints:
+
+#+begin_src emacs-lisp
+(setq avy-lead-faces
+ '(avy-lead-face
+ avy-lead-face-1
+ avy-lead-face-1
+ avy-lead-face-1
+ avy-lead-face-1))
+#+end_src
+
+Limiting the number of faces works well with longer hints when you find
+it difficult to identify individual hints, especially with hints
+touching each other. The first character of the hint will have an
+intense color, the remaining ones the same neutral color.
+
+Third is preferring commands that produce fewer candidates. Fewer hints
+is less noise: ~avy-goto-char-timer~ is an excellent alternative to
+~avy-goto-char~.
+
+** Note on calendar.el weekday and weekend colors
+:properties:
+:custom_id: h:b2db46fb-32f4-44fd-8e11-d2b261cf51ae
+:end:
+
+By default, the {{{kbd(M-x calendar)}}} interface differentiates weekdays from
+weekends by applying a gray color to the former and a faint red to the
+latter. The idea for this approach is that the weekend should serve as
+a subtle warning that no work is supposed to be done on that day, per
+the design of traditional calendars.
+
+Users who prefer all days to look the same can configure the variable
+~calendar-weekend-days~ to either use gray of weekdays or the faint red of
+weekends uniformly.
+
+#+begin_src emacs-lisp
+;; All are treated like weekdays (gray color)
+(setq calendar-weekend-days nil)
+
+;; All are treated like weekends (red-faint color)
+(setq calendar-weekend-days (number-sequence 0 6))
+
+;; The default marks the Saturday and Sunday as the weekend
+(setq calendar-weekend-days '(0 6))
+#+end_src
+
+For changes to take effect, the Calendar buffer needs to be generated
+anew.
+
+** Note on underlines in compilation buffers
+:properties:
+:custom_id: h:420f5a33-c7a9-4112-9b04-eaf2cbad96bd
+:end:
+
+Various buffers that produce compilation results or run tests on code
+apply an underline to the file names they reference or to relevant
+messages. Users may consider this unnecessary or excessive.
+
+To outright disable the effect, use this:
+
+#+begin_src emacs-lisp
+(setq compilation-message-face nil)
+#+end_src
+
+If some element of differentiation is still desired, a good option is to
+render the affected text using the ~italic~ face:
+
+#+begin_src emacs-lisp
+(setq compilation-message-face 'italic)
+#+end_src
+
+[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]].
+
** Note on inline Latex in Org buffers
:properties:
:custom_id: h:dd8478da-f56a-45cd-b199-b836c85c3c5a
@@ -3566,9 +3969,9 @@ In general, an additional source of light other than that
of the monitor
can help reduce eye strain: the eyes are more relaxed when they do not
have to focus on one point to gather light.
-The monitor's display settings must be accounted for. Gamma ray values,
-in particular, need to be calibrated to neither amplify nor distort the
-perception of black. Same principle for sharpness, brightness, and
+The monitor's display settings must be accounted for. Gamma values, in
+particular, need to be calibrated to neither amplify nor distort the
+perception of black. Same principle for sharpness, brightness, and
contrast as determined by the hardware, which all have an effect on how
text is read on the screen.
@@ -3716,8 +4119,9 @@ The Modus themes are a collective effort. Every bit of
work matters.
+ Contributions to code or documentation :: Anders Johansson, Basil
L.{{{space()}}} Contovounesios, Carlo Zancanaro, Eli Zaretskii, Fritz Grabo,
Kostadin Ninev, Madhavan Krishnan, Markus Beppler, Matthew Stevenson,
- Mauro Aranda, Nicolas De Jaeghere, Rudolf Adamkovič, Shreyas Ragavan,
- Stefan Kangas, Vincent Murphy, Xinglu Chen.
+ Mauro Aranda, Nicolas De Jaeghere, Philip Kaludercic, Rudolf
+ Adamkovič, Shreyas Ragavan, Stefan Kangas, Vincent Murphy, Xinglu
+ Chen.
+ Ideas and user feedback :: Aaron Jensen, Adam Spiers, Adrian Manea,
Alex Griffin, Alex Peitsinis, Alexey Shmalko, Alok Singh, Anders
@@ -3725,19 +4129,20 @@ The Modus themes are a collective effort. Every bit of
work matters.
Contovounesios, Burgess Chang, Christian Tietze, Christopher Dimech,
Damien Cassou, Daniel Mendler, Dario Gjorgjevski, David Edmondson,
Davor Rotim, Divan Santana, Emanuele Michele Alberto Monterosso,
- Farasha Euker, Gerry Agbobada, Gianluca Recchia, Gustavo Barros,
- Hörmetjan Yiltiz, Ilja Kocken, Iris Garcia, Jeremy Friesen, John
- Haman, Joshua O'Connor, Kevin Fleming, Kévin Le Gouguec, Kostadin
- Ninev, Len Trigg, Manuel Uberti, Mark Burton, Markus Beppler, Mauro
- Aranda, Michael Goldenberg, Morgan Smith, Murilo Pereira, Nicky van
- Foreest, Nicolas De Jaeghere, Paul Poloskov, Pete Kazmier, Peter Wu,
- Philip K., Pierre Téchoueyres, Roman Rudakov, Ryan Phillips, Rudolf
- Adamkovič, Sam Kleinman, Shreyas Ragavan, Simon Pugnet, Tassilo Horn,
- Thibaut Verron, Trey Merkley, Togan Muftuoglu, Toon Claes, Uri Sharf,
- Utkarsh Singh, Vincent Foley. As well as users: Ben, CsBigDataHub1,
- Emacs Contrib, Eugene, Fourchaux, Fredrik, Moesasji, Nick, TheBlob42,
- Trey, bepolymathe, doolio, fleimgruber, iSeeU, jixiuf, okamsn,
- pRot0ta1p.
+ Farasha Euker, Gautier Ponsinet, Gerry Agbobada, Gianluca Recchia,
+ Gustavo Barros, Hörmetjan Yiltiz, Ilja Kocken, Iris Garcia, Jeremy
+ Friesen, Jerry Zhang, John Haman, Joshua O'Connor, Kevin Fleming,
+ Kévin Le Gouguec, Kostadin Ninev, Len Trigg, Manuel Uberti, Mark
+ Burton, Markus Beppler, Mauro Aranda, Michael Goldenberg, Morgan
+ Smith, Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere, Paul
+ Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu, Philip Kaludercic,
+ Pierre Téchoueyres, Roman Rudakov, Ryan Phillips, Rudolf Adamkovič,
+ Sam Kleinman, Shreyas Ragavan, Simon Pugnet, Tassilo Horn, Thibaut
+ Verron, Thomas Heartman, Trey Merkley, Togan Muftuoglu, Toon Claes,
+ Uri Sharf, Utkarsh Singh, Vincent Foley. As well as users: Ben,
+ CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, Fredrik, Moesasji,
+ Nick, TheBlob42, Trey, bepolymathe, doolio, fleimgruber, iSeeU,
+ jixiuf, okamsn, pRot0ta1p.
+ Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii, Glenn
Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core Emacs),
@@ -3747,9 +4152,9 @@ The Modus themes are a collective effort. Every bit of
work matters.
+ Inspiration for certain features :: Bozhidar Batsov (zenburn-theme),
Fabrice Niessen (leuven-theme).
-Special thanks, in no particular order, to Manuel Uberti and Omar
-Antolín Camarena for their long time contributions and insightful
-commentary.
+Special thanks, in no particular order, to Manuel Uberti, Gustavo
+Barros, and Omar Antolín Camarena for their long time contributions and
+insightful commentary.
* Meta
:properties:
diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi
index 0d4f976..4ba067f 100644
--- a/doc/misc/pcl-cvs.texi
+++ b/doc/misc/pcl-cvs.texi
@@ -839,7 +839,7 @@ files.
@item f
Find the file that the cursor points to (@code{cvs-mode-find-file}). If
the cursor points to a directory, run @code{dired} on that directory;
-@inforef{Dired, , emacs}.
+@pxref{Dired, Emacs Manual, , emacs}.
@item o
Like @kbd{f}, but use another window
diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi
index e187bbb..ae3a3b1 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -124,10 +124,11 @@ server in a network, and servers relay messages from one
to the next.
Here's a typical example:
@cindex redirection to random servers
-When you connect to the Freenode network
-(@code{http://freenode.net/}), you point your IRC client at the
-server @code{chat.freenode.net}. That server will redirect your client
-to a random server on the network, such as @code{zelazny.freenode.net}.
+When you connect to the Libera.Chat network
+(@code{https://libera.chat}), you point your IRC client at the
+server @code{irc.libera.chat}. That server will redirect your client
+to a random server on the network, such as
+@code{zirconium.libera.chat}.
@cindex channel name
@cindex # starts a channel name
@@ -171,15 +172,23 @@ using a different nick. This will prompt you for four
things:
@table @asis
@cindex server, connecting
-@cindex Freenode network
+@cindex Libera.Chat network
@item IRC Server
What server do you want to connect to? All the servers in a particular
-network are equivalent. Some networks use a round-robin system where a
-single server redirects new connections to a random server in the
-network. @code{chat.freenode.net} is such a server for the Freenode
-network. Freenode provides the network ``for the Free and Open Source
-Software communities, for not-for-profit organizations and for related
-communities and organizations.''
+network are equivalent. Some networks use a round-robin system where
+a single server redirects new connections to a random server in the
+network. @code{irc.libera.chat} is such a server for the Libera.Chat
+network. Libera.Chat's purpose is ``to provide services such as a
+community platform for free open-source software and peer directed
+projects on a volunteer basis,'' and was chosen as the official home
+of the GNU Project and the Free Software Foundation's IRC channels in
+June 2021 in the aftermath of the changes in governance and policies
+of the Freenode IRC network. GNU and FSF's announcements about this
+are at
+@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html},
+@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html},
+and
+@uref{https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html}.
@cindex port, connecting
@cindex 6667, default IRC port
@@ -205,13 +214,13 @@ in use, you might for example get assigned the nick
@code{alex`}.
A space separated list of channels you want to join when connecting.
You don't need to join any channels, if you just want to have one-to-one
conversations with friends on the same network. If you're new to the
-Freenode network, join @code{#emacs}, the channel about all things
+Libera.Chat network, join @code{#emacs}, the channel about all things
Emacs, or join @code{#rcirc}, the channel about @code{rcirc}.
@end table
@cindex server buffer
When you have answered these questions, @code{rcirc} will create a server
-buffer, which will be named something like @file{*chat.freenode.net*},
+buffer, which will be named something like @file{*irc.libera.chat*},
and a channel buffer for each of the channels you wanted to join.
@kindex RET
@@ -482,7 +491,7 @@ Here's an example of how to set it:
@end example
By default you will be connected to the @code{rcirc} support channel:
-@code{#rcirc} on @code{chat.freenode.net}.
+@code{#rcirc} on @code{irc.libera.chat}.
@table @code
@item :nick
@@ -554,8 +563,8 @@ Here is an example to illustrate how you would set it:
@example
(setq rcirc-authinfo
- '(("freenode" nickserv "bob" "p455w0rd")
- ("freenode" chanserv "bob" "#bobland" "passwd99")
+ '(("Libera.Chat" nickserv "bob" "p455w0rd")
+ ("Libera.Chat" chanserv "bob" "#bobland" "passwd99")
("bitlbee" bitlbee "robert" "sekrit")))
@end example
diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi
index dd481d2..f5d5675 100644
--- a/doc/misc/smtpmail.texi
+++ b/doc/misc/smtpmail.texi
@@ -264,12 +264,14 @@ file, @pxref{Top,,auth-source, auth, Emacs auth-source
Library}.
@cindex CRAM-MD5
@cindex PLAIN
@cindex LOGIN
-The process by which the SMTP library authenticates you to the server
-is known as ``Simple Authentication and Security Layer'' (SASL).
-There are various SASL mechanisms, and this library supports three of
-them: CRAM-MD5, PLAIN, and LOGIN, where the first uses a form of
+The process by which the @acronym{SMTP} library authenticates you to
+the server is known as ``Simple Authentication and Security Layer''
+(@acronym{SASL}). There are various @acronym{SASL} mechanisms, and
+this library supports three of them: @code{cram-md5}, @code{plain},
+@code{login} and @code{xoauth2}, where the first uses a form of
encryption to obscure your password, while the other two do not. It
-tries each of them, in that order, until one succeeds. You can
+tries each of them, in that order, until one succeeds.
+(@code{xoauth2} requires using the @file{oauth2.el} library. You can
override this by assigning a specific authentication mechanism to a
server by including a key @code{smtp-auth} with the value of your
preferred mechanism in the appropriate @file{~/.authinfo} entry.
@@ -338,6 +340,16 @@ not sent immediately but rather queued in the directory
@code{smtpmail-send-queued-mail} (typically when you connect to the
internet).
+@item smtpmail-store-queue-variables
+@vindex smtpmail-store-queue-variables
+ Normally the queue will be dispatched with the values of the
+@acronym{SMTP} variables that are in effect when @kbd{M-x
+smtpmail-send-queued-mail} is executed, but if
+@code{smtpmail-store-queue-variables} is non-@code{nil}, the values
+for @code{smtpmail-smtp-server} (etc.@:) will be stored when the mail is
+queued, and then used when actually sending the mail. This can be
+useful if you have a complex outgoing mail setup.
+
@item smtpmail-queue-dir
@vindex smtpmail-queue-dir
The variable @code{smtpmail-queue-dir} specifies the name of the
diff --git a/doc/misc/srecode.texi b/doc/misc/srecode.texi
index a0e999b..1f7473c 100644
--- a/doc/misc/srecode.texi
+++ b/doc/misc/srecode.texi
@@ -259,7 +259,7 @@ contexts to have the same name. Some standard contexts are
@code{file}, @code{declaration}, and @code{classdecl}.
A context can be automatically derived as well based on the parsing
-state from @i{Semantic}. @inforef{Top, Semantic Manual, semantic}.
+state from @i{Semantic}. @xref{Top, Semantic Manual,, semantic}.
@section Applications
Commands that do a particular user task which involves also writing
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 6ef9459..5672648 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -142,7 +142,8 @@ Configuring @value{tramp} for use
* Remote shell setup:: Remote shell setup hints.
* FUSE setup:: @acronym{FUSE} setup hints.
* Android shell setup:: Android shell setup hints.
-* Auto-save and Backup:: Auto-save and Backup.
+* Auto-save File Lock and Backup::
+ Auto-save, File Lock and Backup.
* Keeping files encrypted:: Protect remote files by encryption.
* Windows setup hints:: Issues with Cygwin ssh.
@@ -691,7 +692,8 @@ may be used in your init file:
* Remote shell setup:: Remote shell setup hints.
* FUSE setup:: @acronym{FUSE} setup hints.
* Android shell setup:: Android shell setup hints.
-* Auto-save and Backup:: Auto-save and Backup.
+* Auto-save File Lock and Backup::
+ Auto-save, File Lock and Backup.
* Keeping files encrypted:: Protect remote files by encryption.
* Windows setup hints:: Issues with Cygwin ssh.
@end menu
@@ -2745,9 +2747,10 @@ Open a remote connection with a more concise command
@kbd{C-x C-f
@end itemize
-@node Auto-save and Backup
-@section Auto-save and Backup configuration
+@node Auto-save File Lock and Backup
+@section Auto-save, File Lock and Backup configuration
@cindex auto-save
+@cindex file-lock
@cindex backup
@vindex backup-directory-alist
@@ -2842,11 +2845,28 @@ auto-saved files to the same directory as the original
file.
Alternatively, set the user option @code{tramp-auto-save-directory}
to direct all auto saves to that location.
+@vindex lock-file-name-transforms
+And still more issues to handle. Since @w{Emacs 28}, file locks use a
+similar user option as auto-save files, called
+@code{lock-file-name-transforms}. By default this user option is
+@code{nil}, meaning to keep file locks in the same directory as the
+original file.
+
+If you change @code{lock-file-name-transforms} in order to keep file
+locks for remote files somewhere else, you will loose Emacs' feature
+to warn you, if a file is changed in parallel from different Emacs
+sessions, or via different remote connections. Be careful with such
+settings.
+
+@vindex remote-file-name-inhibit-locks
+Setting @code{remote-file-name-inhibit-locks} to non-@code{nil}
+prevents the creation of remote lock files at all.
+
@vindex tramp-allow-unsafe-temporary-files
Per default, @value{tramp} asks for confirmation if a
-@samp{root}-owned backup or auto-save remote file has to be written to
-your local temporary directory. If you want to suppress this
-confirmation question, set user option
+@samp{root}-owned remote backup, auto-save or lock file has to be
+written to your local temporary directory. If you want to suppress
+this confirmation question, set user option
@code{tramp-allow-unsafe-temporary-files} to @code{t}.
@@ -4235,7 +4255,9 @@ test, @ref{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
-passwords from @file{auth-source.el} (@pxref{Password handling}).
+passwords from @file{auth-source.el} (@pxref{Password handling}). The
+latter does not happen for the @option{sudoedit} method, otherwise it
+would be unusable.
When including @value{tramp}'s messages in the bug report, increase
the verbosity level to 6 (@pxref{Traces and Profiles, Traces}) in the
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index 10c951d..b11ee39 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -8,7 +8,7 @@
@c In the Tramp GIT, the version numbers are auto-frobbed from
@c tramp.el, and the bug report address is auto-frobbed from
@c configure.ac.
-@set trampver 2.5.1
+@set trampver 2.5.2-pre
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 25.1
diff --git a/doc/misc/wisent.texi b/doc/misc/wisent.texi
index dc5b8e4..c0bb7b1 100644
--- a/doc/misc/wisent.texi
+++ b/doc/misc/wisent.texi
@@ -1575,7 +1575,7 @@ To use the Wisent parser with @semantic{} you have to
define
your grammar in @dfn{WY} form, a grammar format very close
to the one used by Bison.
-Please @inforef{top, Semantic Grammar Framework Manual, grammar-fw}
+Please see @ref{top, Semantic Grammar Framework Manual,, grammar-fw},
for more information on @semantic{} grammars.
@menu
@@ -1962,8 +1962,8 @@ See implementation of the function
@code{wisent-skip-token} in
@findex semantic-lex
The lexical analysis step of @semantic{} is performed by the general
-function @code{semantic-lex}. For more information, @inforef{Writing
-Lexers, ,semantic-langdev}.
+function @code{semantic-lex}. For more information, see @ref{Writing
+Lexers, Semantic Language Development,,semantic-langdev}.
@code{semantic-lex} produces lexical tokens of the form:
diff --git a/etc/NEWS b/etc/NEWS
index 1a31308..674152c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -92,6 +92,10 @@ proper pty support that Emacs needs.
* Startup Changes in Emacs 28.1
---
+** File names given on the command line will now be pushed onto
+'file-name-history'.
+
+---
** In GTK builds, Emacs now supports startup notification.
This means that Emacs won't steal keyboard focus upon startup
(when started via the Desktop) if the user is typing into another
@@ -114,6 +118,15 @@ avoid security issues when executing untrusted code. See
the manual
page for 'seccomp' system call, for details about Secure Computing
filters.
+** Setting 'fill-column' to nil is obsolete.
+This undocumented use of 'fill-column' is now obsolete. To disable
+auto filling, turn off 'auto-fill-mode' instead.
+
+For instance, you could add something like the following to your init
+file:
+
+ (add-hook 'foo-mode-hook (lambda () (auto-fill-mode -1))
+
* Changes in Emacs 28.1
@@ -166,6 +179,12 @@ behavior, which mixed these two, can be approximated by
customizing
nor t.
+++
+** New user option 'read-minibuffer-restore-windows'.
+When customized to nil, it uses 'minibuffer-restore-windows' in
+'minibuffer-exit-hook' to remove only the window showing the
+"*Completions*" buffer.
+
++++
** New system for displaying documentation for groups of functions.
This can either be used by saying 'M-x shortdoc-display-group' and
choosing a group, or clicking a button in the "*Help*" buffers when
@@ -309,6 +328,14 @@ about the different options to visit a file, how you can
disable the
prompt, and how you can tweak the file size threshold.
+++
+** New user option 'query-about-changed-file'.
+If non-nil (the default), users are prompted as before when
+re-visiting a file that has changed externally after it was visited
+the first time. If nil, the user is not prompted, but instead the
+buffer is opened with its contents before the change, and the user is
+given instructions how to revert the buffer.
+
++++
** Improved support for terminal emulators that encode the Meta flag.
Some terminal emulators set the 8th bit of Meta characters, and then
encode the resulting character code as if it were non-ASCII character
@@ -323,9 +350,14 @@ emulators by using the new input-meta-mode with the
special value
** New frame parameter 'drag-with-tab-line'.
This parameter, similar to 'drag-with-header-line', allows moving frames
by dragging the tab lines of their topmost windows with the mouse.
+
* Editing Changes in Emacs 28.1
+---
+** Dragging a file to Emacs will now also push the name of the file
+onto 'file-name-history'.
+
+++
** A prefix arg now causes 'delete-other-frames' to only iconify frames.
@@ -453,6 +485,7 @@ Typing 'TAB' on a heading line cycles the current section
between
anywhere in the buffer cycles the whole buffer between "only top-level
headings", "all headings and subheadings", and "show all" states.
++++
*** New user option 'outline-minor-mode-cycle'.
This user option customizes 'outline-minor-mode', with the difference
that 'TAB' and 'S-TAB' on heading lines cycle heading visibility.
@@ -461,12 +494,19 @@ Typing 'TAB' on a heading line cycles the current section
between
heading line cycles the whole buffer between "only top-level
headings", "all headings and subheadings", and "show all" states.
+---
*** New user option 'outline-minor-mode-highlight'.
This user option customizes 'outline-minor-mode'. It puts
highlighting on heading lines using standard outline faces. This
works well only when there are no conflicts with faces used by the
major mode.
++++
+** New commands 'copy-matching-lines' and 'kill-matching-lines'.
+These commands are similar to the command 'flush-lines',
+but add the matching lines to the kill ring as a single string,
+including the newlines that separate the lines.
+
* Changes in Specialized Modes and Packages in Emacs 28.1
@@ -514,6 +554,11 @@ in better code.
---
*** New function 'pcase-compile-patterns' to write other macros.
+*** Added 'cl-type' pattern.
+The new 'cl-type' pattern compares types using 'cl-typep', which allows
+comparing simple types like '(cl-type integer)', as well as forms like
+'(cl-type (integer 0 10))'.
+
+++
** profiler.el
The results displayed by 'profiler-report' now have the usage figures
@@ -557,8 +602,15 @@ This is used to fontify non-scalar variables.
** Python mode
+---
+*** New user option 'python-forward-sexp-function'.
+This allows the user to easier customize whether to use block-based
+navigation or not.
+
+---
*** 'python-shell-interpreter' now defaults to python3 on systems with python3.
+---
*** 'C-c C-r' can now be used on arbitrary regions.
The command previously extended the start of the region to the start
of the line, but will now actually send the marked region, as
@@ -566,12 +618,18 @@ documented.
** Ruby mode
+---
*** 'ruby-use-smie' is declared obsolete.
SMIE is now always enabled and 'ruby-use-smie' only controls whether
indentation is done using SMIE or with the old ad-hoc code.
** Icomplete
+---
+*** New user option 'icomplete-matches-format'.
+This allows controlling the current/total number of matches for the
+prompt prefix.
+
+++
*** New minor mode 'icomplete-vertical-mode', alias 'fido-vertical-mode'.
This mode is intended to be used with Icomplete ('M-x icomplete-mode')
@@ -581,10 +639,13 @@ Icomplete, completions are rotated and selection kept at
the top.
When used with Fido, completions scroll like a typical dropdown
widget.
+---
*** Default value of 'icomplete-compute-delay' has been changed to 0.15 s.
+---
*** Default value of 'icomplete-max-delay-chars' has been changed to 2.
+---
*** Reduced blinking while completing the next completions set.
Icomplete doesn't hide the hint with the previously computed
completions anymore when compute delay is in effect, or the previous
@@ -606,6 +667,7 @@ disabled entirely.
** Windmove
++++
*** New user options to customize windmove keybindings.
These options include 'windmove-default-keybindings',
'windmove-display-default-keybindings',
@@ -644,6 +706,7 @@ of the next command to be displayed in a new window.
** Frames
++++
*** The key prefix 'C-x 5 5' displays next command buffer in a new frame.
It's bound to the command 'other-frame-prefix' that requests the buffer
of the next command to be displayed in a new frame.
@@ -730,6 +793,22 @@ faces in other ways.
*** The new command 'recenter-current-error', bound to 'l' in Occur or
compilation buffers, recenters the current displayed occurrence/error.
+*** Matches in target buffers are now highlighted as in 'compilation-mode'.
+The method of highlighting is specified by the user options
+'next-error-highlight' and 'next-error-highlight-no-select'.
+
+---
+*** A fringe arrow in the '*Occur*' buffer indicates the selected match.
+
+---
+*** Occur mode may use a different type for 'occur-target' property values.
+The value was previously always a marker set to the start of the first
+match on the line but can now also be a list of '(BEGIN . END)' pairs
+of markers delimiting each match on the line.
+This is a fully compatible change to the internal occur-mode
+implementation, and code creating their own occur-mode buffers will
+work as before.
+
** EIEIO
+++
@@ -737,6 +816,11 @@ compilation buffers, recenters the current displayed
occurrence/error.
It is now defined as a generalized variable that can be used with
'setf' to modify the value stored in a given class slot.
+---
+*** 'form' in '(eql form)' specializers in 'cl-defmethod' is now evaluated.
+This corresponds to the behaviour of defmethod in Common Lisp Object System.
+For compatibility, '(eql SYMBOL)' does not evaluate SYMBOL, for now.
+
** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'.
The mode provides refined highlighting of built-in functions, types,
and variables.
@@ -777,6 +861,11 @@ time zones will use a form like "+0100" instead of "CET".
** Dired
++++
+*** New user option 'dired-kill-when-opening-new-dired-buffer'.
+If non-nil, Dired will kill the current buffer when selecting a new
+directory to display.
+
---
*** Behavior change on 'dired-clean-confirm-killing-deleted-buffers'.
Previously, if 'dired-clean-up-buffers-too' was non-nil, and
@@ -854,6 +943,12 @@ keys, add the following to your init file:
** Change Logs and VC
+*** vc-git now sets the 'GIT_LITERAL_PATHSPECS' environment variable.
+This ensures that Git operations on files containing wildcard
+characters work as they're supposed to. However, this also affects
+scripts running from Git hooks, and these have to "unset
+GIT_LITERAL_PATHSPECS" to work as before.
+
*** More VC commands can be used from non-file buffers.
The relevant commands are those that don't change the VC state.
The non-file buffers which can use VC commands are those that have
@@ -908,6 +1003,9 @@ String or list of strings specifying switches for Git log
under VC.
** Gnus
+++
+*** nnimap now supports the oauth2.el library.
+
++++
*** New Summary buffer sort options for extra headers.
The extra header sort option ('C-c C-s C-x') prompts for a header
and fails if no sort function has been defined. Sorting by
@@ -1096,6 +1194,15 @@ take the actual screenshot, and defaults to "ImageMagick
import".
** Smtpmail
+++
+*** smtpmail now supports using the oauth2.el library.
+
++++
+*** New user option 'smtpmail-store-queue-variables'.
+If non-nil, SMTP variables will be stored together with the queued
+messages, and will then be used when sending with
+'M-x smtpmail-send-queued-mail'.
+
++++
*** Allow direct selection of smtp authentication mechanism.
A server entry retrieved by auth-source can request a desired smtp
authentication mechanism by setting a value for the key 'smtp-auth'.
@@ -1139,6 +1246,11 @@ any directory names on the 'find' command lines end in a
slash.
This change is for better compatibility with old versions of non-GNU
'find', such as the one used on macOS.
+---
+*** New utility function 'grep-file-at-point'.
+This returns the name of the file at point (if any) in 'grep-mode'
+buffers.
+
** Help
+++
@@ -1185,6 +1297,16 @@ can provide a better overview in a long list of
available bindings.
In previous Emacs versions, the "*Help*" buffer was killed instead when
clicking the "X" icon in the tool bar.
+** Info
+
+---
+*** New user option 'Info-warn-on-index-alternatives-wrap'.
+This option affects what happens when using the ',' command after
+looking up an entry with 'i' in info buffers. If non-nil (the
+default), the ',' command will now warn you when proceeding beyond the
+final entry, and tapping ',' once more will then take you to the
+first entry.
+
+++
** New command 'lossage-size'.
It allows users to set the maximum number of keystrokes and commands
@@ -1266,6 +1388,9 @@ To revert to the previous behavior,
** Customize
+---
+*** Customize buffers can now be reverted with 'C-x x g'.
+
*** Most customize commands now hide obsolete user options.
Obsolete user options are no longer shown in the listings produced by
the commands 'customize', 'customize-group', 'customize-apropos' and
@@ -1389,6 +1514,10 @@ If non-nil, 'shell-mode' handles implicit "cd" commands,
changing the
directory if the command is a directory. Useful for shells like "zsh"
that has this feature.
++++
+*** 'comint-delete-output' can now save deleted text in the kill-ring.
+Interactively, 'C-u C-c C-o' triggers this new optional behavior.
+
** Eshell
---
@@ -1422,6 +1551,9 @@ like cell phones, tablets or cameras.
*** New connection method "sshfs", which allows accessing remote files
via a file system mounted with 'sshfs'.
+---
+*** Tramp supports authentication via yubikey now.
+
+++
*** Trashed remote files are moved to the local trash directory.
All remote files, which are trashed, are moved to the local trash
@@ -1450,9 +1582,15 @@ buffer to a file under the "/tmp/" directory. This is
useful, if (in
rare cases) Tramp blocks Emacs, and we need further debug information.
+++
-*** Writing sensitive auto-save or backup files to the local temporary
-directory must be confirmed. In order to suppress this confirmation,
-set user option 'tramp-allow-unsafe-temporary-files' to t.
+*** Tramp supports lock files now.
+In order to deactivate this, set user option
+'remote-file-name-inhibit-locks' to t.
+
++++
+*** Writing sensitive auto-save, backup or lock files to the local
+temporary directory must be confirmed. In order to suppress this
+confirmation, set user option 'tramp-allow-unsafe-temporary-files' to
+t.
** Tempo
@@ -1476,6 +1614,14 @@ This is a slightly deeper copy than the previous
'copy-sequence'.
** Package
+---
+*** '/ s' ('package-menu-filter-by-status') changes parameter handling.
+The command was documented to take a comma-separated list of statuses
+to filter by, but instead it used the parameter as a regexp. The
+command has been changed so that it now works as documented, and
+checks statuses not as a regexp, but instead an exact match from the
+comma-separated list.
+
+++
*** New command 'package-browse-url' and keystroke 'w'.
@@ -1512,6 +1658,10 @@ See the new user options 'package-name-column-width',
** gdb-mi
+*** New user option 'gdb-registers-enable-filter'.
+If non-nil, apply a register filter based on
+'gdb-registers-filter-pattern-list'.
+
+++
*** gdb-mi can now store and restore window configurations.
Use 'gdb-save-window-configuration' to save window configuration to a
@@ -1546,6 +1696,14 @@ Defaults to 'libravatar', with 'unicornify' and
'gravatar' as options.
** Compilation mode
+---
+*** New function 'ansi-color-compilation-filter'.
+This function is meant to be used in 'compilation-filter-hook'.
+
+---
+*** New user option 'ansi-color-for-compilation-mode'.
+This controls what 'ansi-color-compilation-filter' does.
+
*** Regexp matching of messages is now case-sensitive by default.
The variable 'compilation-error-case-fold-search' can be set for
case-insensitive matching of messages when the old behavior is
@@ -1553,6 +1711,14 @@ required, but the recommended solution is to use a
correctly matching
regexp instead.
---
+*** New user option 'compilation-search-all-directories'.
+When doing parallel builds, directories and compilation errors may
+arrive in the "*compilation*" buffer out-of-order. If this variable is
+non-nil (the default), Emacs will now search backwards in the buffer
+for any directory the file with errors may be in. If nil, this won't
+be done (and this restores how this previously worked).
+
+---
*** Messages from ShellCheck are now recognized.
---
@@ -1617,6 +1783,40 @@ t, which preserves the original behavior.
If set non-nil, showing an unseen message will set the Rmail buffer's
modified flag.
+---
+*** New faces for heading elements.
+Those are 'shr-h1', 'shr-h2', 'shr-h3', 'shr-h4', 'shr-h5', 'shr-h6'.
+
+** MH-E mail handler for Emacs
+
+Functions and variables related to handling junk mail have been
+renamed to not associate color with sender quality.
+
++++
+*** New names for mh-junk interactive functions.
+Function 'mh-junk-whitelist' is renamed 'mh-junk-allowlist'.
+Function 'mh-junk-blacklist' is renamed 'mh-junk-blocklist'.
+
++++
+*** New binding for 'mh-junk-allowlist'.
+The key binding for 'mh-junk-allowlist' is changed from 'J w' to 'J a'.
+The old binding is supported but warns that it is obsolete.
+
++++
+*** New names for some hooks.
+'mh-whitelist-msg-hook' is renamed 'mh-allowlist-msg-hook'.
+'mh-blacklist-msg-hook' is renamed 'mh-blocklist-msg-hook'.
+
++++
+*** New names for some variables.
+Variable 'mh-whitelist-preserves-sequences-flag' is renamed
+'mh-allowlist-preserves-sequences-flag'.
+
++++
+*** New names for some faces.
+Face 'mh-folder-blacklisted' is renamed 'mh-folder-blocklisted'.
+Face 'mh-folder-whitelisted' is renamed 'mh-folder-allowlisted'.
+
** Apropos
*** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'.
@@ -1875,6 +2075,13 @@ project's root directory, respectively.
This command lets you interactively remove an entry from the list of projects
in 'project-list-file'.
+*** 'project-find-file' now accepts non-existent file names.
+This is to allow easy creation of files inside some nested
+sub-directory.
+
+*** 'project-find-file' doesn't use the string at point as default input.
+Now it's only suggested as part of the "future history".
+
** xref
---
@@ -1936,6 +2143,27 @@ used instead. Uses of 'json-encode-list' should be
changed to call
one of 'json-encode', 'json-encode-alist', 'json-encode-plist', or
'json-encode-array' instead.
+** json.c
+
++++
+*** New function 'json-available-p'.
+This predicate returns non-nil if Emacs is built with libjansson
+support, and it is available on the current system.
+
++++
+*** Native JSON functions now signal an error if libjansson is unavailable.
+This affects 'json-serialize', 'json-insert', 'json-parse-string',
+and 'json-parse-buffer'. This can happen if Emacs was compiled with
+libjansson, but the DLL cannot be found and/or loaded by Emacs at run
+time. Previously, Emacs would display a message and return nil in
+these cases.
+
+*** The JSON functions 'json-serialize', 'json-insert',
+'json-parse-string', and 'json-parse-buffer' now implement some of the
+semantics of RFC 8259 instead of the earlier RFC 4627. In particular,
+these functions now accept top-level JSON values that are neither
+arrays nor objects.
+
** xml.el
*** XML serialization functions now reject invalid characters.
@@ -2146,8 +2374,68 @@ Shift while typing 'C-a', i.e. 'C-S-a', will now
highlight the text.
If the 'EMACS_TEST_VERBOSE' environment variable is set, failure
summaries will include the failing condition.
+** File Locks
+
++++
+*** New user option 'lock-file-name-transforms'.
+This option allows controlling where lock files are written. It uses
+the same syntax as 'auto-save-file-name-transforms'.
+
++++
+*** New user option 'remote-file-name-inhibit-locks'.
+When non-nil, this option suppresses lock files for remote files.
+
++++
+*** New minor mode 'lock-file-mode'.
+This command, called interactively, toggles the local value of
+'create-lockfiles' in the current buffer.
+
** Miscellaneous
+---
+*** fileloop will now skip missing files instead of signalling an error.
+
++++
+*** ".dir-locals.el" now supports setting 'auto-mode-alist'.
+The new 'auto-mode-alist' specification in ".dir-locals.el" files can
+now be used to override the global 'auto-mode-alist' in the current
+directory tree.
+
+---
+*** New utility function 'make-separator-line'.
+
+---
+*** New face 'separator-line'.
+This is used by 'make-separator-line'.
+
++++
+*** New user option 'ignored-local-variable-values'.
+This is the opposite of 'safe-local-variable-values' -- it's an alist
+of variable-value pairs that are to be ignored when reading a
+local-variables section of a file.
+
+---
+*** 'indent-tabs-mode' is now a global minor mode instead of just a variable.
+
+---
+*** New user option 'save-place-abbreviate-file-names'.
+
+---
+*** 'tabulated-list-mode' can now restore original display order.
+Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode',
+and that mode allows the user to sort on any column. There was
+previously no easy way to get back to the original displayed order
+after sorting, but giving a -1 numerical prefix to the sorting command
+will now restore the original order.
+
+---
+*** 'M-left' and 'M-right' now move between columns in 'tabulated-list-mode'.
+
++++
+*** New utility function 'insert-into-buffer'.
+This is like 'insert-buffer-substring', but works in the opposite
+direction.
+
+++
*** New user option 'kill-transform-function'.
This can be used to transform (and suppress) strings from entering the
@@ -2275,14 +2563,6 @@ doesn't turn on 'display-fill-column-indicator-mode' in
special-mode
buffers. This can be controlled by customizing the variable
'global-display-fill-column-indicator-modes'.
----
-*** New user option 'compilation-search-all-directories'.
-When doing parallel builds, directories and compilation errors may
-arrive in the "*compilation*" buffer out-of-order. If this variable is
-non-nil (the default), Emacs will now search backwards in the buffer
-for any directory the file with errors may be in. If nil, this won't
-be done (and this restores how this previously worked).
-
+++
*** New user option 'next-error-message-highlight'.
In addition to a fringe arrow, 'next-error' error may now optionally
@@ -2337,20 +2617,6 @@ point leaves the text. If nil, the text is not hidden
again. Instead
'M-x reveal-hide-revealed' can be used to hide all the revealed text.
+++
-*** New user options to control the look of line/column numbers in the mode
line.
-'mode-line-position-line-format' is the line number format (when
-'line-number-mode' is on), 'mode-line-position-column-format' is
-the column number format (when 'column-number-mode' is on), and
-'mode-line-position-column-line-format' is the combined format (when
-both modes are on).
-
-+++
-*** New user option 'mode-line-compact'.
-If non-nil, repeating spaces are compressed into a single space. If
-'long', this is only done when the mode line is longer than the
-current window width (in characters).
-
-+++
*** New command 'submit-emacs-patch'.
This works like 'report-emacs-bug', but is more geared towards sending
patches to the Emacs issue tracker.
@@ -2385,16 +2651,15 @@ leak information from the reporting user.
The semantics are as with 'walk-windows'.
---
-*** Killing virtual ido buffers interactively will make them go away.
-Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't
-do anything. This has now been changed, and killing virtual buffers
-with that command will remove the buffer from recentf.
-
----
*** New variable 'ffap-file-name-with-spaces'.
If non-nil, 'find-file-at-point' and friends will try to guess more
expansively to identify a file name with spaces.
++++
+*** New 'thing-at-point' target: 'existing-filename'.
+This is like 'filename', but is a full path, and is nil if the file
+doesn't exist.
+
---
*** Two new commands for centering in 'doc-view-mode'.
The new commands 'doc-view-center-page-horizontally' (bound to 'c h')
@@ -2464,6 +2729,17 @@ height of lines or width of chars.
When non-nil, use a new xwidget webkit session after bookmark jump.
Otherwise, it will use 'xwidget-webkit-last-session'.
+** ido
+
+---
+*** Switching on 'ido-mode' now also overrides 'ffap-file-finder'.
+
+---
+*** Killing virtual ido buffers interactively will make them go away.
+Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't
+do anything. This has now been changed, and killing virtual buffers
+with that command will remove the buffer from recentf.
+
** Flymake mode
+++
@@ -2549,6 +2825,15 @@ also keep the type information of their arguments. Use
the
---
*** New face 'perl-heredoc', used for heredoc elements.
++++
+** A function can now be thrown to the 'exit' label in addition to t or nil.
+The command loop will call it with zero arguments before returning.
+
++++
+** New error symbol 'minibuffer-quit'.
+Signaling it has almost the same effect as 'quit' except that it
+doesn't cause keyboard macro termination.
+
---
*** The command 'cperl-set-style' offers the new value "PBP".
This value customizes Emacs to use the style recommended in Damian
@@ -2598,6 +2883,34 @@ GPG key servers can now be queried for keys with the
'M-x epa-search-keys' command. Keys can then be added to your
personal key ring.
+** So Long
+
+---
+*** New 'so-long-predicate' function 'so-long-statistics-excessive-p'
+efficiently detects the presence of a long line anywhere in the buffer
+using 'buffer-line-statistics' (see above). This is now the default
+predicate (replacing 'so-long-detected-long-line-p').
+
+---
+*** 'so-long-threshold' and 'so-long-max-lines' have been raised to
+10000 bytes and 500 lines respectively, to reduce the likelihood of
+false-positives when 'global-so-long-mode' is enabled. The latter
+value is now only used by the old predicate, as the new predicate
+knows the longest line in the entire buffer.
+
+---
+*** 'so-long-target-modes' now includes 'fundamental-mode' by default,
+meaning that 'global-so-long-mode' will also process files which were
+not recognised. (This only has an effect if 'set-auto-mode' chooses
+'fundamental-mode'; buffers which are simply in 'fundamental-mode' by
+default are unaffected.)
+
+---
+*** New user options 'so-long-mode-preserved-minor-modes' and
+'so-long-mode-preserved-variables' allow specified mode and variable
+states to be maintained if 'so-long-mode' replaces the original major
+mode. By default, these new options support 'view-mode'.
+
* New Modes and Packages in Emacs 28.1
@@ -2688,6 +3001,23 @@ This is to keep the same behavior as Eshell.
* Incompatible Lisp Changes in Emacs 28.1
---
+** 'replace-match' now runs modification hooks slightly later.
+The function is documented to leave point after the replacement text,
+but this was not always the case if a modification hook inserted text
+in front of the replaced text -- 'replace-match' would instead leave
+point where the end of the inserted text would have been before the
+hook ran. 'replace-match' now always leaves point after the
+replacement text.
+
+---
+** 'kill-all-local-variables' has changed how it handles non-symbol hooks.
+The function is documented to eliminate all buffer-local bindings
+except variables with a 'permanent-local' property, or hooks that
+have elements with a 'permanent-local-hook' property. In addition, it
+would also keep lambda expressions in hooks sometimes. The latter has
+now been changed: The function will now also remove these.
+
+---
** Some floating-point numbers are now handled differently by the Lisp reader.
In previous versions of Emacs, numbers with a trailing dot and an exponent
were read as integers and the exponent ignored: 2.e6 was interpreted as the
@@ -2826,7 +3156,7 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'erc-announced-server-name', 'erc-default-coding-system',
'erc-process', 'erc-send-command', 'eshell-report-bug',
'eval-next-after-load', 'exchange-dot-and-mark', 'ffap-bug',
-'ffap-submit-bug', 'ffap-version', 'file-cache-choose-completion',
+'ffap-submit-bug', 'ffap-version', 'file-cache-mouse-choose-completion',
'forward-point', 'generic-char-p', 'global-highlight-changes',
'hi-lock-face-history', 'hi-lock-regexp-history',
'highlight-changes-active-string', 'highlight-changes-initial-state',
@@ -2915,6 +3245,20 @@ The former is now declared obsolete.
* Lisp Changes in Emacs 28.1
+++
+*** New function 'file-name-concat'.
+This appends file name components to a directory name and returns the
+result.
+
++++
+*** New function 'split-string-shell-command'.
+This splits a shell command string into separate components,
+respecting quoting with single ('like this') and double ("like this")
+quotes, as well as backslash quoting (like\ this).
+
+---
+*** ':safe' settings in 'defcustom' are now propagated to the loaddefs files.
+
++++
** New function 'syntax-class-to-char'.
This does almost the opposite of 'string-to-syntax' -- it returns the
syntax descriptor (a character) given a raw syntax descriptor (an
@@ -3133,6 +3477,27 @@ file mode specification into symbolic form.
** The variable 'force-new-style-backquotes' has been removed.
This removes the final remaining trace of old-style backquotes.
+** Mode Lines
+
++++
+*** New user options to control the line/column numbers in the mode line.
+'mode-line-position-line-format' is the line number format (when
+'line-number-mode' is on), 'mode-line-position-column-format' is
+the column number format (when 'column-number-mode' is on), and
+'mode-line-position-column-line-format' is the combined format (when
+both modes are on).
+
++++
+*** New user option 'mode-line-compact'.
+If non-nil, repeating spaces are compressed into a single space. If
+'long', this is only done when the mode line is longer than the
+current window width (in characters).
+
++++
+*** 'global-mode-string' constructs should end with a space.
+This was previously not formalized, which led to combinations of modes
+displaying data "smushed together" on the mode line.
+
** Changes in handling dynamic modules
*** The module header 'emacs-module.h' now contains type aliases
@@ -3314,12 +3679,6 @@ locales. They are also available as aliases
'ebcdic-cp-*' (e.g.,
'cp278' for 'ibm278'). There are also new charsets 'ibm2xx' to
support these coding-systems.
-** The JSON functions 'json-serialize', 'json-insert',
-'json-parse-string', and 'json-parse-buffer' now implement some of the
-semantics of RFC 8259 instead of the earlier RFC 4627. In particular,
-these functions now accept top-level JSON values that are neither
-arrays nor objects.
-
---
** 'while-no-input-ignore-events' accepts more special events.
The special events 'dbus-event' and 'file-notify' are now ignored in
@@ -3338,6 +3697,11 @@ Emacs constructs the nondirectory part of the auto-save
file name by
applying that 'secure-hash' to the buffer file name. This avoids any
risk of excessively long file names.
+---
+** New user option 'etags-xref-prefer-current-file'.
+When non-nil, matches for identifiers in the file visited by the
+current buffer will be shown first in the "*xref*" buffer.
+
* Changes in Emacs 28.1 on Non-Free Operating Systems
diff --git a/etc/NEWS.27 b/etc/NEWS.27
index 4b4c1a3..e47f408 100644
--- a/etc/NEWS.27
+++ b/etc/NEWS.27
@@ -28,6 +28,29 @@ If set to a non-nil value which isn't a function, resize the
mini
frame using the new function 'fit-mini-frame-to-buffer' which won't
skip leading or trailing empty lines of the buffer.
++++
+** Update IRC-related references to point to Libera.Chat.
+In June 2021, the Free Software Foundation and the GNU Project moved
+their official IRC channels from the Freenode network to Libera.Chat
+in the aftermath of the changes in Freenode's governance structure and
+policies in May and June 2021. The decision-making process took into
+account the feedback received from the community against a set of
+criteria devised by a working group drawn from both GNU and the FSF
+to gauge a chat network's acceptability to software freedom activists.
+
+For the original announcement and the follow-up update, including more
+details, see:
+
+https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html
+https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html
+
+Given the relocation of GNU and FSF's official IRC channels, as well
+as #emacs and various other Emacs-themed channels (see the link below)
+to Libera.Chat, IRC-related references in the Emacs repository have
+now been updated to point to Libera.Chat.
+
+https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html
+
* Changes in Specialized Modes and Packages in Emacs 27.2
diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex
index b31b427..c9d9678 100644
--- a/etc/refcards/pl-refcard.tex
+++ b/etc/refcards/pl-refcard.tex
@@ -394,7 +394,7 @@ po polsku.
\key{szukaj wstecz tekstu zgodnego z~wpisywanym wyra/zeniem regularnym}{C-M-r}
%\key{select previous search string}{M-p}
-%\key{select next later search string}{M-n}
+%\key{select next search string}{M-n}
%\key{exit incremental search}{RET}
%\key{undo effect of last character}{DEL}
%\key{abort current search}{C-g}
diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex
index f7b5da4..4cb8f9d 100644
--- a/etc/refcards/refcard.tex
+++ b/etc/refcards/refcard.tex
@@ -322,7 +322,7 @@ the directions. If you are a first-time user, type
\kbd{C-h t} for a
\key{reverse regular expression search}{C-M-r}
\key{select previous search string}{M-p}
-\key{select next later search string}{M-n}
+\key{select next search string}{M-n}
\key{exit incremental search}{RET}
\key{undo effect of last character}{DEL}
\key{abort current search}{C-g}
diff --git a/etc/themes/modus-operandi-theme.el
b/etc/themes/modus-operandi-theme.el
index cd73681..a946d74 100644
--- a/etc/themes/modus-operandi-theme.el
+++ b/etc/themes/modus-operandi-theme.el
@@ -4,7 +4,7 @@
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://gitlab.com/protesilaos/modus-themes
-;; Version: 1.4.0
+;; Version: 1.5.0
;; Package-Requires: ((emacs "26.1"))
;; Keywords: faces, theme, accessibility
diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el
index c70c560..b9fe4a3 100644
--- a/etc/themes/modus-themes.el
+++ b/etc/themes/modus-themes.el
@@ -4,8 +4,8 @@
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://gitlab.com/protesilaos/modus-themes
-;; Version: 1.4.0
-;; Last-Modified: <2021-05-25 12:25:39 +0300>
+;; Version: 1.5.0
+;; Last-Modified: <2021-07-15 13:21:55 +0300>
;; Package-Requires: ((emacs "26.1"))
;; Keywords: faces, theme, accessibility
@@ -33,10 +33,10 @@
;; official Info manual for further documentation (distributed with the
;; themes, or available at: <https://protesilaos.com/modus-themes>).
;;
-;; The themes share the following customization variables, all of which
-;; are disabled by default (nil):
+;; The themes share the following customization variables:
;;
-;; modus-themes-slanted-constructs (boolean)
+;; modus-themes-inhibit-reload (boolean)
+;; modus-themes-italic-constructs (boolean)
;; modus-themes-bold-constructs (boolean)
;; modus-themes-variable-pitch-headings (boolean)
;; modus-themes-variable-pitch-ui (boolean)
@@ -47,8 +47,8 @@
;; modus-themes-headings (alist)
;; modus-themes-fringes (choice)
;; modus-themes-lang-checkers (choice)
+;; modus-themes-org-agenda (alist)
;; modus-themes-org-blocks (choice)
-;; modus-themes-org-habit (choice)
;; modus-themes-prompts (choice)
;; modus-themes-mode-line (choice)
;; modus-themes-diffs (choice)
@@ -63,11 +63,11 @@
;; The default scale for headings is as follows (it can be customized as
;; well---remember, no scaling takes place by default):
;;
-;; modus-themes-scale-1 1.05
-;; modus-themes-scale-2 1.1
-;; modus-themes-scale-3 1.15
-;; modus-themes-scale-4 1.2
-;; modus-themes-scale-5 1.3
+;; modus-themes-scale-1 1.05
+;; modus-themes-scale-2 1.1
+;; modus-themes-scale-3 1.15
+;; modus-themes-scale-4 1.2
+;; modus-themes-scale-title 1.3
;;
;; There also exist two unique customization variables for overriding
;; color palette values. The specifics are documented in the manual.
@@ -122,6 +122,7 @@
;; counsel-org-capture-string
;; cov
;; cperl-mode
+;; css-mode
;; csv-mode
;; ctrlf
;; custom (M-x customize)
@@ -203,6 +204,7 @@
;; git-timemachine
;; git-walktree
;; gnus
+;; gotest
;; golden-ratio-scroll-screen
;; helm
;; helm-ls-git
@@ -245,6 +247,7 @@
;; jupyter
;; kaocha-runner
;; keycast
+;; ledger-mode
;; line numbers (`display-line-numbers-mode' and global variant)
;; lsp-mode
;; lsp-ui
@@ -307,6 +310,7 @@
;; prism (see "Note for prism.el" in the manual)
;; proced
;; prodigy
+;; pulse
;; quick-peek
;; racket-mode
;; rainbow-blocks
@@ -395,20 +399,6 @@
;; - modus-operandi-theme.el (Light theme)
;; - modus-vivendi-theme.el (Dark theme)
-;;; News:
-;;
-;; Users updating from older versions to >= 1.0.0, are advised to read
-;; the announcement on the emacs-devel mailing list:
-;; <https://lists.gnu.org/archive/html/emacs-devel/2021-03/msg00300.html>.
-;;
-;; The web page of the change log is also available:
-;; <https://protesilaos.com/modus-themes-changelog/>.
-;;
-;; An Info manual should be distributed with the Modus themes.
-;; Evaluate this form to access it directly:
-;;
-;; (info "(modus-themes) Top")
-
;;; Code:
@@ -430,6 +420,13 @@ cover the blue-cyan-magenta side of the spectrum."
:prefix "modus-themes-"
:tag "Modus Themes")
+(defgroup modus-themes-faces ()
+ "Faces defined my `modus-operandi' and `modus-vivendi'."
+ :group 'modus-themes
+ :link '(info-link "(modus-themes) Top")
+ :prefix "modus-themes-"
+ :tag "Modus Themes Faces")
+
;;; Variables for each theme variant
;;;; Modus Operandi
@@ -614,6 +611,7 @@ cover the blue-cyan-magenta side of the spectrum."
(bg-paren-expression . "#dff0ff")
(bg-region . "#bcbcbc")
(bg-region-accent . "#afafef")
+ (bg-region-accent-subtle . "#efdfff")
(bg-tab-bar . "#d5d5d5")
(bg-tab-active . "#f6f6f6")
@@ -710,9 +708,9 @@ symbol and the latter as a string.")
(green-faint . "#78bf78")
(green-alt-faint . "#99b56f")
(green-alt-other-faint . "#88bf99")
- (yellow . "#e0cc00")
- (yellow-alt . "#c4d030")
- (yellow-alt-other . "#e3c55f")
+ (yellow . "#d0bc00")
+ (yellow-alt . "#c0c530")
+ (yellow-alt-other . "#d3b55f")
(yellow-faint . "#d2b580")
(yellow-alt-faint . "#cabf77")
(yellow-alt-other-faint . "#d0ba95")
@@ -847,7 +845,7 @@ symbol and the latter as a string.")
;;
;; all pairs are combinable with themselves
(bg-hl-line . "#151823")
- (bg-hl-line-intense . "#2f2f2f")
+ (bg-hl-line-intense . "#292929")
(bg-hl-line-intense-accent . "#00353f")
(bg-hl-alt . "#181732")
(bg-hl-alt-intense . "#282e46")
@@ -856,6 +854,7 @@ symbol and the latter as a string.")
(bg-paren-expression . "#221044")
(bg-region . "#3c3c3c")
(bg-region-accent . "#4f3d88")
+ (bg-region-accent-subtle . "#240f55")
(bg-tab-bar . "#2c2c2c")
(bg-tab-active . "#0e0e0e")
@@ -928,212 +927,244 @@ symbol and the latter as a string.")
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-subtle-green nil
"Subtle green background combined with a dimmed foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-subtle-yellow nil
"Subtle yellow background combined with a dimmed foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-subtle-blue nil
"Subtle blue background combined with a dimmed foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-subtle-magenta nil
"Subtle magenta background combined with a dimmed foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-subtle-cyan nil
"Subtle cyan background combined with a dimmed foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-subtle-neutral nil
"Subtle gray background combined with a dimmed foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-intense-red nil
"Intense red background combined with the main foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-intense-green nil
"Intense green background combined with the main foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-intense-yellow nil
"Intense yellow background combined with the main foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-intense-blue nil
"Intense blue background combined with the main foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-intense-magenta nil
"Intense magenta background combined with the main foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-intense-cyan nil
"Intense cyan background combined with the main foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-intense-neutral nil
"Intense gray background combined with the main foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-refine-red nil
"Combination of accented red background and foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-refine-green nil
"Combination of accented green background and foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-refine-yellow nil
"Combination of accented yellow background and foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-refine-blue nil
"Combination of accented blue background and foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-refine-magenta nil
"Combination of accented magenta background and foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-refine-cyan nil
"Combination of accented cyan background and foreground.
This is used for general purpose highlighting, mostly in buffers
or for completion interfaces.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-active-red nil
"A red background meant for use on the mode line or similar.
This is combined with the mode lines primary foreground value.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-active-green nil
"A green background meant for use on the mode line or similar.
This is combined with the mode lines primary foreground value.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-active-yellow nil
"A yellow background meant for use on the mode line or similar.
This is combined with the mode lines primary foreground value.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-active-blue nil
"A blue background meant for use on the mode line or similar.
This is combined with the mode lines primary foreground value.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-active-magenta nil
"A magenta background meant for use on the mode line or similar.
This is combined with the mode lines primary foreground value.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-active-cyan nil
"A cyan background meant for use on the mode line or similar.
This is combined with the mode lines primary foreground value.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-fringe-red nil
"A red background meant for use on the fringe or similar.
This is combined with the main foreground value.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-fringe-green nil
"A green background meant for use on the fringe or similar.
This is combined with the main foreground value.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-fringe-yellow nil
"A yellow background meant for use on the fringe or similar.
This is combined with the main foreground value.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-fringe-blue nil
"A blue background meant for use on the fringe or similar.
This is combined with the main foreground value.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-fringe-magenta nil
"A magenta background meant for use on the fringe or similar.
This is combined with the main foreground value.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-fringe-cyan nil
"A cyan background meant for use on the fringe or similar.
This is combined with the main foreground value.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-nuanced-red nil
"A nuanced red background.
@@ -1142,7 +1173,8 @@ meant to serve as the backdrop for elements such as Org
blocks,
headings, and any other surface that needs to retain the colors
on display.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-nuanced-green nil
"A nuanced green background.
@@ -1151,7 +1183,8 @@ meant to serve as the backdrop for elements such as Org
blocks,
headings, and any other surface that needs to retain the colors
on display.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-nuanced-yellow nil
"A nuanced yellow background.
@@ -1160,7 +1193,8 @@ meant to serve as the backdrop for elements such as Org
blocks,
headings, and any other surface that needs to retain the colors
on display.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-nuanced-blue nil
"A nuanced blue background.
@@ -1169,7 +1203,8 @@ meant to serve as the backdrop for elements such as Org
blocks,
headings, and any other surface that needs to retain the colors
on display.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-nuanced-magenta nil
"A nuanced magenta background.
@@ -1178,7 +1213,8 @@ meant to serve as the backdrop for elements such as Org
blocks,
headings, and any other surface that needs to retain the colors
on display.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-nuanced-cyan nil
"A nuanced cyan background.
@@ -1187,7 +1223,8 @@ meant to serve as the backdrop for elements such as Org
blocks,
headings, and any other surface that needs to retain the colors
on display.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-special-cold nil
"Combines the 'special cold' background and foreground values.
@@ -1195,7 +1232,8 @@ This is intended for cases when a neutral gray background
is not
suitable and where a combination of more saturated colors would
not be appropriate.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-special-mild nil
"Combines the 'special mild' background and foreground values.
@@ -1203,7 +1241,8 @@ This is intended for cases when a neutral gray background
is not
suitable and where a combination of more saturated colors would
not be appropriate.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-special-warm nil
"Combines the 'special warm' background and foreground values.
@@ -1211,7 +1250,8 @@ This is intended for cases when a neutral gray background
is not
suitable and where a combination of more saturated colors would
not be appropriate.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-special-calm nil
"Combines the 'special calm' background and foreground values.
@@ -1219,188 +1259,223 @@ This is intended for cases when a neutral gray
background is not
suitable and where a combination of more saturated colors would
not be appropriate.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-diff-added nil
"Combines green colors for the 'added' state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-diff-changed nil
"Combines yellow colors for the 'changed' state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-diff-removed nil
"Combines red colors for the 'removed' state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-diff-refine-added nil
"Combines green colors for word-wise 'added' state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-diff-refine-changed nil
"Combines yellow colors for word-wise 'changed' state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-diff-refine-removed nil
"Combines red colors for word-wise 'removed' state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-diff-focus-added nil
"Combines green colors for the focused 'added' state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-diff-focus-changed nil
"Combines yellow colors for the focused 'changed' state in.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-diff-focus-removed nil
"Combines red colors for the focused 'removed' state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-diff-heading nil
"Combines blue colors for the diff hunk heading.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-pseudo-header nil
"Generic style for some elements that function like headings.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-mark-alt nil
"Combines yellow colors for marking special lines.
This is intended for use in modes such as Dired, Ibuffer, Proced.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-mark-del nil
"Combines red colors for marking deletable lines.
This is intended for use in modes such as Dired, Ibuffer, Proced.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-mark-sel nil
"Combines green colors for marking lines.
This is intended for use in modes such as Dired, Ibuffer, Proced.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-mark-symbol nil
"Applies a blue color and other styles for mark indicators.
This is intended for use in modes such as Dired, Ibuffer, Proced.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-heading-1 nil
"General purpose face for use in headings level 1.
The exact attributes assigned to this face are contingent on the
values assigned to the `modus-themes-headings' variable.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-heading-2 nil
"General purpose face for use in headings level 2.
The exact attributes assigned to this face are contingent on the
values assigned to the `modus-themes-headings' variable.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-heading-3 nil
"General purpose face for use in headings level 3.
The exact attributes assigned to this face are contingent on the
values assigned to the `modus-themes-headings' variable.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-heading-4 nil
"General purpose face for use in headings level 4.
The exact attributes assigned to this face are contingent on the
values assigned to the `modus-themes-headings' variable.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-heading-5 nil
"General purpose face for use in headings level 5.
The exact attributes assigned to this face are contingent on the
values assigned to the `modus-themes-headings' variable.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-heading-6 nil
"General purpose face for use in headings level 6.
The exact attributes assigned to this face are contingent on the
values assigned to the `modus-themes-headings' variable.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-heading-7 nil
"General purpose face for use in headings level 7.
The exact attributes assigned to this face are contingent on the
values assigned to the `modus-themes-headings' variable.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-heading-8 nil
"General purpose face for use in headings level 8.
The exact attributes assigned to this face are contingent on the
values assigned to the `modus-themes-headings' variable.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-hl-line nil
"General purpose face for the current line.
The exact attributes assigned to this face are contingent on the
values assigned to the `modus-themes-hl-line' variable.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-bold nil
"Generic face for applying a conditional bold weight.
This behaves in accordance with `modus-themes-bold-constructs'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-slant nil
"Generic face for applying a conditional slant (italics).
-This behaves in accordance with `modus-themes-slanted-constructs'.
+This behaves in accordance with `modus-themes-italic-constructs'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-variable-pitch nil
"Generic face for applying a conditional `variable-pitch'.
This behaves in accordance with `modus-themes-no-mixed-fonts',
-`modus-themes-variable-pitch-headings' for all heading levels, and
-`modus-themes-variable-pitch-ui'.
+`modus-themes-variable-pitch-headings' for all heading levels,
+and `modus-themes-variable-pitch-ui'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
-The actual styling of the face is done by `modus-themes-faces'.")
+(defface modus-themes-fixed-pitch nil
+ "Generic face for applying a conditional `fixed-pitch'.
+This behaves in accordance with `modus-themes-no-mixed-fonts'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-graph-red-0 nil
"Special subdued red face for use in graphs.
@@ -1408,7 +1483,8 @@ This is intended to be applied in contexts such as the
Org agenda
habit graph where faithfulness to the semantics of a color value
is of paramount importance.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-graph-red-1 nil
"Special prominent red face for use in graphs.
@@ -1416,7 +1492,8 @@ This is intended to be applied in contexts such as the
Org agenda
habit graph where faithfulness to the semantics of a color value
is of paramount importance.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-graph-green-0 nil
"Special subdued green face for use in graphs.
@@ -1424,7 +1501,8 @@ This is intended to be applied in contexts such as the
Org agenda
habit graph where faithfulness to the semantics of a color value
is of paramount importance.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-graph-green-1 nil
"Special prominent green face for use in graphs.
@@ -1432,7 +1510,8 @@ This is intended to be applied in contexts such as the
Org agenda
habit graph where faithfulness to the semantics of a color value
is of paramount importance.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-graph-yellow-0 nil
"Special subdued yellow face for use in graphs.
@@ -1440,7 +1519,8 @@ This is intended to be applied in contexts such as the
Org agenda
habit graph where faithfulness to the semantics of a color value
is of paramount importance.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-graph-yellow-1 nil
"Special prominent yellow face for use in graphs.
@@ -1448,7 +1528,8 @@ This is intended to be applied in contexts such as the
Org agenda
habit graph where faithfulness to the semantics of a color value
is of paramount importance.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-graph-blue-0 nil
"Special subdued blue face for use in graphs.
@@ -1456,7 +1537,8 @@ This is intended to be applied in contexts such as the
Org agenda
habit graph where faithfulness to the semantics of a color value
is of paramount importance.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-graph-blue-1 nil
"Special prominent blue face for use in graphs.
@@ -1464,7 +1546,8 @@ This is intended to be applied in contexts such as the
Org agenda
habit graph where faithfulness to the semantics of a color value
is of paramount importance.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-graph-magenta-0 nil
"Special subdued magenta face for use in graphs.
@@ -1472,7 +1555,8 @@ This is intended to be applied in contexts such as the
Org agenda
habit graph where faithfulness to the semantics of a color value
is of paramount importance.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-graph-magenta-1 nil
"Special prominent magenta face for use in graphs.
@@ -1480,7 +1564,8 @@ This is intended to be applied in contexts such as the
Org agenda
habit graph where faithfulness to the semantics of a color value
is of paramount importance.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-graph-cyan-0 nil
"Special subdued cyan face for use in graphs.
@@ -1488,7 +1573,8 @@ This is intended to be applied in contexts such as the
Org agenda
habit graph where faithfulness to the semantics of a color value
is of paramount importance.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-graph-cyan-1 nil
"Special prominent cyan face for use in graphs.
@@ -1496,28 +1582,32 @@ This is intended to be applied in contexts such as the
Org agenda
habit graph where faithfulness to the semantics of a color value
is of paramount importance.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-lang-note nil
"Generic face for linter or spell checker notes.
The exact attributes and color combinations are controlled by
`modus-themes-lang-checkers'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-lang-warning nil
"Generic face for linter or spell checker warnings.
The exact attributes and color combinations are controlled by
`modus-themes-lang-checkers'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-lang-error nil
"Generic face for linter or spell checker errors.
The exact attributes and color combinations are controlled by
`modus-themes-lang-checkers'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-reset-soft nil
"Generic face to set most face properties to nil.
@@ -1527,7 +1617,8 @@ properties from their context (e.g. an overlay over an
underlined
text should not be underlined as well) yet still blend in. Also
see `modus-themes-reset-hard'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-reset-hard nil
"Generic face to set all face properties to nil.
@@ -1537,28 +1628,68 @@ properties from their context (e.g. an overlay over an
underlined
text should not be underlined as well) and not blend in. Also
see `modus-themes-reset-soft'.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-key-binding nil
"Generic face for key bindings.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-search-success nil
"Generic face for successful search.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-search-success-modeline nil
"Generic mode line indicator for successful search.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
(defface modus-themes-search-success-lazy nil
"Generic face for successful, lazily highlighted search.
-The actual styling of the face is done by `modus-themes-faces'.")
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-prompt nil
+ "Generic face for command prompts.
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
;;; Customization variables
+(defcustom modus-themes-inhibit-reload t
+ "Control theme reload when setting options with Customize.
+
+By default, customizing a theme-related user option through the
+Custom interfaces or with `customize-set-variable' will not
+reload the currently active Modus theme.
+
+Enable this behaviour by setting this variable to nil."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type 'boolean
+ :link '(info-link "(modus-themes) Custom reload theme"))
+
+(defun modus-themes--set-option (sym val)
+ "Custom setter for theme related user options.
+Will set SYM to VAL, and reload the current theme, unless
+`modus-themes-inhibit-reload' is non-nil."
+ (set-default sym val)
+ (unless (or modus-themes-inhibit-reload
+ ;; Check if a theme is being loaded, in which case we
+ ;; don't want to reload a theme if the setter is
+ ;; invoked. `custom--inhibit-theme-enable' is set to nil
+ ;; by `enable-theme'.
+ (null (bound-and-true-p custom--inhibit-theme-enable)))
+ (let ((modus-themes-inhibit-reload t))
+ (pcase (modus-themes--current-theme)
+ ('modus-operandi (modus-themes-load-operandi))
+ ('modus-vivendi (modus-themes-load-vivendi))))))
+
(defcustom modus-themes-operandi-color-overrides nil
"Override colors in the Modus Operandi palette.
@@ -1567,6 +1698,8 @@ For form, see `modus-themes-operandi-colors'."
:package-version '(modus-themes . "1.1.0")
:version "28.1"
:type '(alist :key-type symbol :value-type color)
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Override colors (DIY)"))
(defcustom modus-themes-vivendi-color-overrides nil
@@ -1577,6 +1710,8 @@ For form, see `modus-themes-vivendi-colors'."
:package-version '(modus-themes . "1.1.0")
:version "28.1"
:type '(alist :key-type symbol :value-type color)
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Override colors (DIY)"))
;; The byte compiler complains when a defcustom isn't a top level form
@@ -1595,14 +1730,33 @@ For form, see `modus-themes-vivendi-colors'."
:package-version '(modus-themes . "1.0.0")
:version "28.1"
:type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Slanted constructs"))
+(define-obsolete-variable-alias
+ 'modus-themes-slanted-constructs
+ 'modus-themes-italic-constructs
+ "1.5.0")
+
+(defcustom modus-themes-italic-constructs nil
+ "Use italic font forms in more code constructs."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Italic constructs"))
+
(defcustom modus-themes-bold-constructs nil
"Use bold text in more code constructs."
:group 'modus-themes
:package-version '(modus-themes . "1.0.0")
:version "28.1"
:type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Bold constructs"))
(defcustom modus-themes-variable-pitch-headings nil
@@ -1611,6 +1765,8 @@ For form, see `modus-themes-vivendi-colors'."
:package-version '(modus-themes . "1.0.0")
:version "28.1"
:type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Headings' typeface"))
(defcustom modus-themes-variable-pitch-ui nil
@@ -1620,6 +1776,8 @@ This includes the mode line, header line, tab bar, and
tab line."
:package-version '(modus-themes . "1.1.0")
:version "28.1"
:type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) UI typeface"))
(defcustom modus-themes-no-mixed-fonts nil
@@ -1637,110 +1795,97 @@ mixing fonts."
:package-version '(modus-themes . "1.0.0")
:version "28.1"
:type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) No mixed fonts"))
(defconst modus-themes--headings-choice
- '(choice
- (const :format "[%v] %t\n" :tag "Fairly desaturated foreground with bold
weight (default)" nil)
- (const :format "[%v] %t\n" :tag "Same as the default
(backward-compatible)" t)
- (const :format "[%v] %t\n" :tag "Like the default without bold weight"
no-bold)
- (const :format "[%v] %t\n" :tag "Like the default plus overline" line)
- (const :format "[%v] %t\n" :tag "Like `line' without bold weight"
line-no-bold)
- (const :format "[%v] %t\n" :tag "Like the default but with more colorful
foreground" rainbow)
- (const :format "[%v] %t\n" :tag "Like `rainbow' plus overline"
rainbow-line)
- (const :format "[%v] %t\n" :tag "Like `rainbow' without bold weight"
rainbow-no-bold)
- (const :format "[%v] %t\n" :tag "Like `rainbow-line' without bold weight"
rainbow-line-no-bold)
- (const :format "[%v] %t\n" :tag "Like the default plus subtle background"
highlight)
- (const :format "[%v] %t\n" :tag "Like `highlight' without bold weight"
highlight-no-bold)
- (const :format "[%v] %t\n" :tag "Like `highlight' with more colorful
foreground" rainbow-highlight)
- (const :format "[%v] %t\n" :tag "Like `rainbow-highlight' without bold
weight" rainbow-highlight-no-bold)
- (const :format "[%v] %t\n" :tag "Like `highlight' plus overline" section)
- (const :format "[%v] %t\n" :tag "Like `section' without bold weight"
section-no-bold)
- (const :format "[%v] %t\n" :tag "Like `section' with more colorful
foreground" rainbow-section)
- (const :format "[%v] %t\n" :tag "Like `rainbow-section' without bold
weight" rainbow-section-no-bold)
- (const :format "[%v] %t\n" :tag "Do not use any distinct foreground color;
just bold weight" no-color)
- (const :format "[%v] %t\n" :tag "Like `no-bold' but without the distinct
foreground color" no-color-no-bold))
+ '(set :tag "Properties" :greedy t
+ (const :tag "Background color" background)
+ (const :tag "Overline" overline)
+ (const :tag "No bold weight" no-bold)
+ (choice :tag "Colors"
+ (const :tag "Subtle colors" nil)
+ (const :tag "Rainbow colors" rainbow)
+ (const :tag "Monochrome" monochrome)))
"Refer to the doc string of `modus-themes-headings'.
This is a helper variable intended for internal use.")
(defcustom modus-themes-headings nil
- "Alist of styles for headings, with optional value per level.
-
-To control faces per level from 1-8, use something like this:
+ "Heading styles with optional list of values for levels 1-8.
- (setq modus-themes-headings
- '((1 . highlight)
- (2 . line)
- (t . rainbow-line-no-bold)))
+This is an alist that accepts a (key . list-of-values)
+combination. The key is either a number, representing the
+heading's level or t, which pertains to the fallback style. The
+list of values covers symbols that refer to properties, as
+described below. Here is a sample, followed by a presentation of
+all available properties:
-To set a uniform value for all heading levels, use this pattern:
+ (setq modus-themes-headings
+ '((1 . (background overline))
+ (2 . (overline rainbow))
+ (t . (monochrome))))
- (setq modus-themes-headings
- '((t . rainbow-line-no-bold)))
+By default (a nil value for this variable), all headings have a
+bold typographic weight and use a desaturated text color.
-The default value uses a fairly desaturated foreground color in
-combination with a bold typographic weight. To specify this
-style for a given level N (assuming you wish to have another
-fallback option), just specify the value nil like this:
+A `rainbow' property makes the text color more saturated.
- (setq modus-themes-headings
- '((1 . nil)
- (2 . line)
- (3) ; same as nil
- (t . rainbow-line-no-bold)))
+An `overline' property draws a line above the area of the
+heading.
-A description of all other possible values:
+A `background' property adds a subtle tinted color to the
+background of the heading.
-+ `no-bold' retains the default text color while removing the
- typographic weight.
+A `no-bold' property removes the bold weight from the heading's
+text.
-+ `line' is the same as the default plus an overline over the
- heading.
+A `monochrome' property makes all headings the same base color,
+which is that of the default for the active theme (black/white).
+When `background' is also set, `monochrome' changes its color to
+gray. If both `monochrome' and `rainbow' are set, the former
+takes precedence.
-+ `line-no-bold' is the same as `line' without bold weight.
+Combinations of any of those properties are expressed as a list,
+like in these examples:
-+ `rainbow' uses a more colorful foreground in combination with
- bold weight.
+ (no-bold)
+ (rainbow background)
+ (overline monochrome no-bold)
-+ `rainbow-line' is the same as `rainbow' plus an overline.
+The order in which the properties are set is not significant.
-+ `rainbow-line-no-bold' is the same as `rainbow-line' without
- the bold weight.
+In user configuration files the form may look like this:
-+ `highlight' retains the default style of a fairly desaturated
- foreground combined with a bold weight and add to it a subtle
- accented background.
+ (setq modus-themes-headings
+ '((1 . (background overline rainbow))
+ (2 . (background overline))
+ (t . (overline no-bold))))
-+ `highlight-no-bold' is the same as `highlight' without a bold
- weight.
+When defining the styles per heading level, it is possible to
+pass a non-nil value (t) instead of a list of properties. This
+will retain the original aesthetic for that level. For example:
-+ `rainbow-highlight' is the same as `highlight' but with a more
- colorful foreground.
+ (setq modus-themes-headings
+ '((1 . t) ; keep the default style
+ (2 . (background overline))
+ (t . (rainbow)))) ; style for all other headings
-+ `rainbow-highlight-no-bold' is the same as `rainbow-highlight'
- without a bold weight.
+ (setq modus-themes-headings
+ '((1 . (background overline))
+ (2 . (rainbow no-bold))
+ (t . t))) ; default style for all other levels
-+ `section' retains the default looks and adds to them both an
- overline and a slightly accented background. It is, in effect,
- a combination of the `line' and `highlight' values.
+For Org users, the extent of the heading depends on the variable
+`org-fontify-whole-heading-line'. This affects the `overline'
+and `background' properties. Depending on the version of Org,
+there may be others, such as `org-fontify-done-headline'.
-+ `section-no-bold' is the same as `section' without a bold
- weight.
-
-+ `rainbow-section' is the same as `section' but with a more
- colorful foreground.
-
-+ `rainbow-section-no-bold' is the same as `rainbow-section'
- without a bold weight.
-
-+ `no-color' does not apply any color to the heading, meaning
- that it uses the foreground of the `default' face. It still
- renders the text with a bold typographic weight.
-
-+ `no-color-no-bold' is like `no-color' but without the bold
- weight."
+Also read `modus-themes-scale-headings' to change the height of
+headings and `modus-themes-variable-pitch-headings' to make them
+use a proportionately spaced font."
:group 'modus-themes
- :package-version '(modus-themes . "1.3.0")
+ :package-version '(modus-themes . "1.5.0")
:version "28.1"
:type `(alist
:options ,(mapcar (lambda (el)
@@ -1748,16 +1893,166 @@ A description of all other possible values:
'(1 2 3 4 5 6 7 8 t))
:key-type symbol
:value-type ,modus-themes--headings-choice)
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Heading styles"))
+(defcustom modus-themes-org-agenda nil
+ "Control the style of individual Org agenda constructs.
+
+This is an alist that accepts a (key . value) combination. Here
+is a sample, followed by a description of all possible
+combinations:
+
+ (setq modus-themes-org-agenda
+ '((header-block . (variable-pitch scale-title))
+ (header-date . (grayscale workaholic bold-today))
+ (scheduled . uniform)
+ (habit . traffic-light)))
+
+A `header-block' key applies to elements that concern the
+headings which demarcate blocks in the structure of the agenda.
+By default (a nil value) those are rendered in a bold typographic
+weight, plus a height that is slightly taller than the default
+font size. Acceptable values come in the form of a list that can
+include either or both of those properties:
+
+- `variable-pitch' to use a proportionately spaced typeface;
+- `scale-title' to increase height to `modus-themes-scale-title'
+ OR `no-scale' to set the font to the same height as the rest of
+ the buffer.
+
+In case both `scale-title' and `no-scale' are in the list, the
+latter takes precedence.
+
+Example usage:
+
+ (header-block . nil)
+ (header-block . (scale-title))
+ (header-block . (no-scale))
+ (header-block . (variable-pitch scale-title))
+
+A `header-date' key covers date headings. Dates use only a
+foreground color by default (a nil value), with weekdays and
+weekends having a slight difference in hueness. The current date
+has an added gray background. This key accepts a list of values
+that can include any of the following properties:
+
+- `grayscale' to make weekdays use the main foreground color and
+ weekends a more subtle gray;
+- `workaholic' to make weekdays and weekends look the same in
+ terms of color;
+- `bold-today' to apply a bold typographic weight to the current
+ date;
+- `bold-all' to render all date headings in a bold weight.
+
+For example:
+
+ (header-date . nil)
+ (header-date . (workaholic))
+ (header-date . (grayscale bold-all))
+ (header-date . (grayscale workaholic))
+ (header-date . (grayscale workaholic bold-today))
+
+A `scheduled' key applies to tasks with a scheduled date. By
+default (a nil value), these use varying shades of yellow to
+denote (i) a past or current date and (ii) a future date. Valid
+values are symbols:
+
+- nil (default);
+- `uniform' to make all scheduled dates the same color;
+- `rainbow' to use contrasting colors for past, present, future
+ scheduled dates.
+
+For example:
+
+ (scheduled . nil)
+ (scheduled . uniform)
+ (scheduled . rainbow)
+
+A `habit' key applies to the `org-habit' graph. All possible
+value are passed as a symbol. Those are:
+
+- The default (nil) is meant to conform with the original
+ aesthetic of `org-habit'. It employs all four color codes that
+ correspond to the org-habit states---clear, ready, alert, and
+ overdue---while distinguishing between their present and future
+ variants. This results in a total of eight colors in use: red,
+ yellow, green, blue, in tinted and shaded versions. They cover
+ the full set of information provided by the `org-habit'
+ consistency graph.
+- `simplified' is like the default except that it removes the
+ dichotomy between current and future variants by applying
+ uniform color-coded values. It applies a total of four colors:
+ red, yellow, green, blue. They produce a simplified
+ consistency graph that is more legible (or less \"busy\") than
+ the default. The intent is to shift focus towards the
+ distinction between the four states of a habit task, rather
+ than each state's present/future outlook.
+- `traffic-light' further reduces the available colors to red,
+ yellow, and green. As in `simplified', present and future
+ variants appear uniformly, but differently from it, the 'clear'
+ state is rendered in a green hue, instead of the original blue.
+ This is meant to capture the use-case where a habit task being
+ \"too early\" is less important than it being \"too late\".
+ The difference between ready and clear states is attenuated by
+ painting both of them using shades of green. This option thus
+ highlights the alert and overdue states.
+- `traffic-light-deuteranopia' is like the `traffic-light' except
+ its three colors are red, yellow, and blue to be suitable for
+ users with red-green color deficiency (deuteranopia).
+
+For example:
+
+ (habit . nil)
+ (habit . simplified)
+ (habit . traffic-light)"
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type '(set
+ (cons :tag "Block header"
+ (const header-block)
+ (set :tag "Header presentation" :greedy t
+ (choice :tag "Font style"
+ (const :tag "Use the original typeface (default)"
nil)
+ (const :tag "Use `variable-pitch' font"
variable-pitch))
+ (choice :tag "Scaling"
+ (const :tag "Slight increase in height (default)"
nil)
+ (const :tag "Do not scale" no-scale)
+ (const :tag "Scale to match
`modus-themes-scale-title'" scale-title))))
+ (cons :tag "Date header" :greedy t
+ (const header-date)
+ (set :tag "Header presentation" :greedy t
+ (const :tag "Use grayscale for date headers" grayscale)
+ (const :tag "Do not differentiate weekdays from weekends"
workaholic)
+ (const :tag "Make today bold" bold-today)
+ (const :tag "Make all dates bold" bold-all)))
+ (cons :tag "Scheduled tasks"
+ (const scheduled)
+ (choice (const :tag "Yellow colors to distinguish current and
future tasks (default)" nil)
+ (const :tag "Uniform subtle warm color for all
scheduled tasks" uniform)
+ (const :tag "Rainbow-colored scheduled tasks"
rainbow)))
+ (cons :tag "Habit graph"
+ (const habit)
+ (choice (const :tag "Follow the original design of `org-habit'
(default)" nil)
+ (const :tag "Do not distinguish between present and
future variants" simplified)
+ (const :tag "Use only red, yellow, green"
traffic-light)
+ (const :tag "Use only red, yellow, blue"
traffic-light-deuteranopia))))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Org agenda"))
+
(defcustom modus-themes-scale-headings nil
"Use font scaling for headings.
For regular headings the scale is controlled by the variables
`modus-themes-scale-1' (smallest) and its variants all the way up
-to `modus-themes-scale-4' (larger). While `modus-themes-scale-5'
-is reserved for special headings that must be the largest on the
-scale.
+to `modus-themes-scale-4' (larger).
+
+While `modus-themes-scale-title' is reserved for special headings
+that nominally are the largest on the scale (though that is not a
+requirement).
A special heading is, in this context, one that does not fit into
the syntax for heading levels that apply to the given mode. For
@@ -1768,6 +2063,8 @@ special heading."
:package-version '(modus-themes . "1.2.0")
:version "28.1"
:type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Scaled headings"))
(defcustom modus-themes-scale-1 1.05
@@ -1790,6 +2087,8 @@ accordance with it in cases where it changes, such as
while using
:package-version '(modus-themes . "1.2.0")
:version "28.1"
:type 'number
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Scaled heading sizes"))
(defcustom modus-themes-scale-2 1.1
@@ -1812,6 +2111,8 @@ accordance with it in cases where it changes, such as
while using
:package-version '(modus-themes . "1.2.0")
:version "28.1"
:type 'number
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Scaled heading sizes"))
(defcustom modus-themes-scale-3 1.15
@@ -1834,6 +2135,8 @@ accordance with it in cases where it changes, such as
while using
:package-version '(modus-themes . "1.2.0")
:version "28.1"
:type 'number
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Scaled heading sizes"))
(defcustom modus-themes-scale-4 1.2
@@ -1856,6 +2159,8 @@ accordance with it in cases where it changes, such as
while using
:package-version '(modus-themes . "1.2.0")
:version "28.1"
:type 'number
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Scaled heading sizes"))
(defcustom modus-themes-scale-5 1.3
@@ -1879,6 +2184,35 @@ accordance with it in cases where it changes, such as
while using
:package-version '(modus-themes . "1.2.0")
:version "28.1"
:type 'number
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Scaled heading sizes"))
+
+(define-obsolete-variable-alias 'modus-themes-scale-5
'modus-themes-scale-title "1.5.0")
+
+(defcustom modus-themes-scale-title 1.3
+ "Font size slightly larger than `modus-themes-scale-4'.
+
+This size is only used for 'special' top level headings, such as
+Org's file title heading, denoted by the #+title key word, and
+the Org agenda structure headers (see `modus-themes-org-agenda').
+
+The default value is a floating point that is interpreted as a
+multiple of the base font size. It is recommended to use such a
+value.
+
+However, the variable also accepts an integer, understood as an
+absolute height that is 1/10 of the typeface's point size (e.g. a
+value of 140 is the same as setting the font at 14 point size).
+This will ignore the base font size and, thus, will not scale in
+accordance with it in cases where it changes, such as while using
+`text-scale-adjust'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type 'number
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Scaled heading sizes"))
(defcustom modus-themes-fringes nil
@@ -1895,40 +2229,62 @@ pronounced grayscale value."
(const :format "[%v] %t\n" :tag "No visible fringes (default)" nil)
(const :format "[%v] %t\n" :tag "Subtle grayscale background" subtle)
(const :format "[%v] %t\n" :tag "Intense grayscale background"
intense))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Fringes"))
(defcustom modus-themes-lang-checkers nil
"Control the style of spelling and code checkers/linters.
-Nil (the default) applies a color-coded underline to the affected
-text, while it leaves the original foreground in tact. If the
+The value is a list of properties, each designated by a symbol.
+The default (nil) applies a color-coded underline to the affected
+text, while it leaves the original foreground intact. If the
display spec of Emacs has support for it, the underline's style
is that of a wave, otherwise it is a straight line.
-Options `subtle-foreground' and `intense-foreground' add a
-color-coded underline while also changing the text's foreground
-accordingly. The style of the underline is the same as with the
-default option.
+The property `straight-underline' ensures that the underline
+under the affected text is always drawn as a straight line.
+
+The property `text-also' applies the same color of the underline
+to the affected text.
+
+The property `background' adds a color-coded background.
+
+The property `intense' amplifies the applicable colors if
+`background' and/or `text-only' are set. If `intense' is set on
+its own, then it implies `text-only'.
-Option `straight-underline' is like the default but always
-applies a straight line under the affected text. Same principle
-for `subtle-foreground-straight-underline' and its counterpart
-`intense-foreground-straight-underline'.
+To disable fringe indicators for Flymake or Flycheck, refer to
+variables `flymake-fringe-indicator-position' and
+`flycheck-indication-mode', respectively.
-Option `colored-background' uses a straight underline, a
-background, and a foreground. All are color-coded. This is the
-most intense combination of face properties."
+Combinations of any of those properties can be expressed in a
+list, as in those examples:
+
+ (background)
+ (straight-underline intense)
+ (background text-also straight-underline)
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-lang-checkers '(text-also background))
+
+NOTE: The placement of the straight underline, though not the
+wave style, is controlled by the built-in variables
+`underline-minimum-offset', `x-underline-at-descent-line',
+`x-use-underline-position-properties'."
:group 'modus-themes
- :package-version '(modus-themes . "1.1.0")
+ :package-version '(modus-themes . "1.5.0")
:version "28.1"
- :type '(choice
- (const :format "[%v] %t\n" :tag "Only color-coded wavy underline
(default)" nil)
- (const :format "[%v] %t\n" :tag "Like the default, but with a
straight underline" straight-underline)
- (const :format "[%v] %t\n" :tag "Color-coded wavy underline; subtle
foreground" subtle-foreground)
- (const :format "[%v] %t\n" :tag "Combines `straight-underline' and
`subtle-foreground'" subtle-foreground-straight-underline)
- (const :format "[%v] %t\n" :tag "Color-coded wavy underline; intense
foreground" intense-foreground)
- (const :format "[%v] %t\n" :tag "Combines `straight-underline' and
`intense-foreground'" intense-foreground-straight-underline)
- (const :format "[%v] %t\n" :tag "Color-coded background, foreground,
straight underline" colored-background))
+ :type '(set :tag "Properties" :greedy t
+ (const :tag "Straight underline" straight-underline)
+ (const :tag "Colorise text as well" text-also)
+ (const :tag "Increase color intensity" intense)
+ (const :tag "With background" background))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Language checkers"))
(defcustom modus-themes-org-blocks nil
@@ -1971,10 +2327,14 @@ respectively."
(const :format "[%v] %t\n" :tag "Alias for `gray-background'"
greyscale)
(const :format "[%v] %t\n" :tag "Color-coded background per
programming language" tinted-background)
(const :format "[%v] %t\n" :tag "Alias for `tinted-background'"
rainbow)) ; back compat
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Org mode blocks"))
(defcustom modus-themes-org-habit nil
- "Control the presentation of the `org-habit' graph.
+ "Deprecated in version 1.5.0 favor of `modus-themes-org-agenda'.
+
+Control the presentation of the `org-habit' graph.
The default is meant to conform with the original aesthetic of
`org-habit'. It employs all four color codes that correspond to
@@ -2009,64 +2369,90 @@ highlights the alert and overdue states."
(const :format "[%v] %t\n" :tag "Respect the original design of
org-habit (default)" nil)
(const :format "[%v] %t\n" :tag "Like the default, but do not
distinguish between present and future variants" simplified)
(const :format "[%v] %t\n" :tag "Like `simplified', but only use
red, yellow, green" traffic-light))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Org agenda habits"))
+(make-obsolete 'modus-themes-org-habit 'modus-themes-org-agenda "1.5.0")
+
(defcustom modus-themes-mode-line nil
- "Adjust the overall style of the mode line.
-
-The default (nil) is a two-dimensional rectangle with a border
-around it. The active and the inactive mode lines use different
-shades of grayscale values for the background and foreground.
-
-A `3d' value will apply a three-dimensional effect to the active
-mode line. The inactive mode lines remain two-dimensional and
-are toned down a bit, relative to the nil value.
-
-The `moody' option is meant to optimize the mode line for use
-with the library of the same name. This practically means to
-remove the box effect and rely on underline and overline
-properties instead. It also tones down the inactive mode lines.
-Despite its intended purpose, this option can also be used
-without the `moody' library.
-
-The `borderless' option uses the same colors as the default (nil
-value), but removes the border effect. This is done by making
-the box property use the same color as the background,
-effectively blending the two and creating some padding.
-
-The `borderless-3d' and `borderless-moody' approximate the `3d'
-and `moody' options respectively, while removing the borders.
-However, to ensure that the inactive mode lines remain visible,
-they apply a slightly more prominent background to them than what
-their counterparts do (same inactive background as with the
-default).
-
-Similarly, `accented', `accented-3d', and `accented-moody'
-correspond to the default (nil), `3d', and `moody' styles
-respectively, except that the active mode line uses a colored
-background instead of the standard shade of gray.
-
-Same principle for styles `borderless-accented',
-`borderless-accented-3d', `borderless-accented-moody', which
-apply a colored background to the active mode line, while they
-remove any noticeable border around both the active and inactive
-the mode lines."
+ "Control the overall style of the mode line.
+
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) is a two-dimensional
+rectangle with a border around it. The active and the inactive
+mode lines use different shades of grayscale values for the
+background, foreground, border.
+
+The `3d' property applies a three-dimensional effect to the
+active mode line. The inactive mode lines remain two-dimensional
+and are toned down a bit, relative to the default style.
+
+The `moody' property optimizes the mode line for use with the
+library of the same name (hereinafter referred to as 'Moody').
+In practice, it removes the box effect and replaces it with
+underline and overline properties. It also tones down the
+inactive mode lines. Despite its intended purpose, this option
+can also be used without the Moody library (please consult the
+themes' manual on this point for more details). If both `3d' and
+`moody' properties are set, the latter takes precedence.
+
+The `borderless' property removes the color of the borders. It
+does not actually remove the borders, but only makes their color
+the same as the background, effectively creating some padding.
+
+The `accented' property ensures that the active mode line uses a
+colored background instead of the standard shade of gray.
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
+
+ (accented)
+ (borderless 3d)
+ (moody accented borderless)
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-mode-line '(borderless accented))
+
+Note that Moody does not expose any faces that the themes could
+style directly. Instead it re-purposes existing ones to render
+its tabs and ribbons. As such, there may be cases where the
+contrast ratio falls below the 7:1 target that the themes conform
+with (WCAG AAA). To hedge against this, we configure a fallback
+foreground for the `moody' property, which will come into effect
+when the background of the mode line changes to something less
+accessible, such as Moody ribbons (read the doc string of
+`set-face-attribute', specifically `:distant-foreground'). This
+fallback is activated when Emacs determines that the background
+and foreground of the given construct are too close to each other
+in terms of color distance. In practice, users will need to
+experiment with the variable `face-near-same-color-threshold' to
+trigger the effect. We find that a value of 45000 shall suffice,
+contrary to the default 30000. Though for the combinations that
+involve the `accented' and `moody' properties, as mentioned
+above, that should be raised up to 70000. Do not set it too
+high, because it has the adverse effect of always overriding the
+default colors (which have been carefully designed to be highly
+accessible).
+
+Furthermore, because Moody expects an underline and overline
+instead of a box style, it is advised to set
+`x-underline-at-descent-line' to a non-nil value."
:group 'modus-themes
- :package-version '(modus-themes . "1.4.0")
+ :package-version '(modus-themes . "1.5.0")
:version "28.1"
- :type '(choice
- (const :format "[%v] %t\n" :tag "Two-dimensional box (default)" nil)
- (const :format "[%v] %t\n" :tag "Three-dimensional style for the
active mode line" 3d)
- (const :format "[%v] %t\n" :tag "No box effects, which are optimal
for use with the `moody' library" moody)
- (const :format "[%v] %t\n" :tag "Like the default, but without
discernible border effects" borderless)
- (const :format "[%v] %t\n" :tag "Like `3d', but without noticeable
border" borderless-3d)
- (const :format "[%v] %t\n" :tag "Like `moody', but without
noticeable border" borderless-moody)
- (const :format "[%v] %t\n" :tag "Two-dimensional box with a colored
background" accented)
- (const :format "[%v] %t\n" :tag "Like `3d', but with a colored
background" accented-3d)
- (const :format "[%v] %t\n" :tag "Like `moody', but with a colored
background" accented-moody)
- (const :format "[%v] %t\n" :tag "Like `accented', but without a
noticeable border" borderless-accented)
- (const :format "[%v] %t\n" :tag "Like `accented-3d', but with a
noticeable border" borderless-accented-3d)
- (const :format "[%v] %t\n" :tag "Like `accented-moody', but with a
noticeable border" borderless-accented-moody))
+ :type '(set :tag "Properties" :greedy t
+ (choice :tag "Overall style"
+ (const :tag "Rectangular Border" nil)
+ (const :tag "3d borders" 3d)
+ (const :tag "No box effects (Moody-compatible)" moody))
+ (const :tag "Colored background" accented)
+ (const :tag "Without border color" borderless))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Mode line"))
(defcustom modus-themes-diffs nil
@@ -2108,10 +2494,12 @@ interest of backward compatibility."
:type '(choice
(const :format "[%v] %t\n" :tag "Intensely colored backgrounds
(default)" nil)
(const :format "[%v] %t\n" :tag "Slightly accented backgrounds with
tinted text" desaturated)
- (const :format "[%v] %t\n" :tag "Apply color-coded backgrounds; keep
syntax colors in tact" bg-only)
+ (const :format "[%v] %t\n" :tag "Apply color-coded backgrounds; keep
syntax colors intact" bg-only)
(const :format "[%v] %t\n" :tag "Like the default (nil), though
optimized for red-green color defficiency" deuteranopia)
(const :format "[%v] %t\n" :tag "No backgrounds, except for refined
diffs" fg-only-deuteranopia)
(const :format "[%v] %t\n" :tag "Alias of `fg-only-deuteranopia' for
backward compatibility" fg-only))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Diffs"))
(defcustom modus-themes-completions nil
@@ -2155,36 +2543,57 @@ and `opinionated' possibilities."
(const :format "[%v] %t\n" :tag "Respect the framework's established
aesthetic (default)" nil)
(const :format "[%v] %t\n" :tag "Subtle backgrounds for various
elements" moderate)
(const :format "[%v] %t\n" :tag "Radical alternative to the
framework's looks" opinionated))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Completion UIs"))
(defcustom modus-themes-prompts nil
"Use subtle or intense styles for minibuffer and REPL prompts.
-Nil means to only use an accented foreground color.
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) means to only use a
+subtle accented foreground color.
+
+The property `background' applies a background color to the
+prompt's text. By default, this is a subtle accented value.
+
+The property `intense' makes the foreground color more prominent.
+If the `background' property is also set, it amplifies the value
+of the background as well.
+
+The property `gray' changes the prompt's colors to grayscale.
+This affects the foreground and, if the `background' property is
+also set, the background. Its effect is subtle, unless it is
+combined with the `intense' property.
+
+The property `bold' makes the text use a bold typographic weight.
+Similarly, `italic' adds a slant to the font's forms (italic or
+oblique forms, depending on the typeface).
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
-Options `subtle-accented' and `intense-accented' will change both
-the background and the foreground values to use accented color
-combinations that follow the hue of the default styles'
-foreground (e.g. the default minibuffer prompt is cyan text, so
-these combinations will involved a cyan background and an
-appropriate cyan foreground).
+ (intense)
+ (bold intense)
+ (intense bold gray)
+ (intense background gray bold)
-Options `subtle-gray' and `intense-gray' are like their
-`subtle-accented' and `intense-accented' counterparts, except
-they use grayscale values instead of accented ones."
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-prompts '(background gray))"
:group 'modus-themes
- :package-version '(modus-themes . "1.1.0")
+ :package-version '(modus-themes . "1.5.0")
:version "28.1"
- :type '(choice
- ;; `subtle' is the same as `subtle-accented', while `intense' is
- ;; equal to `intense-accented' for backward compatibility
- (const :format "[%v] %t\n" :tag "No prompt background (default)" nil)
- (const :format "[%v] %t\n" :tag "Subtle accented background for the
prompt" subtle-accented)
- (const :format "[%v] %t\n" :tag "Same as `subtle-accented' for
compatibility with older versions" subtle)
- (const :format "[%v] %t\n" :tag "Intense accented background and
foreground for the prompt" intense-accented)
- (const :format "[%v] %t\n" :tag "Same as `intense-accented' for
compatibility with older versions" intense)
- (const :format "[%v] %t\n" :tag "Like `subtle-accented' but
grayscale" subtle-gray)
- (const :format "[%v] %t\n" :tag "Like `intense-accented' but
grayscale" intense-gray))
+ :type '(set :tag "Properties" :greedy t
+ (const :tag "With Background" background)
+ (const :tag "Intense" intense)
+ (const :tag "Grayscale" gray)
+ (const :tag "Bold font weight" bold)
+ (const :tag "Italic font slant" italic))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Command prompts"))
(defcustom modus-themes-intense-hl-line nil
@@ -2193,6 +2602,8 @@ they use grayscale values instead of accented ones."
:package-version '(modus-themes . "1.0.0")
:version "28.1"
:type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Line highlighting"))
(make-obsolete 'modus-themes-intense-hl-line 'modus-themes-hl-line "1.3.0")
@@ -2200,39 +2611,44 @@ they use grayscale values instead of accented ones."
(defcustom modus-themes-hl-line nil
"Control the current line highlight of HL-line mode.
-The default (nil) is to apply a subtle neutral background to the
-current line.
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) is a subtle gray
+background color.
-Option `intense-background' uses a prominent neutral background.
+The property `accented' changes the background to a colored
+variant.
-Option `accented-background' is like the `intense-background' but
-with a more colorful background.
+An `underline' property draws a line below the highlighted area.
+Its color is similar to the background, so gray by default or an
+accent color when `accented' is also set.
-Option `underline-neutral' combines a subtle neutral background
-with a gray underline.
+An `intense' property amplifies the colors in use, which may be
+both the background and the underline.
-Option `underline-accented' draws an underline while applying a
-subtle colored background.
+Combinations of any of those properties are expressed as a list,
+like in these examples:
-Option `underline-only-neutral' uses just a neutral underline,
-without any added change to the background.
+ (intense)
+ (underline intense)
+ (accented intense underline)
-Option `underline-only-accented' uses just a colored underline,
-without any added change to the background.
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-hl-line '(underline accented))
Set `x-underline-at-descent-line' to a non-nil value for better
results with underlines."
:group 'modus-themes
- :package-version '(modus-themes . "1.4.0")
+ :package-version '(modus-themes . "1.5.0")
:version "28.1"
- :type '(choice
- (const :format "[%v] %t\n" :tag "Subtle neutral background
(default)" nil)
- (const :format "[%v] %t\n" :tag "Prominent neutral background"
intense-background)
- (const :format "[%v] %t\n" :tag "Subtle colored background"
accented-background)
- (const :format "[%v] %t\n" :tag "Underline with a subtle neutral
background" underline-neutral)
- (const :format "[%v] %t\n" :tag "Underline with a subtle colored
background" underline-accented)
- (const :format "[%v] %t\n" :tag "Just a neutral underline, without a
background" underline-only-neutral)
- (const :format "[%v] %t\n" :tag "Just an accented underline, without
a background" underline-only-accented))
+ :type '(set :tag "Properties" :greedy t
+ (const :tag "Colored background" accented)
+ (const :tag "Underline" underline)
+ (const :tag "Intense style" intense))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Line highlighting"))
(defcustom modus-themes-subtle-line-numbers nil
@@ -2241,145 +2657,208 @@ results with underlines."
:package-version '(modus-themes . "1.2.0")
:version "28.1"
:type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Line numbers"))
(defcustom modus-themes-paren-match nil
- "Choose the style of matching parentheses or delimiters.
+ "Control the style of matching parentheses or delimiters.
-Nil means to use a subtle tinted background color (the default).
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) is a subtle background
+color.
-Option `intense' applies a saturated background color.
+The `bold' property adds a bold weight to the characters of the
+matching delimiters.
-Option `subtle-bold' is the same as the default, but also makes
-use of bold typographic weight (inherits the `bold' face).
+The `intense' property applies a more prominent background color
+to the delimiters.
-Option `intense-bold' is the same as `intense', while it also
-uses a bold weight."
+The `underline' property draws a straight line under the affected
+text.
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
+
+ (bold)
+ (underline intense)
+ (bold intense underline)
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-paren-match '(bold intense))"
:group 'modus-themes
- :package-version '(modus-themes . "1.0.0")
+ :package-version '(modus-themes . "1.5.0")
:version "28.1"
- :type '(choice
- (const :format "[%v] %t\n" :tag "Sublte tinted background (default)"
nil)
- (const :format "[%v] %t\n" :tag "Like the default, but also use bold
typographic weight" subtle-bold)
- (const :format "[%v] %t\n" :tag "Intense saturated background"
intense)
- (const :format "[%v] %t\n" :tag "Like `intense' but with bold
weight" intense-bold))
+ :type '(set :tag "Properties" :greedy t
+ (const :tag "Bold weight" bold)
+ (const :tag "Intense background color" intense)
+ (const :tag "Underline" underline))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Matching parentheses"))
(defcustom modus-themes-syntax nil
"Control the overall style of code syntax highlighting.
-Nil (the default) means to use colors on the cyan-blue-magenta
-side of the spectrum. There is little to no use of greens,
-yellows, and reds.
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) is to use a balanced
+combination of colors on the cyan-blue-magenta side of the
+spectrum. There is little to no use of greens, yellows, and
+reds. Comments are gray, strings are blue colored, doc strings
+are a shade of cyan, while color combinations are designed to
+avoid exaggerations.
+
+The property `faint' fades the saturation of all applicable
+colors, where that is possible or appropriate.
-Option `faint' is like the default in terms of the choice of
-palette but applies desaturated color values.
+The property `yellow-comments' applies a yellow color to
+comments.
-Option `yellow-comments' applies a yellow tint to comments. The
-rest of the syntax is the same as the default.
+The property `green-strings' applies a green color to strings and
+a green tint to doc strings.
-Option `green-strings' replaces the blue/cyan/cold color variants
-in strings with greener alternatives. The rest of the syntax
-remains the same.
+The property `alt-syntax' changes the combination of colors
+beyond strings and comments, so that the effective palette is
+broadened to provide greater variety relative to the default.
-Option `yellow-comments-green-strings' combines yellow comments
-with green strings and the rest of the default syntax
-highlighting style.
+Combinations of any of those properties are expressed as a list,
+like in these examples:
-Option `alt-syntax' expands the color palette and applies new
-color combinations. Strings are green. Doc strings are magenta
-tinted. Comments are gray.
+ (faint)
+ (green-strings yellow-comments)
+ (alt-syntax green-strings yellow-comments)
+ (faint alt-syntax green-strings yellow-comments)
-Option `alt-syntax-yellow-comments' combines `alt-syntax' with
-`yellow-comments'.
+The order in which the properties are set is not significant.
-Option `faint-yellow-comments' combines the `faint' style with
-`yellow-comments'."
+In user configuration files the form may look like this:
+
+ (setq modus-themes-syntax '(faint alt-syntax))
+
+Independent of this variable, users may also control the use of a
+bold weight or italic text: `modus-themes-bold-constructs' and
+`modus-themes-italic-constructs'."
:group 'modus-themes
- :package-version '(modus-themes . "1.2.0")
+ :package-version '(modus-themes . "1.5.0")
:version "28.1"
- :type '(choice
- (const :format "[%v] %t\n" :tag "Balanced use of blue, cyan,
magenta, purple variants (default)" nil)
- (const :format "[%v] %t\n" :tag "Like the default, but with
desaturated color values" faint)
- (const :format "[%v] %t\n" :tag "Apply yellow tint to comments, keep
the default style for the rest" yellow-comments)
- (const :format "[%v] %t\n" :tag "Use green for strings, keep the
default style for the rest" green-strings)
- (const :format "[%v] %t\n" :tag "Use green for strings, yellow for
comments, keep the default style for the rest" yellow-comments-green-strings)
- (const :format "[%v] %t\n" :tag "Refashion syntax highlighting with
more colors, gray comments" alt-syntax)
- (const :format "[%v] %t\n" :tag "Like `alt-syntax' but with yellow
comments" alt-syntax-yellow-comments)
- (const :format "[%v] %t\n" :tag "Like `faint' but with yellow
comments" faint-yellow-comments))
+ :type '(set :tag "Properties" :greedy t
+ (const :tag "Faint colors" faint)
+ (const :tag "Yellow comments" yellow-comments)
+ (const :tag "Green strings" green-strings)
+ (const :tag "Alternative set of colors" alt-syntax))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Syntax styles"))
(defcustom modus-themes-links nil
"Set the style of links.
-Nil means to use an underline that is the same color as the
-foreground.
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) is a prominent text
+color, typically blue, with an underline of the same color.
+
+For the style of the underline, a `neutral-underline' property
+turns the color of the line into a subtle gray, while the
+`no-underline' property removes the line altogether. If both of
+those are set, the latter takes precedence.
+
+For text coloration, a `faint' property desaturates the color of
+the text and the underline, unless the underline is affected by
+the aforementioned properties. While a `no-color' property
+removes the color from the text. If both of those are set, the
+latter takes precedence.
+
+A `bold' property applies a heavy typographic weight to the text
+of the link.
+
+An `italic' property adds a slant to the link's text (italic or
+oblique forms, depending on the typeface).
-Option `faint' applies desaturated colors to the link's text and
-underline.
+A `background' property applies a subtle tinted background color.
-Option `neutral-underline' applies a subtle gray underline, while
-retaining the link's foreground.
+In case both `no-underline' and `no-color' are set, then a subtle
+gray background is applied to all links. This can still be
+combined with the `bold' and `italic' properties.
-Option `faint-neutral-underline' combines a desaturated text
-color with a subtle gray underline.
+Combinations of any of those properties are expressed as a list,
+like in these examples:
-Option `no-underline' removes link underlines altogether, while
-retaining their original fairly vivid color.
+ (faint)
+ (no-underline faint)
+ (no-color no-underline bold)
+ (italic bold background no-color no-underline)
-Option `underline-only' applies an underline while making the
-affected text colorless (it uses the same foreground as the
-theme's default).
+The order in which the properties are set is not significant.
-Option `neutral-underline-only' makes the text colorless while
-using a subtle underline below it."
+In user configuration files the form may look like this:
+
+ (setq modus-themes-links '(neutral-underline background))
+
+The placement of the underline, meaning its proximity to the
+text, is controlled by `x-use-underline-position-properties',
+`x-underline-at-descent-line', `underline-minimum-offset'.
+Please refer to their documentation strings."
:group 'modus-themes
- :package-version '(modus-themes . "1.2.0")
+ :package-version '(modus-themes . "1.5.0")
:version "28.1"
- :type '(choice
- (const :format "[%v] %t\n" :tag "Undeline link using the same color
as the text (default)" nil)
- (const :format "[%v] %t\n" :tag "Like the default, but apply less
intense colors to links" faint)
- (const :format "[%v] %t\n" :tag "Change the color of link underlines
to a neutral gray" neutral-underline)
- (const :format "[%v] %t\n" :tag "Desaturated foreground with neutral
gray underline" faint-neutral-underline)
- (const :format "[%v] %t\n" :tag "Remove underline property from
links, keeping their foreground as-is" no-underline)
- (const :format "[%v] %t\n" :tag "Apply underline only; use default
foreground" underline-only)
- (const :format "[%v] %t\n" :tag "Like `underline-only' but with a
subtle underline" neutral-underline-only))
+ :type '(set :tag "Properties" :greedy t
+ (choice :tag "Text coloration"
+ (const :tag "Saturared color (default)" nil)
+ (const :tag "Faint coloration" faint)
+ (const :tag "No color (use main black/white)" no-color))
+ (choice :tag "Underline"
+ (const :tag "Same color as text (default)" nil)
+ (const :tag "Neutral (gray) underline color"
neutral-underline)
+ (const :tag "No underline" no-underline))
+ (const :tag "Bold font weight" bold)
+ (const :tag "Italic font slant" italic)
+ (const :tag "Subtle background color" background))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Link styles"))
(defcustom modus-themes-region nil
- "Change the overall appearance of the active region.
+ "Control the overall style of the active region.
-Nil (the default) means to only use a prominent gray background
-with a neutral foreground. The foreground overrides all syntax
-highlighting. The region extends to the edge of the window.
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) is a prominent gray
+background that overrides all foreground colors in the area it
+encompasses. Its reach extends to the edge of the window.
-Option `no-extend' preserves the default aesthetic but prevents
-the region from extending to the edge of the window.
+The `no-extend' property limits the region to the end of the
+line, so that it does not reach the edge of the window.
-Option `bg-only' applies a faint tinted background that is
-distinct from all others used in the theme, while it does not
-override any existing colors. It extends to the edge of the
-window.
+The `bg-only' property makes the region's background color more
+subtle to allow the underlying text to retain its foreground
+colors.
-Option `bg-only-no-extend' is a combination of the `bg-only' and
-`no-extend' options.
+The `accented' property applies a more colorful background to the
+region.
-Option `accent' uses a more colorful background with a neutral
-foreground. It overrides all syntax highlighting and extends to
-the edge of the window.
+Combinations of any of those properties are expressed as a list,
+like in these examples:
-Option `accent-no-extend' is like the above, but stretches only
-to the end of each line within the region."
+ (no-extend)
+ (bg-only accented)
+ (accented bg-only no-extend)
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-region '(bg-only no-extend))"
:group 'modus-themes
- :package-version '(modus-themes . "1.3.0")
+ :package-version '(modus-themes . "1.5.0")
:version "28.1"
- :type '(choice
- (const :format "[%v] %t\n" :tag "Intense background; overrides
colors; extends to edge of window (default)" nil)
- (const :format "[%v] %t\n" :tag "As with the default, but does not
extend" no-extend)
- (const :format "[%v] %t\n" :tag "Subtle background; preserves
colors; extends to edge of window" bg-only)
- (const :format "[%v] %t\n" :tag "As with the `subtle' option, but
does not extend" bg-only-no-extend)
- (const :format "[%v] %t\n" :tag "Like the default, but with an
accented background" accent)
- (const :format "[%v] %t\n" :tag "As with the `accent' option, but
does not extend" accent-no-extend))
+ :type '(set :tag "Properties" :greedy t
+ (const :tag "Do not extend to the edge of the window" no-extend)
+ (const :tag "Background only (preserve underlying colors)"
bg-only)
+ (const :tag "Accented background" accented))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Active region"))
(defcustom modus-themes-success-deuteranopia nil
@@ -2397,6 +2876,8 @@ configured to conform with deuteranopia:
`modus-themes-diffs'."
:package-version '(modus-themes . "1.4.0")
:version "28.1"
:type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Success' color-code"))
(defcustom modus-themes-mail-citations nil
@@ -2420,6 +2901,8 @@ colored into a uniform shade of shade of gray."
(const :format "[%v] %t\n" :tag "Like the default, but with less
saturated colors" faint)
(const :format "[%v] %t\n" :tag "Deprecated alias of `faint'"
desaturated)
(const :format "[%v] %t\n" :tag "Uniformly gray mail citations"
monochrome))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Mail citations"))
@@ -2474,17 +2957,17 @@ Those are stored in `modus-themes-faces' and
(when modus-themes-bold-constructs
(list :inherit 'bold)))
-(defun modus-themes--mixed-fonts ()
- "Conditional application of `fixed-pitch' inheritance."
- (unless modus-themes-no-mixed-fonts
- (list :inherit 'fixed-pitch)))
-
(defun modus-themes--slant ()
"Conditional use of italics for slant attribute."
- (if modus-themes-slanted-constructs
+ (if modus-themes-italic-constructs
(list 'italic)
(list 'normal)))
+(defun modus-themes--fixed-pitch ()
+ "Conditional application of `fixed-pitch' inheritance."
+ (unless modus-themes-no-mixed-fonts
+ (list :inherit 'fixed-pitch)))
+
(defun modus-themes--variable-pitch ()
"Conditional use of `variable-pitch' in headings."
(when modus-themes-variable-pitch-headings
@@ -2512,43 +2995,113 @@ combines with the theme's primary background
(white/black)."
(list :background (or altbg 'unspecified) :foreground altfg)
(list :background mainbg :foreground mainfg)))
-(defun modus-themes--lang-check (underline subtlefg intensefg bg)
+(defun modus-themes--lang-check (underline subtlefg intensefg intensefg-alt
subtlebg intensebg)
"Conditional use of foreground colors for language checkers.
UNDERLINE is a color-code value for the affected text's underline
property. SUBTLEFG and INTENSEFG follow the same color-coding
pattern and represent a value that is faint or vibrant
-respectively. BG is a color-coded background."
- (pcase modus-themes-lang-checkers
- ('colored-background
- (list :underline underline :background bg :foreground intensefg))
- ('intense-foreground
- (list :underline (list :color underline :style 'wave) :foreground
intensefg))
- ('intense-foreground-straight-underline
- (list :underline underline :foreground intensefg))
- ('subtle-foreground
- (list :underline (list :color underline :style 'wave) :foreground
subtlefg))
- ('subtle-foreground-straight-underline
- (list :underline underline :foreground subtlefg))
- ('straight-underline
- (list :underline underline))
- (_ (list :underline (list :color underline :style 'wave)))))
-
-(defun modus-themes--prompt (mainfg subtlebg subtlefg intensebg intensefg)
- "Conditional use of background colors for prompts.
-MAINFG is the prompt's standard foreground. SUBTLEBG should be a
-subtle accented background that works with SUBTLEFG. INTENSEBG
-must be a more pronounced accented color that should be
-combinable with INTENSEFG."
- (pcase modus-themes-prompts
- ;; `subtle' is the same as `subtle-accented', while `intense' is
- ;; equal to `intense-accented' for backward compatibility
- ('intense-accented (list :background intensebg :foreground intensefg))
- ('intense (list :background intensebg :foreground intensefg))
- ('subtle-accented (list :background subtlebg :foreground subtlefg))
- ('subtle (list :background subtlebg :foreground subtlefg))
- ('subtle-gray (list :inherit 'modus-themes-subtle-neutral))
- ('intense-gray (list :inherit 'modus-themes-intense-neutral))
- (_ (list :background 'unspecified :foreground mainfg))))
+respectively. INTENSEFG-ALT is used when the intensity is high.
+SUBTLEBG and INTENSEBG are color-coded background colors that
+differ in overall intensity."
+ (let ((modus-themes-lang-checkers
+ (if (listp modus-themes-lang-checkers)
+ modus-themes-lang-checkers
+ (pcase modus-themes-lang-checkers
+ ('colored-background '(background intense))
+ ('intense-foreground '(intense))
+ ('intense-foreground-straight-underline '(intense
straight-underline))
+ ('subtle-foreground '(text-also))
+ ('subtle-foreground-straight-underline '(text-also
straight-underline))
+ ('straight-underline '(straight-underline))))))
+ (list :underline
+ (list :color
+ underline
+ :style
+ (if (memq 'straight-underline modus-themes-lang-checkers)
+ 'line 'wave))
+ :background
+ (cond
+ ((and (memq 'background modus-themes-lang-checkers)
+ (memq 'intense modus-themes-lang-checkers))
+ intensebg)
+ ((memq 'background modus-themes-lang-checkers)
+ subtlebg))
+ :foreground
+ (cond
+ ((and (memq 'background modus-themes-lang-checkers)
+ (memq 'intense modus-themes-lang-checkers))
+ intensefg-alt)
+ ((memq 'intense modus-themes-lang-checkers)
+ intensefg)
+ ((memq 'text-also modus-themes-lang-checkers)
+ subtlefg)))))
+
+(defun modus-themes--prompt (mainfg intensefg grayfg subtlebg intensebg
intensebg-fg subtlebggray intensebggray)
+ "Conditional use of colors for prompts.
+MAINFG is the prompt's standard foreground. INTENSEFG is a more
+prominent alternative to the main foreground, while GRAYFG is a
+less luminant shade of gray.
+
+SUBTLEBG is a subtle accented background that works with either
+MAINFG or INTENSEFG.
+
+INTENSEBG is a more pronounced accented background color that
+should be combinable with INTENSEBG-FG.
+
+SUBTLEBGGRAY and INTENSEBGGRAY are background values. The former
+can be combined with GRAYFG, while the latter only works with the
+theme's fallback text color."
+ (let ((modus-themes-prompts
+ (if (listp modus-themes-prompts)
+ modus-themes-prompts
+ ;; translation layer for legacy values
+ (pcase modus-themes-prompts
+ ;; `subtle' is the same as `subtle-accented', while `intense' is
+ ;; equal to `intense-accented' for backward compatibility
+ ('subtle '(background))
+ ('subtle-accented '(background))
+ ('subtle-gray '(background gray))
+ ('intense '(background intense))
+ ('intense-accented '(background intense))
+ ('intense-gray '(background intense gray))))))
+ (list :foreground
+ (cond
+ ((and (memq 'gray modus-themes-prompts)
+ (memq 'intense modus-themes-prompts))
+ 'unspecified)
+ ((memq 'gray modus-themes-prompts)
+ grayfg)
+ ((and (memq 'background modus-themes-prompts)
+ (memq 'intense modus-themes-prompts))
+ intensebg-fg)
+ ((memq 'intense modus-themes-prompts)
+ intensefg)
+ (mainfg))
+ :background
+ (cond
+ ((and (memq 'gray modus-themes-prompts)
+ (memq 'background modus-themes-prompts)
+ (memq 'intense modus-themes-prompts))
+ intensebggray)
+ ((and (memq 'gray modus-themes-prompts)
+ (memq 'background modus-themes-prompts))
+ subtlebggray)
+ ((and (memq 'background modus-themes-prompts)
+ (memq 'intense modus-themes-prompts))
+ intensebg)
+ ((memq 'background modus-themes-prompts)
+ subtlebg)
+ ('unspecified))
+ :inherit
+ (cond
+ ((and (memq 'bold modus-themes-prompts)
+ (memq 'italic modus-themes-prompts))
+ 'bold-italic)
+ ((memq 'italic modus-themes-prompts)
+ 'italic)
+ ((memq 'bold modus-themes-prompts)
+ 'bold)
+ ('unspecified)))))
(defun modus-themes--paren (normalbg intensebg)
"Conditional use of intense colors for matching parentheses.
@@ -2556,127 +3109,278 @@ NORMALBG should be the special palette color
'bg-paren-match' or
something similar. INTENSEBG must be easier to discern next to
other backgrounds, such as the special palette color
'bg-paren-match-intense'."
- (pcase modus-themes-paren-match
- ('subtle-bold (list :inherit 'bold :background normalbg))
- ('intense-bold (list :inherit 'bold :background intensebg))
- ('intense (list :background intensebg))
- (_ (list :background normalbg))))
+ (let ((modus-themes-paren-match
+ (if (listp modus-themes-paren-match)
+ modus-themes-paren-match
+ ;; translation layer for legacy values
+ (pcase modus-themes-paren-match
+ ;; `subtle' is the same as `subtle-accented', while `intense' is
+ ;; equal to `intense-accented' for backward compatibility
+ ('intense-bold '(intense bold))
+ ('subtle-bold '(bold))
+ ('intense '(intense))))))
+ (list :inherit
+ (if (memq 'bold modus-themes-paren-match)
+ 'bold
+ 'unspecified)
+ :background
+ (if (memq 'intense modus-themes-paren-match)
+ intensebg
+ normalbg)
+ :underline
+ (if (memq 'underline modus-themes-paren-match)
+ t
+ nil))))
(defun modus-themes--syntax-foreground (fg faint)
"Apply foreground value to code syntax.
FG is the default. FAINT is typically the same color in its
desaturated version."
- (pcase modus-themes-syntax
- ('faint (list :foreground faint))
- ('faint-yellow-comments (list :foreground faint))
- (_ (list :foreground fg))))
-
-(defun modus-themes--syntax-extra (fg faint alt)
+ (let ((modus-themes-syntax
+ (if (listp modus-themes-syntax)
+ modus-themes-syntax
+ ;; translation layer for legacy values
+ (pcase modus-themes-syntax
+ ('faint '(faint))
+ ('faint-yellow-comments '(faint yellow-comments))
+ ('green-strings '(green-strings))
+ ('yellow-comments '(yellow-comments))
+ ('yellow-comments-green-strings '(green-strings yellow-comments))
+ ('alt-syntax '(alt-syntax))
+ ('alt-syntax-yellow-comments '(alt-syntax yellow-comments))))))
+ (list :foreground
+ (cond
+ ((memq 'faint modus-themes-syntax)
+ faint)
+ (fg)))))
+
+(defun modus-themes--syntax-extra (fg faint alt &optional faint-alt)
"Apply foreground value to code syntax.
FG is the default. FAINT is typically the same color in its
-desaturated version. ALT is another hue."
- (pcase modus-themes-syntax
- ('faint (list :foreground faint))
- ('faint-yellow-comments (list :foreground faint))
- ('alt-syntax (list :foreground alt))
- ('alt-syntax-yellow-comments (list :foreground alt))
- (_ (list :foreground fg))))
-
-(defun modus-themes--syntax-string (fg faint green alt)
- "Apply foreground value to strings in code syntax.
-FG is the default. FAINT is typically the same color in its
-desaturated version. GREEN is a color variant in that side of
-the spectrum. ALT is another hue."
- (pcase modus-themes-syntax
- ('faint (list :foreground faint))
- ('faint-yellow-comments (list :foreground faint))
- ('green-strings (list :foreground green))
- ('yellow-comments-green-strings (list :foreground alt))
- ('alt-syntax (list :foreground alt))
- ('alt-syntax-yellow-comments (list :foreground alt))
- (_ (list :foreground fg))))
-
-(defun modus-themes--syntax-docstring (fg faint green alt)
+desaturated version. ALT is another hue while optional FAINT-ALT
+is its subtle alternative."
+ (let ((modus-themes-syntax
+ (if (listp modus-themes-syntax)
+ modus-themes-syntax
+ ;; translation layer for legacy values
+ (pcase modus-themes-syntax
+ ('faint '(faint))
+ ('faint-yellow-comments '(faint yellow-comments))
+ ('green-strings '(green-strings))
+ ('yellow-comments '(yellow-comments))
+ ('yellow-comments-green-strings '(green-strings yellow-comments))
+ ('alt-syntax '(alt-syntax))
+ ('alt-syntax-yellow-comments '(alt-syntax yellow-comments))))))
+ (list :foreground
+ (cond
+ ((and (memq 'alt-syntax modus-themes-syntax)
+ (memq 'faint modus-themes-syntax))
+ (or faint-alt alt))
+ ((memq 'faint modus-themes-syntax)
+ faint)
+ ((memq 'alt-syntax modus-themes-syntax)
+ alt)
+ (fg)))))
+
+(defun modus-themes--syntax-string (fg faint green alt &optional faint-green
faint-alt)
"Apply foreground value to strings in code syntax.
FG is the default. FAINT is typically the same color in its
desaturated version. GREEN is a color variant in that side of
-the spectrum. ALT is another hue."
- (pcase modus-themes-syntax
- ('faint (list :foreground faint))
- ('faint-yellow-comments (list :foreground faint))
- ('green-strings (list :foreground green))
- ('yellow-comments-green-strings (list :foreground green))
- ('alt-syntax (list :foreground alt))
- ('alt-syntax-yellow-comments (list :foreground alt))
- (_ (list :foreground fg))))
-
-(defun modus-themes--syntax-comment (fg yellow)
+the spectrum. ALT is another hue. Optional FAINT-GREEN is a
+subtle alternative to GREEN. Optional FAINT-ALT is a subtle
+alternative to ALT."
+ (let ((modus-themes-syntax
+ (if (listp modus-themes-syntax)
+ modus-themes-syntax
+ ;; translation layer for legacy values
+ (pcase modus-themes-syntax
+ ('faint '(faint))
+ ('faint-yellow-comments '(faint yellow-comments))
+ ('green-strings '(green-strings))
+ ('yellow-comments '(yellow-comments))
+ ('yellow-comments-green-strings '(green-strings yellow-comments))
+ ('alt-syntax '(alt-syntax))
+ ('alt-syntax-yellow-comments '(alt-syntax yellow-comments))))))
+ (list :foreground
+ (cond
+ ((and (memq 'faint modus-themes-syntax)
+ (memq 'green-strings modus-themes-syntax))
+ (or faint-green green))
+ ((and (memq 'alt-syntax modus-themes-syntax)
+ (memq 'faint modus-themes-syntax))
+ (or faint-alt faint))
+ ((memq 'faint modus-themes-syntax)
+ faint)
+ ((memq 'green-strings modus-themes-syntax)
+ green)
+ ((memq 'alt-syntax modus-themes-syntax)
+ alt)
+ (fg)))))
+
+(defun modus-themes--syntax-comment (fg yellow &optional faint-yellow faint)
"Apply foreground value to strings in code syntax.
-FG is the default. YELLOW is a color variant of that name."
- (pcase modus-themes-syntax
- ('yellow-comments (list :foreground yellow))
- ('yellow-comments-green-strings (list :foreground yellow))
- ('alt-syntax-yellow-comments (list :foreground yellow))
- ('faint-yellow-comments (list :foreground yellow))
- (_ (list :foreground fg))))
-
-(defun modus-themes--heading-p (key)
- "Query style of KEY in `modus-themes-headings'."
- (cdr (assoc key modus-themes-headings)))
-
-(defun modus-themes--heading (level fg fg-alt bg border)
+FG is the default. YELLOW is a color variant of that name while
+optional FAINT-YELLOW is its subtle variant. Optional FAINT is
+an alternative to the default value."
+ (let ((modus-themes-syntax
+ (if (listp modus-themes-syntax)
+ modus-themes-syntax
+ ;; translation layer for legacy values
+ (pcase modus-themes-syntax
+ ('faint '(faint))
+ ('faint-yellow-comments '(faint yellow-comments))
+ ('green-strings '(green-strings))
+ ('yellow-comments '(yellow-comments))
+ ('yellow-comments-green-strings '(green-strings yellow-comments))
+ ('alt-syntax '(alt-syntax))
+ ('alt-syntax-yellow-comments '(alt-syntax yellow-comments))))))
+ (list :foreground
+ (cond
+ ((and (memq 'faint modus-themes-syntax)
+ (memq 'yellow-comments modus-themes-syntax))
+ (or faint-yellow yellow))
+ ((and (memq 'alt-syntax modus-themes-syntax)
+ (memq 'yellow-comments modus-themes-syntax)
+ (not (memq 'green-strings modus-themes-syntax)))
+ (or faint-yellow yellow))
+ ((memq 'yellow-comments modus-themes-syntax)
+ yellow)
+ ((memq 'faint modus-themes-syntax)
+ (or faint fg))
+ (fg)))))
+
+(defun modus-themes--key-cdr (key alist)
+ "Get cdr of KEY in ALIST."
+ (cdr (assoc key alist)))
+
+(defun modus-themes--heading (level fg fg-alt bg bg-gray border)
"Conditional styles for `modus-themes-headings'.
LEVEL is the heading's position in their order. FG is the
default text color. FG-ALT is an accented, more saturated value
than the default. BG is a nuanced, typically accented,
background that can work well with either of the foreground
-values. BORDER is a color value that combines well with the
-background and alternative foreground."
- (let* ((key (modus-themes--heading-p level))
- (style (or key (modus-themes--heading-p t)))
- (var (when modus-themes-variable-pitch-headings
- 'variable-pitch))
+values. BG-GRAY is a gray background. BORDER is a color value
+that combines well with the background and foreground."
+ (let* ((key (modus-themes--key-cdr level modus-themes-headings))
+ (style (or key (modus-themes--key-cdr t modus-themes-headings)))
+ (modus-themes-headings
+ (if (listp style)
+ style
+ ;; translation layer for legacy values
+ (pcase style
+ ('highlight '(background))
+ ('highlight-no-bold '(background no-bold))
+ ('line '(overline))
+ ('line-no-bold '(no-bold overline))
+ ('no-bold '(no-bold))
+ ('no-color '(monochrome))
+ ('no-color-no-bold '(no-bold monochrome))
+ ('rainbow '(rainbow))
+ ('rainbow-highlight '(rainbow background))
+ ('rainbow-highlight-no-bold '(no-bold rainbow background))
+ ('rainbow-line '(rainbow overline))
+ ('rainbow-no-bold '(no-bold rainbow))
+ ('rainbow-line-no-bold '(rainbow overline no-bold))
+ ('rainbow-section '(rainbow overline background))
+ ('rainbow-section-no-bold '(no-bold rainbow background overline))
+ ('section '(background overline))
+ ('section-no-bold '(background overline no-bold)))))
+ (var (if modus-themes-variable-pitch-headings
+ 'variable-pitch
+ 'unspecified))
(varbold (if var
(append (list 'bold) (list var))
'bold)))
- (pcase style
- ('no-bold
- (list :inherit var :foreground fg))
- ('no-color
- (list :inherit varbold))
- ('no-color-no-bold
- (list :inherit var))
- ('line
- (list :inherit varbold :foreground fg :overline border))
- ('line-no-bold
- (list :inherit var :foreground fg :overline border))
- ('rainbow
- (list :inherit varbold :foreground fg-alt))
- ('rainbow-no-bold
- (list :inherit var :foreground fg-alt))
- ('rainbow-line
- (list :inherit varbold :foreground fg-alt :overline border))
- ('rainbow-line-no-bold
- (list :inherit var :foreground fg-alt :overline border))
- ('highlight
- (list :inherit varbold :background bg :foreground fg))
- ('highlight-no-bold
- (list :inherit var :background bg :foreground fg))
- ('rainbow-highlight
- (list :inherit varbold :background bg :foreground fg-alt))
- ('rainbow-highlight-no-bold
- (list :inherit var :background bg :foreground fg-alt))
- ('section
- (list :inherit varbold :background bg :foreground fg :overline border
:extend t))
- ('section-no-bold
- (list :inherit var :background bg :foreground fg :overline border
:extend t))
- ('rainbow-section
- (list :inherit varbold :background bg :foreground fg-alt :overline
border :extend t))
- ('rainbow-section-no-bold
- (list :inherit var :background bg :foreground fg-alt :overline border
:extend t))
- (_
- (list :inherit varbold :foreground fg)))))
+ (list :inherit
+ (cond
+ ((memq 'no-bold modus-themes-headings)
+ var)
+ (varbold))
+ :background
+ (cond
+ ((and (memq 'monochrome modus-themes-headings)
+ (memq 'background modus-themes-headings))
+ bg-gray)
+ ((memq 'background modus-themes-headings)
+ bg)
+ ('unspecified))
+ :foreground
+ (cond
+ ((memq 'monochrome modus-themes-headings)
+ 'unspecified)
+ ((memq 'rainbow modus-themes-headings)
+ fg-alt)
+ (fg))
+ :overline
+ (if (memq 'overline modus-themes-headings)
+ border
+ 'unspecified))))
+
+(defun modus-themes--agenda-structure (fg)
+ "Control the style of the Org agenda structure.
+FG is the foreground color to use."
+ (let* ((properties (modus-themes--key-cdr 'header-block
modus-themes-org-agenda))
+ (inherit (cond ((memq 'variable-pitch properties)
+ (list 'bold 'variable-pitch))
+ ('bold)))
+ (height (cond ((memq 'no-scale properties)
+ 1.0)
+ ((memq 'scale-title properties)
+ modus-themes-scale-title)
+ (1.15))))
+ (list :inherit inherit
+ :height height
+ :foreground fg)))
+
+(defun modus-themes--agenda-date (defaultfg grayscalefg &optional bold
workaholicfg grayscaleworkaholicfg)
+ "Control the style of date headings in Org agenda buffers.
+DEFAULTFG is the original accent color for the foreground.
+GRAYSCALEFG is a neutral color. Optional BOLD applies a bold
+weight. Optional WORKAHOLICFG and GRAYSCALEWORKAHOLICFG are
+alternative foreground colors."
+ (let* ((properties (modus-themes--key-cdr 'header-date
modus-themes-org-agenda))
+ (weight (cond ((memq 'bold-all properties)
+ 'bold)
+ ((and bold (memq 'bold-today properties))
+ 'bold)
+ (t
+ nil)))
+ (fg (cond ((and (memq 'grayscale properties)
+ (memq 'workaholic properties))
+ (or grayscaleworkaholicfg grayscalefg))
+ ((memq 'grayscale properties)
+ grayscalefg)
+ ((memq 'workaholic properties)
+ (or workaholicfg defaultfg))
+ (t
+ defaultfg))))
+ (list :inherit weight
+ :foreground fg)))
+
+(defun modus-themes--agenda-scheduled (defaultfg uniformfg rainbowfg)
+ "Control the style of the Org agenda scheduled tasks.
+DEFAULTFG is an accented foreground color that is meant to
+differentiate between past or present and future tasks.
+UNIFORMFG is a more subtle color that eliminates the color coding
+for scheduled tasks. RAINBOWFG is a prominent accent value that
+clearly distinguishes past, present, future tasks."
+ (pcase (modus-themes--key-cdr 'scheduled modus-themes-org-agenda)
+ ('uniform (list :foreground uniformfg))
+ ('rainbow (list :foreground rainbowfg))
+ (_ (list :foreground defaultfg))))
+
+(defun modus-themes--agenda-habit (default traffic simple &optional
traffic-deuteran)
+ "Specify background values for `modus-themes-org-agenda' habits.
+DEFAULT is the original foregrounc color. TRAFFIC is to be used
+when the 'traffic-light' style is applied, while SIMPLE
+corresponds to the 'simplified style'. Optional TRAFFIC-DEUTERAN
+is an alternative to TRAFFIC, meant for deuteranopia."
+ (pcase (modus-themes--key-cdr 'habit modus-themes-org-agenda)
+ ('traffic-light (list :background traffic))
+ ('traffic-light-deuteranopia (list :background (or traffic-deuteran
traffic)))
+ ('simplified (list :background simple))
+ (_ (list :background default))))
(defun modus-themes--org-block (bgblk fgdefault &optional fgblk)
"Conditionally set the background of Org blocks.
@@ -2715,15 +3419,6 @@ set to `rainbow'."
('rainbow (list :background bgaccent :foreground fgaccent))
(_ (list :background bg :foreground fg))))
-(defun modus-themes--org-habit (default &optional traffic simple)
- "Specify background values for `modus-themes-org-habit'.
-If no optional TRAFFIC argument is supplied, the DEFAULT is used
-instead. Same for SIMPLE."
- (pcase modus-themes-org-habit
- ('traffic-light (list :background (or traffic default)))
- ('simplified (list :background (or simple default)))
- (_ (list :background default))))
-
(defun modus-themes--mode-line-attrs
(fg bg fg-alt bg-alt fg-accent bg-accent border border-3d &optional
alt-style border-width fg-distant)
"Color combinations for `modus-themes-mode-line'.
@@ -2743,51 +3438,60 @@ rectangle that produces the box effect.
Optional FG-DISTANT should be close to the main background
values. It is intended to be used as a distant-foreground
property."
- (pcase modus-themes-mode-line
- ('3d
- `( :background ,bg-alt :foreground ,fg-alt
- :box ( :line-width ,(or border-width 1)
- :color ,border-3d
- :style ,(and alt-style 'released-button))))
- ('moody
- `( :background ,bg-alt :foreground ,fg-alt
- :underline ,border :overline ,border
- :distant-foreground ,fg-distant))
- ('borderless
- `(:background ,bg :foreground ,fg :box ,bg))
- ('borderless-3d
- `( :background ,bg :foreground ,fg
- :box ( :line-width ,(or border-width 1)
- :color ,bg
- :style ,(and alt-style 'released-button))))
- ('borderless-moody
- `( :background ,bg :foreground ,fg
- :underline ,bg :overline ,bg
- :distant-foreground ,fg-distant))
- ('accented
- `(:background ,bg-accent :foreground ,fg-accent :box ,border))
- ('accented-3d
- `( :background ,bg-accent :foreground ,fg-accent
- :box ( :line-width ,(or border-width 1)
- :color ,border-3d
- :style ,(and alt-style 'released-button))))
- ('accented-moody
- `( :background ,bg-accent :foreground ,fg-accent
- :underline ,border :overline ,border
- :distant-foreground ,fg-distant))
- ('borderless-accented
- `(:background ,bg-accent :foreground ,fg-accent :box ,bg-accent))
- ('borderless-accented-3d
- `( :background ,bg-accent :foreground ,fg-accent
- :box ( :line-width ,(or border-width 1)
- :color ,bg-accent
- :style ,(and alt-style 'released-button))))
- ('borderless-accented-moody
- `( :background ,bg-accent :foreground ,fg-accent
- :underline ,bg-accent :overline ,bg-accent
- :distant-foreground ,fg-distant))
- (_
- `(:background ,bg :foreground ,fg :box ,border))))
+ (let ((modus-themes-mode-line
+ (if (listp modus-themes-mode-line)
+ modus-themes-mode-line
+ ;; translation layer for legacy values
+ (alist-get modus-themes-mode-line
+ '((3d . (3d))
+ (moody . (moody))
+ (borderless . (borderless))
+ (borderless-3d . (borderless 3d))
+ (borderless-moody . (borderless moody))
+ (accented . (accented))
+ (accented-3d . (accented 3d))
+ (accented-moody . (accented moody))
+ (borderless-accented . (borderless accented))
+ (borderless-accented-3d . (borderless accented 3d))
+ (borderless-accented-moody . (borderless accented
moody)))))))
+ (let ((base (cond ((memq 'accented modus-themes-mode-line)
+ (cons fg-accent bg-accent))
+ ((and (or (memq 'moody modus-themes-mode-line)
+ (memq '3d modus-themes-mode-line))
+ (not (memq 'borderless modus-themes-mode-line)))
+ (cons fg-alt bg-alt))
+ ((cons fg bg))))
+ (box (cond ((memq 'moody modus-themes-mode-line)
+ nil)
+ ((memq '3d modus-themes-mode-line)
+ (list :line-width (or border-width 1)
+ :color
+ (cond ((and (memq 'accented modus-themes-mode-line)
+ (memq 'borderless
modus-themes-mode-line))
+ bg-accent)
+ ((memq 'borderless modus-themes-mode-line)
bg)
+ (border-3d))
+ :style (and alt-style 'released-button)))
+ ((or (memq 'borderless modus-themes-mode-line)
+ (memq 'moody modus-themes-mode-line))
+ bg)
+ (border)))
+ (line (cond ((not (memq 'moody modus-themes-mode-line))
+ nil)
+ ((and (memq 'borderless modus-themes-mode-line)
+ (memq 'accented modus-themes-mode-line))
+ bg-accent)
+ ((memq 'borderless modus-themes-mode-line)
+ bg)
+ (border))))
+ (list :foreground (car base)
+ :background (cdr base)
+ :box box
+ :overline line
+ :underline line
+ :distant-foreground
+ (and (memq 'moody modus-themes-mode-line)
+ fg-distant)))))
(defun modus-themes--diff
(fg-only-bg fg-only-fg mainbg mainfg altbg altfg &optional deuteranbg
deuteranfg bg-only-fg)
@@ -2867,30 +3571,85 @@ These are intended for Helm, Ivy, etc."
('moderate (list :inherit (list subtleface bold)))
(_ (list :inherit (list intenseface bold)))))
-(defun modus-themes--link (fg fgfaint underline)
+(defun modus-themes--link (fg fgfaint underline bg bgneutral)
"Conditional application of link styles.
FG is the link's default color for its text and underline
property. FGFAINT is a desaturated color for the text and
-underline. UNDERLINE is a gray color only for the undeline."
- (pcase modus-themes-links
- ('faint (list :foreground fgfaint :underline t))
- ('neutral-underline (list :foreground fg :underline underline))
- ('faint-neutral-underline (list :foreground fgfaint :underline underline))
- ('no-underline (list :foreground fg :underline nil))
- ('underline-only (list :underline t))
- ('neutral-underline-only (list :underline underline))
- (_ (list :foreground fg :underline t))))
+underline. UNDERLINE is a gray color only for the undeline. BG
+is a background color and BGNEUTRAL is its fallback value."
+ (let ((modus-themes-links
+ (if (listp modus-themes-links)
+ modus-themes-links
+ ;; translation layer for legacy values
+ (pcase modus-themes-links
+ ('faint '(faint))
+ ('neutral-underline '(neutral-underline))
+ ('faint-neutral-underline '(neutral-underline faint))
+ ('no-underline '(no-underline))
+ ('underline-only '(no-color))
+ ('neutral-underline-only '(no-color neutral-underline))))))
+ (list :inherit
+ (cond
+ ((and (memq 'bold modus-themes-links)
+ (memq 'italic modus-themes-links))
+ 'bold-italic)
+ ((memq 'italic modus-themes-links)
+ 'italic)
+ ((memq 'bold modus-themes-links)
+ 'bold)
+ ('unspecified))
+ :background
+ (cond
+ ((and (memq 'no-color modus-themes-links)
+ (memq 'no-underline modus-themes-links))
+ bgneutral)
+ ((memq 'background modus-themes-links)
+ bg)
+ ('unspecified))
+ :foreground
+ (cond
+ ((memq 'no-color modus-themes-links)
+ 'unspecified)
+ ((memq 'faint modus-themes-links)
+ fgfaint)
+ (fg))
+ :underline
+ (cond
+ ((memq 'no-underline modus-themes-links)
+ 'unspecified)
+ ((memq 'neutral-underline modus-themes-links)
+ underline)
+ (t)))))
(defun modus-themes--link-color (fg fgfaint &optional neutralfg)
"Extends `modus-themes--link'.
FG is the main accented foreground. FGFAINT is also accented,
yet desaturated. Optional NEUTRALFG is a gray value."
- (pcase modus-themes-links
- ('faint (list :foreground fgfaint))
- ('faint-neutral-underline (list :foreground fgfaint))
- ('underline-only (list :underline t :foreground (or neutralfg
'unspecified)))
- ('neutral-underline-only (list :underline 'unspecified :foreground (or
neutralfg 'unspecified)))
- (_ (list :foreground fg))))
+ (let ((modus-themes-links
+ (if (listp modus-themes-links)
+ modus-themes-links
+ ;; translation layer for legacy values
+ (pcase modus-themes-links
+ ('faint '(faint))
+ ('neutral-underline '(neutral-underline))
+ ('faint-neutral-underline '(neutral-underline faint))
+ ('no-underline '(no-underline))
+ ('underline-only '(no-color))
+ ('neutral-underline-only '(no-color neutral-underline))))))
+ (list :foreground
+ (cond
+ ((memq 'no-color modus-themes-links)
+ (or neutralfg 'unspecified))
+ ((memq 'faint modus-themes-links)
+ fgfaint)
+ (fg))
+ :underline
+ (cond
+ ((memq 'no-underline modus-themes-links)
+ 'unspecified)
+ ((memq 'neutral-underline modus-themes-links)
+ (or neutralfg 'unspecified))
+ (t)))))
(defun modus-themes--scale (amount)
"Scale heading by AMOUNT.
@@ -2898,39 +3657,96 @@ AMOUNT is a customization option."
(when modus-themes-scale-headings
(list :height amount)))
-(defun modus-themes--region (bg fg bgsubtle bgaccent)
+(defun modus-themes--region (bg fg bgsubtle bgaccent bgaccentsubtle)
"Apply `modus-themes-region' styles.
BG and FG are the main values that are used by default. BGSUBTLE
is a subtle background value that can be combined with all colors
used to fontify text and code syntax. BGACCENT is a colored
-background that combines well with FG."
- (pcase modus-themes-region
- ('bg-only (list :background bgsubtle))
- ('bg-only-no-extend (list :background bgsubtle :extend nil))
- ('no-extend (list :background bg :foreground fg :extend nil))
- ('accent (list :background bgaccent :foreground fg))
- ('accent-no-extend (list :background bgaccent :foreground fg :extend nil))
- (_ (list :background bg :foreground fg))))
-
-(defun modus-themes--hl-line (bgdefault bgintense bgaccent bgaccentul
lineneutral lineaccent)
+background that combines well with FG. BGACCENTSUBTLE can be
+combined with all colors used to fontify text."
+ (let ((modus-themes-region
+ (if (listp modus-themes-region)
+ modus-themes-region
+ ;; translation layer for legacy values
+ (pcase modus-themes-region
+ ('bg-only '(bg-only))
+ ('bg-only-no-extend '(bg-only no-extend))
+ ('accent '(accented))
+ ('accent-no-extend '(accented no-extend))
+ ('no-extend '(no-extend))))))
+ (list :background
+ (cond
+ ((and (memq 'accented modus-themes-region)
+ (memq 'bg-only modus-themes-region))
+ bgaccentsubtle)
+ ((memq 'accented modus-themes-region)
+ bgaccent)
+ ((memq 'bg-only modus-themes-region)
+ bgsubtle)
+ (bg))
+ :foreground
+ (cond
+ ((and (memq 'accented modus-themes-region)
+ (memq 'bg-only modus-themes-region))
+ 'unspecified)
+ ((memq 'bg-only modus-themes-region)
+ 'unspecified)
+ (fg))
+ :extend
+ (cond
+ ((memq 'no-extend modus-themes-region)
+ nil)
+ (t)))))
+
+(defun modus-themes--hl-line
+ (bgdefault bgintense bgaccent bgaccentsubtle lineneutral lineaccent
lineneutralintense lineaccentintense)
"Apply `modus-themes-hl-line' styles.
BGDEFAULT is a subtle neutral background. BGINTENSE is like the
default, but more prominent. BGACCENT is a prominent accented
-background, while BGACCENTUL is more subtle and is meant to be
-used in tandem with an underline. LINENEUTRAL and LINEACCENT are
-a color values that can remain distinct against the buffer's
-possible backgrounds: the former is neutral, the latter is
-accented."
- (pcase modus-themes-hl-line
- ('intense-background (list :background bgintense))
- ('accented-background (list :background bgaccent))
- ('underline-neutral (list :background bgdefault :underline lineneutral))
- ('underline-accented (list :background bgaccentul :underline lineaccent))
- ('underline-only-neutral (list :background 'unspecified :underline
lineneutral))
- ('underline-only-accented (list :background 'unspecified :underline
lineaccent))
- (_ (list :background bgdefault))))
+background, while BGACCENTSUBTLE is more subtle. LINENEUTRAL and
+LINEACCENT are color values that can remain distinct against the
+buffer's possible backgrounds: the former is neutral, the latter
+is accented. LINENEUTRALINTENSE and LINEACCENTINTENSE are their
+more prominent alternatives."
+ (let ((modus-themes-hl-line
+ (if (listp modus-themes-hl-line)
+ modus-themes-hl-line
+ ;; translation layer for legacy values
+ (pcase modus-themes-hl-line
+ ('intense-background '(intense))
+ ('accented-background '(accented))
+ ('underline-neutral '(underline))
+ ('underline-accented '(underline accented))
+ ('underline-only-neutral '(underline)) ; only underline styles
have been removed
+ ('underline-only-accented '(underline accented))))))
+ (list :background
+ (cond
+ ((and (memq 'intense modus-themes-hl-line)
+ (memq 'accented modus-themes-hl-line))
+ bgaccent)
+ ((memq 'accented modus-themes-hl-line)
+ bgaccentsubtle)
+ ((memq 'intense modus-themes-hl-line)
+ bgintense)
+ (bgdefault))
+ :underline
+ (cond
+ ((and (memq 'intense modus-themes-hl-line)
+ (memq 'accented modus-themes-hl-line)
+ (memq 'underline modus-themes-hl-line))
+ lineaccentintense)
+ ((and (memq 'accented modus-themes-hl-line)
+ (memq 'underline modus-themes-hl-line))
+ lineaccent)
+ ((and (memq 'intense modus-themes-hl-line)
+ (memq 'underline modus-themes-hl-line))
+ lineneutralintense)
+ ((or (memq 'no-background modus-themes-hl-line)
+ (memq 'underline modus-themes-hl-line))
+ lineneutral)
+ ('unspecified)))))
(defun modus-themes--mail-cite (mainfg subtlefg)
"Combinations for `modus-themes-mail-citations'.
@@ -3226,32 +4042,40 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;; styles for regular headings used in Org, Markdown, Info, etc.
`(modus-themes-heading-1
((,class ,@(modus-themes--heading
- 1 fg-main magenta-alt-other magenta-nuanced-bg bg-region)
+ 1 fg-main magenta-alt-other
+ magenta-nuanced-bg bg-alt bg-region)
,@(modus-themes--scale modus-themes-scale-4))))
`(modus-themes-heading-2
((,class ,@(modus-themes--heading
- 2 fg-special-warm magenta-alt red-nuanced-bg bg-region)
+ 2 fg-special-warm magenta-alt
+ red-nuanced-bg bg-alt bg-region)
,@(modus-themes--scale modus-themes-scale-3))))
`(modus-themes-heading-3
((,class ,@(modus-themes--heading
- 3 fg-special-cold blue blue-nuanced-bg bg-region)
+ 3 fg-special-cold blue
+ blue-nuanced-bg bg-alt bg-region)
,@(modus-themes--scale modus-themes-scale-2))))
`(modus-themes-heading-4
((,class ,@(modus-themes--heading
- 4 fg-special-mild cyan cyan-nuanced-bg bg-region)
+ 4 fg-special-mild cyan
+ cyan-nuanced-bg bg-alt bg-region)
,@(modus-themes--scale modus-themes-scale-1))))
`(modus-themes-heading-5
((,class ,@(modus-themes--heading
- 5 fg-special-calm green-alt-other green-nuanced-bg
bg-region))))
+ 5 fg-special-calm green-alt-other
+ green-nuanced-bg bg-alt bg-region))))
`(modus-themes-heading-6
((,class ,@(modus-themes--heading
- 6 yellow-nuanced-fg yellow-alt-other yellow-nuanced-bg
bg-region))))
+ 6 yellow-nuanced-fg yellow-alt-other
+ yellow-nuanced-bg bg-alt bg-region))))
`(modus-themes-heading-7
((,class ,@(modus-themes--heading
- 7 red-nuanced-fg red-alt red-nuanced-bg bg-region))))
+ 7 red-nuanced-fg red-alt
+ red-nuanced-bg bg-alt bg-region))))
`(modus-themes-heading-8
((,class ,@(modus-themes--heading
- 8 magenta-nuanced-fg magenta bg-alt bg-region))))
+ 8 magenta-nuanced-fg magenta
+ bg-alt bg-alt bg-region))))
;;;;; graph-specific faces
`(modus-themes-graph-red-0 ((,class :background ,red-graph-0-bg)))
`(modus-themes-graph-red-1 ((,class :background ,red-graph-1-bg)))
@@ -3267,25 +4091,27 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(modus-themes-graph-cyan-1 ((,class :background ,cyan-graph-1-bg)))
;;;;; language checkers
`(modus-themes-lang-error ((,class ,@(modus-themes--lang-check
- fg-lang-underline-error
- fg-lang-error
- red red-nuanced-bg))))
+ fg-lang-underline-error fg-lang-error
+ red red-refine-fg red-nuanced-bg
red-refine-bg))))
`(modus-themes-lang-note ((,class ,@(modus-themes--lang-check
- fg-lang-underline-note
- fg-lang-note
- blue-alt blue-nuanced-bg))))
+ fg-lang-underline-note fg-lang-note
+ blue-alt blue-refine-fg
blue-nuanced-bg blue-refine-bg))))
`(modus-themes-lang-warning ((,class ,@(modus-themes--lang-check
- fg-lang-underline-warning
- fg-lang-warning
- yellow yellow-nuanced-bg))))
+ fg-lang-underline-warning
fg-lang-warning
+ yellow yellow-refine-fg
yellow-nuanced-bg yellow-refine-bg))))
;;;;; other custom faces
`(modus-themes-bold ((,class ,@(modus-themes--bold-weight))))
`(modus-themes-hl-line ((,class ,@(modus-themes--hl-line
bg-hl-line bg-hl-line-intense
bg-hl-line-intense-accent
blue-nuanced-bg
- bg-region blue-intense-bg)
+ bg-region blue-intense-bg
+ fg-alt cyan-intense)
:extend t)))
`(modus-themes-key-binding ((,class :inherit bold :foreground
,blue-alt-other)))
+ `(modus-themes-prompt ((,class ,@(modus-themes--prompt
+ cyan-alt-other blue-alt-other fg-alt
+ cyan-nuanced-bg blue-refine-bg fg-main
+ bg-alt bg-active))))
`(modus-themes-reset-hard ((,class :inherit (fixed-pitch
modus-themes-reset-soft))))
`(modus-themes-reset-soft ((,class :background ,bg-main :foreground
,fg-main
:weight normal :slant normal
:strike-through nil
@@ -3301,6 +4127,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
green-active))))
`(modus-themes-slant ((,class :inherit italic :slant
,@(modus-themes--slant))))
`(modus-themes-variable-pitch ((,class ,@(modus-themes--variable-pitch))))
+ `(modus-themes-fixed-pitch ((,class ,@(modus-themes--fixed-pitch))))
;;;; standard faces
;;;;; absolute essentials
`(default ((,class :background ,bg-main :foreground ,fg-main)))
@@ -3313,11 +4140,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(bold-italic ((,class :inherit (bold italic))))
`(buffer-menu-buffer ((,class :inherit bold)))
`(comint-highlight-input ((,class :inherit bold)))
- `(comint-highlight-prompt ((,class :inherit modus-themes-bold
- ,@(modus-themes--prompt
- cyan
- blue-nuanced-bg blue-alt
- blue-refine-bg fg-main))))
+ `(comint-highlight-prompt ((,class :inherit modus-themes-prompt)))
`(error ((,class :inherit bold :foreground ,red)))
`(escape-glyph ((,class :foreground ,fg-escape-char-construct)))
`(file-name-shadow ((,class :foreground ,fg-unfocused)))
@@ -3332,15 +4155,14 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(italic ((,class :slant italic)))
`(nobreak-hyphen ((,class :foreground ,fg-escape-char-construct)))
`(nobreak-space ((,class :foreground ,fg-escape-char-construct :underline
t)))
- `(minibuffer-prompt ((,class ,@(modus-themes--prompt
- cyan-alt-other
- cyan-nuanced-bg cyan
- cyan-refine-bg fg-main))))
+ `(minibuffer-prompt ((,class :inherit modus-themes-prompt)))
`(mm-command-output ((,class :foreground ,red-alt-other)))
`(mm-uu-extract ((,class :background ,bg-dim :foreground
,fg-special-mild)))
- `(next-error ((,class :inherit modus-themes-subtle-red)))
+ `(next-error ((,class :inherit modus-themes-subtle-red :extend t)))
`(rectangle-preview ((,class :inherit modus-themes-special-mild)))
- `(region ((,class ,@(modus-themes--region bg-region fg-main
bg-hl-alt-intense bg-region-accent))))
+ `(region ((,class ,@(modus-themes--region bg-region fg-main
+ bg-hl-alt-intense
bg-region-accent
+ bg-region-accent-subtle))))
`(secondary-selection ((,class :inherit modus-themes-special-cold)))
`(shadow ((,class :foreground ,fg-alt)))
`(success ((,class :inherit bold :foreground
,@(modus-themes--success-deuteran blue green))))
@@ -3348,7 +4170,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(warning ((,class :inherit bold :foreground ,yellow)))
;;;;; buttons, links, widgets
`(button ((,class ,@(modus-themes--link
- blue-alt-other blue-alt-other-faint bg-region))))
+ blue-alt-other blue-alt-other-faint
+ bg-region blue-nuanced-bg bg-alt))))
`(link ((,class :inherit button)))
`(link-visited ((,class :inherit button
,@(modus-themes--link-color
@@ -3358,7 +4181,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(widget-button-pressed ((,class :inherit widget-button :foreground
,magenta)))
`(widget-documentation ((,class :foreground ,green)))
`(widget-field ((,class :background ,bg-alt :foreground ,fg-dim)))
- `(widget-inactive ((,class :background ,bg-inactive :foreground
,fg-inactive)))
+ `(widget-inactive ((,class :foreground ,fg-alt)))
`(widget-single-line-field ((,class :inherit widget-field)))
;;;;; ag
`(ag-hit-face ((,class :foreground ,fg-special-cold)))
@@ -3419,21 +4242,24 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(anzu-replace-highlight ((,class :inherit modus-themes-refine-yellow
:underline t)))
`(anzu-replace-to ((,class :inherit (modus-themes-search-success bold))))
;;;;; apropos
+ `(apropos-button ((,class :inherit button
+ ,@(modus-themes--link-color
+ magenta-alt-other magenta-alt-other-faint))))
`(apropos-function-button ((,class :inherit button
,@(modus-themes--link-color
- magenta-alt-other
magenta-alt-other-faint))))
+ magenta magenta-faint))))
`(apropos-keybinding ((,class :inherit modus-themes-key-binding)))
`(apropos-misc-button ((,class :inherit button
,@(modus-themes--link-color
cyan-alt-other cyan-alt-other-faint))))
`(apropos-property ((,class :inherit modus-themes-bold :foreground
,magenta-alt)))
- `(apropos-symbol ((,class :inherit modus-themes-bold :foreground
,magenta)))
+ `(apropos-symbol ((,class :inherit modus-themes-pseudo-header)))
`(apropos-user-option-button ((,class :inherit button
,@(modus-themes--link-color
- green-alt-other
green-alt-other-faint))))
+ cyan cyan-faint))))
`(apropos-variable-button ((,class :inherit button
,@(modus-themes--link-color
- blue blue-faint))))
+ blue-alt blue-alt-faint))))
;;;;; apt-sources-list
`(apt-sources-list-components ((,class :foreground ,cyan)))
`(apt-sources-list-options ((,class :foreground ,yellow)))
@@ -3546,7 +4372,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(calendar-month-header ((,class :inherit modus-themes-pseudo-header)))
`(calendar-today ((,class :inherit bold :underline t)))
`(calendar-weekday-header ((,class :foreground ,fg-unfocused)))
- `(calendar-weekend-header ((,class :foreground ,fg-unfocused)))
+ `(calendar-weekend-header ((,class :foreground ,red-faint)))
`(diary ((,class :background ,blue-nuanced-bg :foreground
,blue-alt-other)))
`(diary-anniversary ((,class :foreground ,red-alt-other)))
`(diary-time ((,class :foreground ,cyan)))
@@ -3566,7 +4392,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(cfw:face-sunday ((,class :inherit bold :foreground ,cyan-alt-other)))
`(cfw:face-title ((,class :inherit modus-themes-variable-pitch
:foreground ,fg-special-cold
- ,@(modus-themes--scale modus-themes-scale-5))))
+ ,@(modus-themes--scale
modus-themes-scale-title))))
`(cfw:face-today ((,class :background ,bg-inactive)))
`(cfw:face-today-title ((,class :background ,bg-active)))
`(cfw:face-toolbar ((,class :background ,bg-alt :foreground ,bg-alt)))
@@ -3618,7 +4444,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(cider-instrumented-face ((,class :box (:line-width -1 :color ,red :style
nil) :background ,bg-dim)))
`(cider-reader-conditional-face ((,class :inherit italic :foreground
,fg-special-warm)))
`(cider-repl-input-face ((,class :inherit bold)))
- `(cider-repl-prompt-face ((,class :inherit comint-highlight-prompt)))
+ `(cider-repl-prompt-face ((,class :inherit modus-themes-prompt)))
`(cider-repl-stderr-face ((,class :inherit bold :foreground ,red)))
`(cider-repl-stdout-face ((,class :foreground ,blue)))
`(cider-result-overlay-face ((,class :box (:line-width -1 :color ,blue
:style nil) :background ,bg-dim)))
@@ -3642,7 +4468,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; circe (and lui)
`(circe-fool-face ((,class :inherit shadow)))
`(circe-highlight-nick-face ((,class :inherit bold :foreground ,blue)))
- `(circe-prompt-face ((,class :inherit comint-highlight-prompt)))
+ `(circe-prompt-face ((,class :inherit modus-themes-prompt)))
`(circe-server-face ((,class :foreground ,fg-unfocused)))
`(lui-button-face ((,class :inherit button)))
`(lui-highlight-face ((,class :foreground ,magenta-alt)))
@@ -3755,6 +4581,9 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(cperl-nonoverridable-face ((,class :foreground unspecified)))
`(cperl-array-face ((,class :inherit font-lock-keyword-face)))
`(cperl-hash-face ((,class :inherit font-lock-variable-name-face)))
+;;;;; css-mode
+ `(css-property ((,class :inherit font-lock-type-face)))
+ `(css-selector ((,class :inherit font-lock-keyword-face)))
;;;;; csv-mode
`(csv-separator-face ((,class :foreground ,red-intense)))
;;;;; ctrlf
@@ -3851,7 +4680,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; diff-mode
`(diff-added ((,class :inherit modus-themes-diff-added)))
`(diff-changed ((,class :inherit modus-themes-diff-changed :extend t)))
- `(diff-context ((,class :foreground ,fg-alt)))
+ `(diff-context ((,class ,@(unless (eq modus-themes-diffs 'bg-only) (list
:foreground fg-unfocused)))))
`(diff-error ((,class :inherit modus-themes-intense-red)))
`(diff-file-header ((,class :inherit (bold diff-header))))
`(diff-function ((,class :inherit modus-themes-diff-heading)))
@@ -4113,8 +4942,10 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; embark
`(embark-keybinding ((,class :inherit modus-themes-key-binding)))
;;;;; emms
- `(emms-playlist-track-face ((,class :foreground ,blue)))
- `(emms-playlist-selected-face ((,class :inherit bold :foreground
,magenta)))
+ `(emms-playlist-track-face ((,class :foreground ,blue-alt)))
+ `(emms-playlist-selected-face ((,class :inherit bold :foreground
,blue-alt-other)))
+ `(emms-metaplaylist-mode-current-face ((,class :inherit
emms-playlist-selected-face)))
+ `(emms-metaplaylist-mode-face ((,class :foreground ,cyan)))
;;;;; enh-ruby-mode (enhanced-ruby-mode)
`(enh-ruby-heredoc-delimiter-face ((,class :inherit
font-lock-constant-face)))
`(enh-ruby-op-face ((,class :foreground ,fg-main)))
@@ -4162,7 +4993,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(erc-nick-prefix-face ((,class :inherit erc-nick-default-face)))
`(erc-notice-face ((,class :foreground ,fg-unfocused)))
`(erc-pal-face ((,class :inherit bold :foreground ,red-alt)))
- `(erc-prompt-face ((,class :inherit comint-highlight-prompt)))
+ `(erc-prompt-face ((,class :inherit modus-themes-prompt)))
`(erc-timestamp-face ((,class :foreground ,blue-nuanced-fg)))
`(erc-underline-face ((,class :underline t)))
`(bg:erc-color-face0 ((,class :background "white")))
@@ -4215,7 +5046,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(eshell-ls-special ((,class :foreground ,magenta)))
`(eshell-ls-symlink ((,class :foreground ,cyan)))
`(eshell-ls-unreadable ((,class :background ,bg-inactive :foreground
,fg-inactive)))
- `(eshell-prompt ((,class :inherit comint-highlight-prompt)))
+ `(eshell-prompt ((,class :inherit modus-themes-prompt)))
;;;;; eshell-fringe-status
`(eshell-fringe-status-failure ((,class :inherit error)))
`(eshell-fringe-status-success ((,class :inherit success)))
@@ -4363,45 +5194,56 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; font-lock
`(font-lock-builtin-face ((,class :inherit modus-themes-bold
,@(modus-themes--syntax-extra
- magenta-alt magenta-alt-faint
blue-alt))))
+ magenta-alt magenta-alt-faint
+ magenta magenta-faint))))
`(font-lock-comment-delimiter-face ((,class :inherit
font-lock-comment-face)))
`(font-lock-comment-face ((,class :inherit modus-themes-slant
,@(modus-themes--syntax-comment
- fg-alt fg-comment-yellow))))
+ fg-alt fg-comment-yellow
yellow-alt-other-faint))))
`(font-lock-constant-face ((,class ,@(modus-themes--syntax-extra
- blue-alt-other blue-alt-other-faint
magenta-alt-other))))
+ blue-alt-other blue-alt-other-faint
+ magenta-alt-other
magenta-alt-other-faint))))
`(font-lock-doc-face ((,class :inherit modus-themes-slant
- ,@(modus-themes--syntax-docstring
- fg-docstring green-alt-other-faint
- green-alt-other-faint
magenta-nuanced-fg))))
+ ,@(modus-themes--syntax-string
+ fg-docstring fg-special-cold
+ fg-special-mild magenta-nuanced-fg
+ fg-special-mild magenta-nuanced-fg))))
`(font-lock-function-name-face ((,class ,@(modus-themes--syntax-extra
- magenta magenta-faint
magenta-alt))))
+ magenta magenta-faint
+ magenta-alt
magenta-alt-faint))))
`(font-lock-keyword-face ((,class :inherit modus-themes-bold
,@(modus-themes--syntax-extra
- magenta-alt-other
magenta-alt-other-faint cyan-alt-other))))
+ magenta-alt-other
magenta-alt-other-faint
+ cyan cyan-faint))))
`(font-lock-negation-char-face ((,class :inherit modus-themes-bold
,@(modus-themes--syntax-foreground
yellow yellow-faint))))
- `(font-lock-preprocessor-face ((,class ,@(modus-themes--syntax-foreground
- red-alt-other
red-alt-other-faint))))
+ `(font-lock-preprocessor-face ((,class ,@(modus-themes--syntax-extra
+ red-alt-other red-alt-other-faint
+ blue-alt blue-alt-faint))))
`(font-lock-regexp-grouping-backslash ((,class :inherit bold
,@(modus-themes--syntax-string
fg-escape-char-backslash
yellow-alt-faint
- magenta-alt-other
blue-alt))))
+ yellow magenta-alt
+ yellow-faint
red-faint))))
`(font-lock-regexp-grouping-construct ((,class :inherit bold
,@(modus-themes--syntax-string
fg-escape-char-construct
red-alt-other-faint
- red magenta-alt))))
+ blue blue-alt-other
+ blue-faint
blue-alt-other-faint))))
`(font-lock-string-face ((,class ,@(modus-themes--syntax-string
- blue-alt blue-alt-faint green
green-alt))))
+ blue-alt blue-alt-faint
+ green red
+ green-faint red-faint))))
`(font-lock-type-face ((,class :inherit modus-themes-bold
- ,@(modus-themes--syntax-extra
- cyan-alt-other cyan-alt-faint
cyan-alt))))
+ ,@(modus-themes--syntax-foreground
+ cyan-alt-other cyan-alt-faint))))
`(font-lock-variable-name-face ((,class ,@(modus-themes--syntax-extra
- cyan cyan-faint
blue-alt-faint))))
+ cyan cyan-faint
+ blue-alt-other
blue-alt-other-faint))))
`(font-lock-warning-face ((,class :inherit modus-themes-bold
- ,@(modus-themes--syntax-foreground
- yellow-active yellow-alt-faint))))
+ ,@(modus-themes--syntax-comment
+ yellow-active red-active red-faint
yellow-faint))))
;;;;; forge
`(forge-post-author ((,class :inherit bold :foreground ,fg-main)))
`(forge-post-date ((,class :foreground ,fg-special-cold)))
@@ -4439,7 +5281,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(geiser-font-lock-image-button ((,class :inherit button :foreground
,green-alt)))
`(geiser-font-lock-repl-input ((,class :inherit bold)))
`(geiser-font-lock-repl-output ((,class :inherit font-lock-keyword-face)))
- `(geiser-font-lock-repl-prompt ((,class :inherit minibuffer-prompt)))
+ `(geiser-font-lock-repl-prompt ((,class :inherit modus-themes-prompt)))
`(geiser-font-lock-xref-header ((,class :inherit bold)))
`(geiser-font-lock-xref-link ((,class :inherit button)))
;;;;; git-commit
@@ -4580,7 +5422,13 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(gnus-summary-normal-ticked ((,class :foreground ,red-alt-other)))
`(gnus-summary-normal-undownloaded ((,class :foreground ,yellow)))
`(gnus-summary-normal-unread ((,class :foreground ,fg-main)))
- `(gnus-summary-selected ((,class :inherit modus-themes-subtle-blue :extend
t)))
+ `(gnus-summary-selected ((,class :inherit highlight :extend t)))
+;;;;; gotest
+ `(go-test--ok-face ((,class :inherit success)))
+ `(go-test--error-face ((,class :inherit error)))
+ `(go-test--warning-face ((,class :inherit warning)))
+ `(go-test--pointer-face ((,class :foreground ,magenta-alt-other)))
+ `(go-test--standard-face ((,class :foreground ,fg-special-cold)))
;;;;; golden-ratio-scroll-screen
`(golden-ratio-scroll-highlight-line-face ((,class :background
,cyan-subtle-bg :foreground ,fg-main)))
;;;;; helm
@@ -4681,7 +5529,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
'modus-themes-subtle-cyan
'modus-themes-nuanced-cyan
cyan-alt-other))))
- `(helm-minibuffer-prompt ((,class :inherit minibuffer-prompt)))
+ `(helm-minibuffer-prompt ((,class :inherit modus-themes-prompt)))
`(helm-moccur-buffer ((,class :inherit button
,@(modus-themes--link-color
cyan-alt-other cyan-alt-other-faint))))
@@ -4748,7 +5596,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(hi-red-b ((,class :inherit bold :background ,red-intense-bg :foreground
,fg-main)))
`(hi-salmon ((,class :background ,red-subtle-bg :foreground ,fg-main)))
`(hi-yellow ((,class :background ,yellow-subtle-bg :foreground ,fg-main)))
- `(highlight ((,class :inherit modus-themes-subtle-blue)))
+ `(highlight ((,class :background ,blue-subtle-bg :foreground ,fg-main)))
`(highlight-changes ((,class :foreground ,red-alt :underline nil)))
`(highlight-changes-delete ((,class :background ,red-nuanced-bg
:foreground ,red :underline t)))
@@ -4791,11 +5639,11 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; hl-todo
`(hl-todo ((,class :inherit (bold modus-themes-slant) :foreground
,red-alt-other)))
;;;;; hydra
- `(hydra-face-amaranth ((,class :inherit bold :foreground ,yellow)))
- `(hydra-face-blue ((,class :inherit bold :foreground ,blue-alt)))
- `(hydra-face-pink ((,class :inherit bold :foreground ,magenta-alt)))
- `(hydra-face-red ((,class :inherit bold :foreground ,red)))
- `(hydra-face-teal ((,class :inherit bold :foreground ,cyan)))
+ `(hydra-face-amaranth ((,class :inherit bold :foreground ,yellow-alt)))
+ `(hydra-face-blue ((,class :inherit bold :foreground ,blue)))
+ `(hydra-face-pink ((,class :inherit bold :foreground ,magenta-alt-faint)))
+ `(hydra-face-red ((,class :inherit bold :foreground ,red-faint)))
+ `(hydra-face-teal ((,class :inherit bold :foreground ,cyan-alt-other)))
;;;;; hyperlist
`(hyperlist-condition ((,class :foreground ,green)))
`(hyperlist-hashtag ((,class :foreground ,yellow)))
@@ -4847,10 +5695,10 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(indium-keyword-face ((,class :inherit font-lock-keyword-face)))
`(indium-litable-face ((,class :inherit modus-themes-slant :foreground
,fg-special-warm)))
`(indium-repl-error-face ((,class :inherit error)))
- `(indium-repl-prompt-face ((,class :inherit comint-highlight-prompt)))
+ `(indium-repl-prompt-face ((,class :inherit modus-themes-prompt)))
`(indium-repl-stdout-face ((,class :foreground ,fg-main)))
;;;;; info
- `(Info-quoted ((,class ,@(modus-themes--mixed-fonts) ; the capitalization
is canonical
+ `(Info-quoted ((,class :inherit modus-themes-fixed-pitch ; the
capitalization is canonical
:background ,bg-alt :foreground ,fg-special-calm)))
`(info-header-node ((,class :inherit bold :foreground ,fg-alt)))
`(info-header-xref ((,class :foreground ,blue-active)))
@@ -5016,6 +5864,17 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; keycast
`(keycast-command ((,class :inherit bold :foreground ,blue-active)))
`(keycast-key ((,class :background ,blue-active :foreground ,bg-main)))
+;;;;; ledger-mode
+ `(ledger-font-auto-xact-face ((,class :foreground ,magenta)))
+ `(ledger-font-account-name-face ((,class :foreground ,fg-special-cold)))
+ `(ledger-font-directive-face ((,class :foreground ,magenta-alt-other)))
+ `(ledger-font-posting-date-face ((,class :inherit bold :foreground
,fg-main)))
+ `(ledger-font-periodic-xact-face ((,class :foreground ,cyan-alt-other)))
+ `(ledger-font-posting-amount-face ((,class :foreground ,fg-special-mild)))
+ `(ledger-font-payee-cleared-face ((,class :foreground ,blue-alt)))
+ `(ledger-font-payee-pending-face ((,class :foreground ,yellow)))
+ `(ledger-font-payee-uncleared-face ((,class :foreground ,red-alt-other)))
+ `(ledger-font-xact-highlight-face ((,class :background ,bg-hl-alt)))
;;;;; line numbers (display-line-numbers-mode and global variant)
`(line-number
((,class :inherit default
@@ -5119,7 +5978,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
bg-diff-changed fg-diff-changed
yellow-nuanced-bg fg-diff-changed))))
`(magit-diff-base-highlight ((,class :inherit
modus-themes-diff-focus-changed)))
- `(magit-diff-context ((,class :foreground ,fg-unfocused)))
+ `(magit-diff-context ((,class ,@(unless (eq modus-themes-diffs 'bg-only)
(list :foreground fg-unfocused)))))
`(magit-diff-context-highlight ((,class ,@(modus-themes--diff
bg-dim fg-dim
bg-inactive fg-inactive
@@ -5239,7 +6098,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; markdown-mode
`(markdown-blockquote-face ((,class :inherit modus-themes-slant
:foreground ,fg-special-cold)))
`(markdown-bold-face ((,class :inherit bold)))
- `(markdown-code-face ((,class ,@(modus-themes--mixed-fonts) :background
,bg-dim :extend t)))
+ `(markdown-code-face ((,class :inherit modus-themes-fixed-pitch
:background ,bg-dim :extend t)))
`(markdown-comment-face ((,class :inherit font-lock-comment-face)))
`(markdown-footnote-marker-face ((,class :inherit bold :foreground
,cyan-alt)))
`(markdown-footnote-text-face ((,class :inherit modus-themes-slant
:foreground ,fg-main)))
@@ -5254,22 +6113,22 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(markdown-header-face-6 ((,class :inherit modus-themes-heading-6)))
`(markdown-header-rule-face ((,class :inherit bold :foreground
,fg-special-warm)))
`(markdown-hr-face ((,class :inherit bold :foreground ,fg-special-warm)))
- `(markdown-html-attr-name-face ((,class ,@(modus-themes--mixed-fonts)
+ `(markdown-html-attr-name-face ((,class :inherit modus-themes-fixed-pitch
:foreground ,cyan)))
- `(markdown-html-attr-value-face ((,class ,@(modus-themes--mixed-fonts)
+ `(markdown-html-attr-value-face ((,class :inherit modus-themes-fixed-pitch
:foreground ,blue)))
- `(markdown-html-entity-face ((,class ,@(modus-themes--mixed-fonts)
+ `(markdown-html-entity-face ((,class :inherit modus-themes-fixed-pitch
:foreground ,cyan)))
- `(markdown-html-tag-delimiter-face ((,class ,@(modus-themes--mixed-fonts)
+ `(markdown-html-tag-delimiter-face ((,class :inherit
modus-themes-fixed-pitch
:foreground ,fg-special-mild)))
- `(markdown-html-tag-name-face ((,class ,@(modus-themes--mixed-fonts)
+ `(markdown-html-tag-name-face ((,class :inherit modus-themes-fixed-pitch
:foreground ,magenta-alt)))
- `(markdown-inline-code-face ((,class ,@(modus-themes--mixed-fonts)
+ `(markdown-inline-code-face ((,class :inherit modus-themes-fixed-pitch
:background ,bg-alt :foreground
,fg-special-calm)))
`(markdown-italic-face ((,class :inherit italic :foreground
,fg-special-cold)))
- `(markdown-language-info-face ((,class ,@(modus-themes--mixed-fonts)
+ `(markdown-language-info-face ((,class :inherit modus-themes-fixed-pitch
:foreground ,fg-special-cold)))
- `(markdown-language-keyword-face ((,class ,@(modus-themes--mixed-fonts)
+ `(markdown-language-keyword-face ((,class :inherit modus-themes-fixed-pitch
:background ,bg-alt
:foreground ,fg-alt)))
`(markdown-line-break-face ((,class :inherit modus-themes-refine-cyan
:underline t)))
@@ -5285,46 +6144,53 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(markdown-pre-face ((,class :inherit markdown-code-face :foreground
,fg-special-mild)))
`(markdown-reference-face ((,class :inherit markdown-markup-face)))
`(markdown-strike-through-face ((,class :strike-through t)))
- `(markdown-table-face ((,class ,@(modus-themes--mixed-fonts)
+ `(markdown-table-face ((,class :inherit modus-themes-fixed-pitch
:foreground ,fg-special-cold)))
`(markdown-url-face ((,class :foreground ,blue-alt)))
;;;;; markup-faces (`adoc-mode')
- `(markup-anchor-face ((,class :foreground ,fg-inactive)))
- `(markup-attribute-face ((,class :inherit italic :foreground
,fg-inactive)))
- `(markup-big-face ((,class :height 1.3 :foreground ,blue-nuanced-fg)))
+ `(markup-attribute-face ((,class :inherit (italic markup-meta-face))))
`(markup-bold-face ((,class :inherit bold :foreground ,red-nuanced-fg)))
- `(markup-code-face ((,class :inherit fixed-pitch :foreground ,magenta)))
- `(markup-command-face ((,class :foreground ,fg-inactive)))
+ `(markup-code-face ((,class :foreground ,magenta)))
`(markup-comment-face ((,class :inherit font-lock-comment-face)))
- `(markup-complex-replacement-face ((,class :box (:line-width 2 :color nil
:style released-button)
- :inherit
modus-themes-refine-magenta)))
- `(markup-emphasis-face ((,class :inherit italic :foreground
,fg-special-cold)))
- `(markup-error-face ((,class :inherit bold :foreground ,red)))
+ `(markup-complex-replacement-face ((,class :background ,magenta-nuanced-bg
+ :foreground ,magenta-alt-other
+ :underline ,magenta-alt-other)))
+ `(markup-emphasis-face ((,class :inherit markup-italic-face)))
+ `(markup-error-face ((,class :inherit error)))
`(markup-gen-face ((,class :foreground ,magenta-alt)))
- `(markup-internal-reference-face ((,class :inherit button :foreground
,fg-alt)))
+ `(markup-internal-reference-face ((,class :foreground ,fg-alt :underline
,bg-region)))
`(markup-italic-face ((,class :inherit italic :foreground
,fg-special-cold)))
- `(markup-list-face ((,class :inherit modus-themes-special-calm)))
- `(markup-meta-face ((,class :foreground ,fg-inactive)))
- `(markup-meta-hide-face ((,class :inherit shadow)))
- `(markup-passthrough-face ((,class :inherit fixed-pitch :foreground
,cyan)))
- `(markup-preprocessor-face ((,class :foreground ,red-alt-other)))
- `(markup-replacement-face ((,class :foreground ,yellow-alt-other)))
- `(markup-secondary-text-face ((,class :height 0.8 :foreground
,magenta-nuanced-fg)))
- `(markup-small-face ((,class :height 0.8 :foreground ,fg-main)))
- `(markup-strong-face ((,class :inherit bold :foreground ,red-nuanced-fg)))
- `(markup-subscript-face ((,class :height 0.8 :foreground
,fg-special-cold)))
- `(markup-superscript-face ((,class :height 0.8 :foreground
,fg-special-cold)))
- `(markup-table-cell-face ((,class :inherit modus-themes-special-cold)))
- `(markup-table-face ((,class :inherit modus-themes-subtle-cyan)))
- `(markup-table-row-face ((,class :inherit modus-themes-subtle-cyan)))
- `(markup-title-0-face ((,class :height 3.0 :foreground ,blue-nuanced-fg)))
- `(markup-title-1-face ((,class :height 2.4 :foreground ,blue-nuanced-fg)))
- `(markup-title-2-face ((,class :height 1.8 :foreground ,blue-nuanced-fg)))
- `(markup-title-3-face ((,class :height 1.4 :foreground ,blue-nuanced-fg)))
- `(markup-title-4-face ((,class :height 1.2 :foreground ,blue-nuanced-fg)))
- `(markup-title-5-face ((,class :height 1.2 :foreground ,blue-nuanced-fg
:underline t)))
- `(markup-value-face ((,class :foreground ,fg-inactive)))
- `(markup-verbatim-face ((,class :inherit modus-themes-special-mild)))
+ `(markup-list-face ((,class :inherit modus-themes-special-cold)))
+ `(markup-meta-face ((,class :inherit shadow)))
+ `(markup-meta-hide-face ((,class :foreground "gray50")))
+ `(markup-reference-face ((,class :foreground ,blue-alt :underline
,bg-region)))
+ `(markup-replacement-face ((,class :inherit fixed-pitch :foreground
,red-alt)))
+ `(markup-secondary-text-face ((,class :height 0.9 :foreground
,cyan-alt-other)))
+ `(markup-small-face ((,class :inherit markup-gen-face :height 0.9)))
+ `(markup-strong-face ((,class :inherit markup-bold-face)))
+ `(markup-subscript-face ((,class :height 0.9 :foreground
,magenta-alt-other)))
+ `(markup-superscript-face ((,class :height 0.9 :foreground
,magenta-alt-other)))
+ `(markup-table-cell-face ((,class :inherit modus-themes-subtle-neutral)))
+ `(markup-table-face ((,class :inherit modus-themes-subtle-neutral)))
+ `(markup-table-row-face ((,class :inherit modus-themes-special-cold)))
+ `(markup-title-0-face ((,class :inherit (bold modus-themes-variable-pitch)
+ :foreground ,blue-nuanced-fg
+ ,@(modus-themes--scale
modus-themes-scale-title))))
+ `(markup-title-1-face ((,class :inherit (bold modus-themes-variable-pitch)
+ :foreground ,blue-nuanced-fg
+ ,@(modus-themes--scale
modus-themes-scale-1))))
+ `(markup-title-2-face ((,class :inherit (bold modus-themes-variable-pitch)
+ :foreground ,blue-nuanced-fg
+ ,@(modus-themes--scale
modus-themes-scale-2))))
+ `(markup-title-3-face ((,class :inherit (bold modus-themes-variable-pitch)
+ :foreground ,blue-nuanced-fg
+ ,@(modus-themes--scale
modus-themes-scale-3))))
+ `(markup-title-4-face ((,class :inherit (bold modus-themes-variable-pitch)
+ :foreground ,blue-nuanced-fg
+ ,@(modus-themes--scale
modus-themes-scale-4))))
+ `(markup-title-5-face ((,class :inherit (bold modus-themes-variable-pitch)
+ :foreground ,blue-nuanced-fg)))
+ `(markup-verbatim-face ((,class :background ,bg-alt)))
;;;;; mentor
`(mentor-download-message ((,class :foreground ,fg-special-warm)))
`(mentor-download-name ((,class :foreground ,fg-special-cold)))
@@ -5548,39 +6414,41 @@ by virtue of calling either of
`modus-themes-load-operandi' and
yellow yellow-nuanced-bg
yellow-refine-bg yellow-refine-fg))))
;;;;; org
- `(org-agenda-calendar-event ((,class :foreground ,fg-main)))
- `(org-agenda-calendar-sexp ((,class :foreground ,cyan-alt)))
+ `(org-agenda-calendar-event ((,class :inherit shadow)))
+ `(org-agenda-calendar-sexp ((,class :inherit (modus-themes-slant shadow))))
`(org-agenda-clocking ((,class :inherit modus-themes-special-cold :extend
t)))
`(org-agenda-column-dateline ((,class :background ,bg-alt)))
- `(org-agenda-current-time ((,class :inherit bold :foreground
,blue-alt-other)))
- `(org-agenda-date ((,class :foreground ,cyan)))
- `(org-agenda-date-today ((,class :inherit bold :foreground ,fg-main
:underline t)))
- `(org-agenda-date-weekend ((,class :foreground ,cyan-alt-other)))
- `(org-agenda-diary ((,class :foreground ,fg-main)))
- `(org-agenda-dimmed-todo-face ((,class :inherit bold :foreground ,fg-alt)))
- `(org-agenda-done ((,class :foreground ,green-alt)))
- `(org-agenda-filter-category ((,class :inherit bold :foreground
,magenta-active)))
- `(org-agenda-filter-effort ((,class :inherit bold :foreground
,magenta-active)))
- `(org-agenda-filter-regexp ((,class :inherit bold :foreground
,magenta-active)))
- `(org-agenda-filter-tags ((,class :inherit bold :foreground
,magenta-active)))
+ `(org-agenda-current-time ((,class :foreground ,blue-alt-other-faint)))
+ `(org-agenda-date ((,class ,@(modus-themes--agenda-date cyan fg-main
nil))))
+ `(org-agenda-date-today ((,class :background ,bg-active
+ ,@(modus-themes--agenda-date blue-active
fg-main t cyan-active))))
+ `(org-agenda-date-weekend ((,class ,@(modus-themes--agenda-date
cyan-alt-other fg-alt nil cyan fg-main))))
+ `(org-agenda-diary ((,class :inherit shadow)))
+ `(org-agenda-dimmed-todo-face ((,class :inherit shadow)))
+ `(org-agenda-done ((,class :foreground ,@(modus-themes--success-deuteran
+ blue-nuanced-fg
+ green-nuanced-fg))))
+ `(org-agenda-filter-category ((,class :inherit bold :foreground
,cyan-active)))
+ `(org-agenda-filter-effort ((,class :inherit bold :foreground
,cyan-active)))
+ `(org-agenda-filter-regexp ((,class :inherit bold :foreground
,cyan-active)))
+ `(org-agenda-filter-tags ((,class :inherit bold :foreground ,cyan-active)))
`(org-agenda-restriction-lock ((,class :background ,bg-dim :foreground
,fg-dim)))
- `(org-agenda-structure ((,class ,@(modus-themes--scale
modus-themes-scale-5)
- :foreground ,blue-alt)))
+ `(org-agenda-structure ((,class ,@(modus-themes--agenda-structure
blue-alt))))
`(org-archived ((,class :background ,bg-alt :foreground ,fg-alt)))
- `(org-block ((,class ,@(modus-themes--mixed-fonts)
+ `(org-block ((,class :inherit modus-themes-fixed-pitch
,@(modus-themes--org-block bg-dim fg-main))))
- `(org-block-begin-line ((,class ,@(modus-themes--mixed-fonts)
+ `(org-block-begin-line ((,class :inherit modus-themes-fixed-pitch
,@(modus-themes--org-block-delim
bg-dim fg-special-cold
- bg-alt fg-special-mild))))
+ bg-alt fg-alt))))
`(org-block-end-line ((,class :inherit org-block-begin-line)))
`(org-checkbox ((,class :box (:line-width 1 :color ,bg-active)
:background ,bg-inactive :foreground ,fg-active)))
`(org-checkbox-statistics-done ((,class :inherit org-done)))
`(org-checkbox-statistics-todo ((,class :inherit org-todo)))
`(org-clock-overlay ((,class :inherit modus-themes-special-cold)))
- `(org-code ((,class ,@(modus-themes--mixed-fonts)
- :background ,magenta-nuanced-bg :foreground
,magenta-nuanced-fg)))
+ `(org-code ((,class :inherit modus-themes-fixed-pitch
+ :background ,bg-alt :foreground ,fg-special-mild)))
`(org-column ((,class :background ,bg-alt)))
`(org-column-title ((,class :inherit bold :underline t :background
,bg-alt)))
`(org-date ((,class :inherit ,(if modus-themes-no-mixed-fonts
@@ -5591,51 +6459,52 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(org-date-selected ((,class :inherit bold :foreground ,blue-alt
:inverse-video t)))
`(org-dispatcher-highlight ((,class :inherit (bold
modus-themes-mark-alt))))
`(org-document-info ((,class :foreground ,fg-special-cold)))
- `(org-document-info-keyword ((,class ,@(modus-themes--mixed-fonts)
- :foreground ,fg-alt)))
+ `(org-document-info-keyword ((,class :inherit modus-themes-fixed-pitch
:foreground ,fg-alt)))
`(org-document-title ((,class :inherit (bold modus-themes-variable-pitch)
:foreground ,fg-special-cold
- ,@(modus-themes--scale
modus-themes-scale-5))))
+ ,@(modus-themes--scale
modus-themes-scale-title))))
`(org-done ((,class :foreground ,@(modus-themes--success-deuteran blue
green))))
- `(org-drawer ((,class ,@(modus-themes--mixed-fonts)
- :foreground ,fg-alt)))
+ `(org-drawer ((,class :inherit modus-themes-fixed-pitch :foreground
,fg-alt)))
`(org-ellipsis (())) ; inherits from the heading's color
`(org-footnote ((,class :inherit button
,@(modus-themes--link-color
blue-alt blue-alt-faint))))
- `(org-formula ((,class ,@(modus-themes--mixed-fonts)
- :foreground ,red-alt)))
- `(org-habit-alert-face ((,class ,@(modus-themes--org-habit
+ `(org-formula ((,class :inherit modus-themes-fixed-pitch :foreground
,red-alt)))
+ `(org-habit-alert-face ((,class ,@(modus-themes--agenda-habit
yellow-graph-0-bg
yellow-graph-0-bg
yellow-graph-1-bg))))
- `(org-habit-alert-future-face ((,class ,@(modus-themes--org-habit
+ `(org-habit-alert-future-face ((,class ,@(modus-themes--agenda-habit
yellow-graph-1-bg
yellow-graph-0-bg
yellow-graph-1-bg))))
- `(org-habit-clear-face ((,class ,@(modus-themes--org-habit
+ `(org-habit-clear-face ((,class ,@(modus-themes--agenda-habit
blue-graph-0-bg
green-graph-1-bg
+ blue-graph-1-bg
blue-graph-1-bg))))
- `(org-habit-clear-future-face ((,class ,@(modus-themes--org-habit
+ `(org-habit-clear-future-face ((,class ,@(modus-themes--agenda-habit
blue-graph-1-bg
green-graph-1-bg
+ blue-graph-1-bg
blue-graph-1-bg))))
- `(org-habit-overdue-face ((,class ,@(modus-themes--org-habit
+ `(org-habit-overdue-face ((,class ,@(modus-themes--agenda-habit
red-graph-0-bg
red-graph-0-bg
red-graph-1-bg))))
- `(org-habit-overdue-future-face ((,class ,@(modus-themes--org-habit
+ `(org-habit-overdue-future-face ((,class ,@(modus-themes--agenda-habit
red-graph-1-bg
red-graph-0-bg
red-graph-1-bg))))
- `(org-habit-ready-face ((,class ,@(modus-themes--org-habit
+ `(org-habit-ready-face ((,class ,@(modus-themes--agenda-habit
green-graph-0-bg
green-graph-0-bg
- green-graph-1-bg))))
- `(org-habit-ready-future-face ((,class ,@(modus-themes--org-habit
+ green-graph-1-bg
+ blue-graph-0-bg))))
+ `(org-habit-ready-future-face ((,class ,@(modus-themes--agenda-habit
green-graph-1-bg
green-graph-0-bg
- green-graph-1-bg))))
+ green-graph-1-bg
+ blue-graph-0-bg))))
`(org-headline-done ((,class :inherit modus-themes-variable-pitch
:foreground ,@(modus-themes--success-deuteran
blue-nuanced-fg
@@ -5654,23 +6523,20 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(org-level-8 ((,class :inherit modus-themes-heading-8)))
`(org-link ((,class :inherit button)))
`(org-list-dt ((,class :inherit bold)))
- `(org-macro ((,class ,@(modus-themes--mixed-fonts)
+ `(org-macro ((,class :inherit modus-themes-fixed-pitch
:background ,cyan-nuanced-bg :foreground
,cyan-nuanced-fg)))
- `(org-meta-line ((,class ,@(modus-themes--mixed-fonts) :foreground
,fg-alt)))
+ `(org-meta-line ((,class :inherit modus-themes-fixed-pitch :foreground
,fg-alt)))
`(org-mode-line-clock ((,class :foreground ,fg-main)))
- `(org-mode-line-clock-overrun ((,class :inherit modus-themes-active-red)))
+ `(org-mode-line-clock-overrun ((,class :inherit bold :foreground
,red-active)))
`(org-priority ((,class :foreground ,magenta)))
- `(org-property-value ((,class ,@(modus-themes--mixed-fonts)
- :foreground ,fg-special-cold)))
+ `(org-property-value ((,class :inherit modus-themes-fixed-pitch
:foreground ,fg-special-cold)))
`(org-quote ((,class ,@(modus-themes--org-block bg-dim fg-special-cold
fg-main))))
- `(org-scheduled ((,class :foreground ,magenta-alt)))
- `(org-scheduled-previously ((,class :foreground ,yellow-alt-other)))
- `(org-scheduled-today ((,class :foreground ,magenta-alt-other)))
+ `(org-scheduled ((,class ,@(modus-themes--agenda-scheduled yellow-faint
fg-special-warm magenta-alt))))
+ `(org-scheduled-previously ((,class ,@(modus-themes--agenda-scheduled
yellow fg-special-warm yellow-alt-other))))
+ `(org-scheduled-today ((,class ,@(modus-themes--agenda-scheduled yellow
fg-special-warm magenta-alt-other))))
`(org-sexp-date ((,class :inherit org-date)))
- `(org-special-keyword ((,class ,@(modus-themes--mixed-fonts)
- :foreground ,fg-alt)))
- `(org-table ((,class ,@(modus-themes--mixed-fonts)
- :foreground ,fg-special-cold)))
+ `(org-special-keyword ((,class :inherit modus-themes-fixed-pitch
:foreground ,fg-alt)))
+ `(org-table ((,class :inherit modus-themes-fixed-pitch :foreground
,fg-special-cold)))
`(org-table-header ((,class :inherit (fixed-pitch
modus-themes-intense-neutral))))
`(org-tag ((,class :foreground ,magenta-nuanced-fg)))
`(org-tag-group ((,class :inherit bold :foreground ,cyan-nuanced-fg)))
@@ -5678,8 +6544,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(org-time-grid ((,class :foreground ,fg-unfocused)))
`(org-todo ((,class :foreground ,red)))
`(org-upcoming-deadline ((,class :foreground ,red-alt-other)))
- `(org-upcoming-distant-deadline ((,class :foreground ,red-nuanced-fg)))
- `(org-verbatim ((,class ,@(modus-themes--mixed-fonts)
+ `(org-upcoming-distant-deadline ((,class :foreground ,red-faint)))
+ `(org-verbatim ((,class :inherit modus-themes-fixed-pitch
:background ,bg-alt :foreground ,fg-special-calm)))
`(org-verse ((,class :inherit org-quote)))
`(org-warning ((,class :inherit bold :foreground ,red-alt-other)))
@@ -5719,7 +6585,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(org-tree-slide-header-overlay-face
((,class :inherit (bold modus-themes-variable-pitch) :background ,bg-main
:foreground ,fg-special-cold :overline nil
- ,@(modus-themes--scale modus-themes-scale-5))))
+ ,@(modus-themes--scale modus-themes-scale-title))))
;;;;; org-treescope
`(org-treescope-faces--markerinternal-midday ((,class :inherit
modus-themes-intense-blue)))
`(org-treescope-faces--markerinternal-range ((,class :inherit
modus-themes-special-mild)))
@@ -5736,7 +6602,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(outline-7 ((,class :inherit modus-themes-heading-7)))
`(outline-8 ((,class :inherit modus-themes-heading-8)))
;;;;; outline-minor-faces
- `(outline-minor-0 ((,class :background ,bg-alt)))
+ `(outline-minor-0 (()))
;;;;; package (M-x list-packages)
`(package-description ((,class :foreground ,fg-special-cold)))
`(package-help-section-name ((,class :inherit bold :foreground
,magenta-alt-other)))
@@ -5845,6 +6711,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(prodigy-green-face ((,class :foreground ,green)))
`(prodigy-red-face ((,class :foreground ,red)))
`(prodigy-yellow-face ((,class :foreground ,yellow)))
+;;;;; pulse
+ `(pulse-highlight-start-face ((,class :background ,bg-active-accent
:extend t)))
;;;;; quick-peek
`(quick-peek-background-face ((,class :background ,bg-alt)))
`(quick-peek-border-face ((,class :background ,fg-window-divider-inner
:height 1)))
@@ -5911,7 +6779,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(rcirc-nick-in-message ((,class :foreground ,magenta-alt-other)))
`(rcirc-nick-in-message-full-line ((,class :inherit bold :foreground
,fg-special-mild)))
`(rcirc-other-nick ((,class :inherit bold :foreground ,fg-special-cold)))
- `(rcirc-prompt ((,class :inherit comint-highlight-prompt)))
+ `(rcirc-prompt ((,class :inherit modus-themes-prompt)))
`(rcirc-server ((,class :foreground ,fg-unfocused)))
`(rcirc-timestamp ((,class :foreground ,blue-nuanced-fg)))
`(rcirc-url ((,class :foreground ,blue :underline t)))
@@ -5997,6 +6865,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
:background ,@(pcase modus-themes-completions
('opinionated (list bg-active))
(_ (list bg-inactive))))))
+ `(selectrum-mouse-highlight ((,class :inherit highlight)))
`(selectrum-primary-highlight
((,class :inherit bold
,@(modus-themes--standard-completions
@@ -6053,6 +6922,12 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(show-paren-match-expression ((,class :background ,bg-paren-expression)))
`(show-paren-mismatch ((,class :inherit modus-themes-intense-red)))
;;;;; shr
+ `(shr-h1 ((,class :inherit modus-themes-heading-1)))
+ `(shr-h2 ((,class :inherit modus-themes-heading-2)))
+ `(shr-h3 ((,class :inherit modus-themes-heading-3)))
+ `(shr-h4 ((,class :inherit modus-themes-heading-4)))
+ `(shr-h5 ((,class :inherit modus-themes-heading-5)))
+ `(shr-h6 ((,class :inherit modus-themes-heading-6)))
`(shr-abbreviation ((,class :inherit modus-themes-lang-note)))
`(shr-selected-link ((,class :inherit modus-themes-subtle-red)))
;;;;; side-notes
@@ -6309,8 +7184,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(tomatinho-reset-face ((,class :inherit shadow)))
;;;;; transient
`(transient-active-infix ((,class :inherit modus-themes-special-mild)))
- `(transient-amaranth ((,class :inherit bold :foreground ,yellow)))
- `(transient-argument ((,class :inherit bold :foreground ,red-alt)))
+ `(transient-amaranth ((,class :inherit bold :foreground ,yellow-alt)))
+ `(transient-argument ((,class :inherit bold :foreground ,green)))
`(transient-blue ((,class :inherit bold :foreground ,blue)))
`(transient-disabled-suffix ((,class :inherit modus-themes-intense-red)))
`(transient-enabled-suffix ((,class :inherit
,@(modus-themes--success-deuteran
@@ -6322,8 +7197,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(transient-key ((,class :inherit modus-themes-key-binding)))
`(transient-mismatched-key ((,class :underline t)))
`(transient-nonstandard-key ((,class :underline t)))
- `(transient-pink ((,class :inherit bold :foreground ,magenta)))
- `(transient-red ((,class :inherit bold :foreground ,red-intense)))
+ `(transient-pink ((,class :inherit bold :foreground ,magenta-alt-faint)))
+ `(transient-red ((,class :inherit bold :foreground ,red-faint)))
`(transient-teal ((,class :inherit bold :foreground ,cyan-alt-other)))
`(transient-unreachable ((,class :foreground ,fg-unfocused)))
`(transient-unreachable-key ((,class :foreground ,fg-unfocused)))
@@ -6560,7 +7435,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(whitespace-empty ((,class :inherit modus-themes-intense-magenta)))
`(whitespace-hspace ((,class :background ,bg-whitespace :foreground
,fg-whitespace)))
`(whitespace-indentation ((,class :background ,bg-whitespace :foreground
,fg-whitespace)))
- `(whitespace-line ((,class :background ,bg-alt)))
+ `(whitespace-line ((,class :inherit modus-themes-subtle-yellow)))
`(whitespace-newline ((,class :background ,bg-whitespace :foreground
,fg-whitespace)))
`(whitespace-space ((,class :background ,bg-whitespace :foreground
,fg-whitespace)))
`(whitespace-space-after-tab ((,class :inherit
modus-themes-subtle-magenta)))
diff --git a/etc/themes/modus-vivendi-theme.el
b/etc/themes/modus-vivendi-theme.el
index fa8ba21..6ff359d 100644
--- a/etc/themes/modus-vivendi-theme.el
+++ b/etc/themes/modus-vivendi-theme.el
@@ -4,7 +4,7 @@
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://gitlab.com/protesilaos/modus-themes
-;; Version: 1.4.0
+;; Version: 1.5.0
;; Package-Requires: ((emacs "26.1"))
;; Keywords: faces, theme, accessibility
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 12ced4a..8346524 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -80,6 +80,9 @@ char *w32_getenv (const char *);
#include <sys/stat.h>
#include <unistd.h>
+#ifndef WINDOWSNT
+# include <acl.h>
+#endif
#include <filename.h>
#include <intprops.h>
#include <min-max.h>
@@ -91,6 +94,10 @@ char *w32_getenv (const char *);
# pragma GCC diagnostic ignored "-Wformat-truncation=2"
#endif
+#if !defined O_PATH && !defined WINDOWSNT
+# define O_PATH O_SEARCH
+#endif
+
/* Name used to invoke this program. */
static char const *progname;
@@ -1128,24 +1135,74 @@ process_grouping (void)
#ifdef SOCKETS_IN_FILE_SYSTEM
-/* Return the file status of NAME, ordinarily a socket.
- It should be owned by UID. Return one of the following:
- >0 - 'stat' failed with this errno value
- -1 - isn't owned by us
- 0 - success: none of the above */
+/* A local socket address. The union avoids the need to cast. */
+union local_sockaddr
+{
+ struct sockaddr_un un;
+ struct sockaddr sa;
+};
+
+/* Relative to the directory DIRFD, connect the socket file named ADDR
+ to the socket S. Return 0 if successful, -1 if DIRFD is not
+ AT_FDCWD and DIRFD's permissions would allow a symlink attack, an
+ errno otherwise. */
static int
-socket_status (const char *name, uid_t uid)
+connect_socket (int dirfd, char const *addr, int s, uid_t uid)
{
- struct stat statbfr;
+ int sock_status = 0;
- if (stat (name, &statbfr) != 0)
- return errno;
+ union local_sockaddr server;
+ if (sizeof server.un.sun_path <= strlen (addr))
+ return ENAMETOOLONG;
+ server.un.sun_family = AF_UNIX;
+ strcpy (server.un.sun_path, addr);
- if (statbfr.st_uid != uid)
- return -1;
+ /* If -1, WDFD is not set yet. If nonnegative, WDFD is a file
+ descriptor for the initial working directory. Otherwise -1 - WDFD is
+ the error number for the initial working directory. */
+ static int wdfd = -1;
- return 0;
+ if (dirfd != AT_FDCWD)
+ {
+ /* Fail if DIRFD's permissions are bogus. */
+ struct stat st;
+ if (fstat (dirfd, &st) != 0)
+ return errno;
+ if (st.st_uid != uid || (st.st_mode & (S_IWGRP | S_IWOTH)))
+ return -1;
+
+ if (wdfd == -1)
+ {
+ /* Save the initial working directory. */
+ wdfd = open (".", O_PATH | O_CLOEXEC);
+ if (wdfd < 0)
+ wdfd = -1 - errno;
+ }
+ if (wdfd < 0)
+ return -1 - wdfd;
+ if (fchdir (dirfd) != 0)
+ return errno;
+
+ /* Fail if DIRFD has an ACL, which means its permissions are
+ almost surely bogus. */
+ int has_acl = file_has_acl (".", &st);
+ if (has_acl)
+ sock_status = has_acl < 0 ? errno : -1;
+ }
+
+ if (!sock_status)
+ sock_status = connect (s, &server.sa, sizeof server.un) == 0 ? 0 : errno;
+
+ /* Fail immediately if we cannot change back to the initial working
+ directory, as that can mess up the rest of execution. */
+ if (dirfd != AT_FDCWD && fchdir (wdfd) != 0)
+ {
+ message (true, "%s: .: %s\n", progname, strerror (errno));
+ exit (EXIT_FAILURE);
+ }
+
+ return sock_status;
}
@@ -1322,32 +1379,49 @@ act_on_signals (HSOCKET emacs_socket)
}
}
-/* Create in SOCKNAME (of size SOCKNAMESIZE) a name for a local socket.
- The first TMPDIRLEN bytes of SOCKNAME are already initialized to be
- the name of a temporary directory. Use UID and SERVER_NAME to
- concoct the name. Return the total length of the name if successful,
- -1 if it does not fit (and store a truncated name in that case).
- Fail if TMPDIRLEN is out of range. */
+enum { socknamesize = sizeof ((struct sockaddr_un *) NULL)->sun_path };
+
+/* Given a local socket S, create in *SOCKNAME a name for a local socket
+ and connect to that socket. The first TMPDIRLEN bytes of *SOCKNAME are
+ already initialized to be the name of a temporary directory.
+ Use UID and SERVER_NAME to concoct the name. Return 0 if
+ successful, -1 if the socket's parent directory is not safe, and an
+ errno if there is some other problem. */
static int
-local_sockname (char *sockname, int socknamesize, int tmpdirlen,
- uintmax_t uid, char const *server_name)
+local_sockname (int s, char sockname[socknamesize], int tmpdirlen,
+ uid_t uid, char const *server_name)
{
/* If ! (0 <= TMPDIRLEN && TMPDIRLEN < SOCKNAMESIZE) the truncated
temporary directory name is already in SOCKNAME, so nothing more
need be stored. */
- if (0 <= tmpdirlen)
- {
- int remaining = socknamesize - tmpdirlen;
- if (0 < remaining)
- {
- int suffixlen = snprintf (&sockname[tmpdirlen], remaining,
- "/emacs%"PRIuMAX"/%s", uid, server_name);
- if (0 <= suffixlen && suffixlen < remaining)
- return tmpdirlen + suffixlen;
- }
- }
- return -1;
+ if (! (0 <= tmpdirlen && tmpdirlen < socknamesize))
+ return ENAMETOOLONG;
+
+ /* Put the full address name into the buffer, since the caller might
+ need it for diagnostics. But don't overrun the buffer. */
+ uintmax_t uidmax = uid;
+ int emacsdirlen;
+ int suffixlen = snprintf (sockname + tmpdirlen, socknamesize - tmpdirlen,
+ "/emacs%"PRIuMAX"%n/%s", uidmax, &emacsdirlen,
+ server_name);
+ if (! (0 <= suffixlen && suffixlen < socknamesize - tmpdirlen))
+ return ENAMETOOLONG;
+
+ /* Make sure the address's parent directory is not a symlink and is
+ 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 + emacsdirlen;
+ *emacsdirend = '\0';
+ int dir = openat (AT_FDCWD, sockname,
+ O_PATH | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC);
+ *emacsdirend = '/';
+ if (dir < 0)
+ return errno;
+ int sock_status = connect_socket (dir, server_name, s, uid);
+ close (dir);
+ return sock_status;
}
/* Create a local socket for SERVER_NAME and connect it to Emacs. If
@@ -1358,28 +1432,43 @@ local_sockname (char *sockname, int socknamesize, int
tmpdirlen,
static HSOCKET
set_local_socket (char const *server_name)
{
- union {
- struct sockaddr_un un;
- struct sockaddr sa;
- } server = {{ .sun_family = AF_UNIX }};
+ union local_sockaddr server;
+ int sock_status;
char *sockname = server.un.sun_path;
- enum { socknamesize = sizeof server.un.sun_path };
int tmpdirlen = -1;
int socknamelen = -1;
uid_t uid = geteuid ();
bool tmpdir_used = false;
+ int s = cloexec_socket (AF_UNIX, SOCK_STREAM, 0);
+ if (s < 0)
+ {
+ message (true, "%s: can't create socket: %s\n",
+ progname, strerror (errno));
+ fail ();
+ }
if (strchr (server_name, '/')
|| (ISSLASH ('\\') && strchr (server_name, '\\')))
- socknamelen = snprintf (sockname, socknamesize, "%s", server_name);
+ {
+ socknamelen = snprintf (sockname, socknamesize, "%s", server_name);
+ sock_status = (0 <= socknamelen && socknamelen < socknamesize
+ ? connect_socket (AT_FDCWD, sockname, s, 0)
+ : ENAMETOOLONG);
+ }
else
{
/* socket_name is a file name component. */
+ sock_status = ENOENT;
char const *xdg_runtime_dir = egetenv ("XDG_RUNTIME_DIR");
if (xdg_runtime_dir)
- socknamelen = snprintf (sockname, socknamesize, "%s/emacs/%s",
- xdg_runtime_dir, server_name);
- else
+ {
+ socknamelen = snprintf (sockname, socknamesize, "%s/emacs/%s",
+ xdg_runtime_dir, server_name);
+ sock_status = (0 <= socknamelen && socknamelen < socknamesize
+ ? connect_socket (AT_FDCWD, sockname, s, 0)
+ : ENAMETOOLONG);
+ }
+ if (sock_status == ENOENT)
{
char const *tmpdir = egetenv ("TMPDIR");
if (tmpdir)
@@ -1398,23 +1487,24 @@ set_local_socket (char const *server_name)
if (tmpdirlen < 0)
tmpdirlen = snprintf (sockname, socknamesize, "/tmp");
}
- socknamelen = local_sockname (sockname, socknamesize, tmpdirlen,
+ sock_status = local_sockname (s, sockname, tmpdirlen,
uid, server_name);
tmpdir_used = true;
}
}
- if (! (0 <= socknamelen && socknamelen < socknamesize))
+ if (sock_status == 0)
+ return s;
+
+ if (sock_status == ENAMETOOLONG)
{
message (true, "%s: socket-name %s... too long\n", progname, sockname);
fail ();
}
- /* See if the socket exists, and if it's owned by us. */
- int sock_status = socket_status (sockname, uid);
- if (sock_status)
+ if (tmpdir_used)
{
- /* Failing that, see if LOGNAME or USER exist and differ from
+ /* See whether LOGNAME or USER exist and differ from
our euid. If so, look for a socket based on the UID
associated with the name. This is reminiscent of the logic
that init_editfns uses to set the global Vuser_full_name. */
@@ -1431,48 +1521,26 @@ set_local_socket (char const *server_name)
if (pw && pw->pw_uid != uid)
{
/* We're running under su, apparently. */
- socknamelen = local_sockname (sockname, socknamesize, tmpdirlen,
+ sock_status = local_sockname (s, sockname, tmpdirlen,
pw->pw_uid, server_name);
- if (socknamelen < 0)
+ if (sock_status == 0)
+ return s;
+ if (sock_status == ENAMETOOLONG)
{
message (true, "%s: socket-name %s... too long\n",
progname, sockname);
exit (EXIT_FAILURE);
}
-
- sock_status = socket_status (sockname, uid);
}
}
}
- if (sock_status == 0)
- {
- HSOCKET s = cloexec_socket (AF_UNIX, SOCK_STREAM, 0);
- if (s < 0)
- {
- message (true, "%s: socket: %s\n", progname, strerror (errno));
- return INVALID_SOCKET;
- }
- if (connect (s, &server.sa, sizeof server.un) != 0)
- {
- message (true, "%s: connect: %s\n", progname, strerror (errno));
- CLOSE_SOCKET (s);
- return INVALID_SOCKET;
- }
+ close (s);
- struct stat connect_stat;
- if (fstat (s, &connect_stat) != 0)
- sock_status = errno;
- else if (connect_stat.st_uid == uid)
- return s;
- else
- sock_status = -1;
-
- CLOSE_SOCKET (s);
- }
-
- if (sock_status < 0)
- message (true, "%s: Invalid socket owner\n", progname);
+ if (sock_status == -1)
+ message (true,
+ "%s: Invalid permissions on parent directory of socket: %s\n",
+ progname, sockname);
else if (sock_status == ENOENT)
{
if (tmpdir_used)
@@ -1502,7 +1570,7 @@ set_local_socket (char const *server_name)
}
}
else
- message (true, "%s: can't stat %s: %s\n",
+ message (true, "%s: can't connect to %s: %s\n",
progname, sockname, strerror (sock_status));
return INVALID_SOCKET;
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 72498bb..ae39fc4 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -340,7 +340,6 @@ typedef struct regexp
struct re_pattern_buffer *pat; /* the compiled pattern */
struct re_registers regs; /* re registers */
bool error_signaled; /* already signaled for this regexp */
- bool force_explicit_name; /* do not allow implicit tag name */
bool ignore_case; /* ignore case when matching */
bool multi_line; /* do a multi-line match on the whole file */
} regexp;
@@ -6911,7 +6910,6 @@ add_regex (char *regexp_pattern, language *lang)
struct re_pattern_buffer *patbuf;
regexp *rp;
bool
- force_explicit_name = true, /* do not use implicit tag names */
ignore_case = false, /* case is significant */
multi_line = false, /* matches are done one line at a time
*/
single_line = false; /* dot does not match newline */
@@ -6950,7 +6948,8 @@ add_regex (char *regexp_pattern, language *lang)
case 'N':
if (modifiers == name)
error ("forcing explicit tag name but no name, ignoring");
- force_explicit_name = true;
+ /* This option has no effect and is present only for backward
+ compatibility. */
break;
case 'i':
ignore_case = true;
@@ -7005,7 +7004,6 @@ add_regex (char *regexp_pattern, language *lang)
p_head->pat = patbuf;
p_head->name = savestr (name);
p_head->error_signaled = false;
- p_head->force_explicit_name = force_explicit_name;
p_head->ignore_case = ignore_case;
p_head->multi_line = multi_line;
}
@@ -7145,20 +7143,15 @@ regex_tag_multiline (void)
name = NULL;
else /* make a named tag */
name = substitute (buffer, rp->name, &rp->regs);
- if (rp->force_explicit_name)
- {
- /* Force explicit tag name, if a name is there. */
- pfnote (name, true, buffer + linecharno,
- charno - linecharno + 1, lineno, linecharno);
-
- if (debug)
- fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n",
- name ? name : "(unnamed)", curfdp->taggedfname,
- lineno, buffer + linecharno);
- }
- else
- make_tag (name, strlen (name), true, buffer + linecharno,
- charno - linecharno + 1, lineno, linecharno);
+
+ /* Force explicit tag name, if a name is there. */
+ pfnote (name, true, buffer + linecharno,
+ charno - linecharno + 1, lineno, linecharno);
+
+ if (debug)
+ fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n",
+ name ? name : "(unnamed)", curfdp->taggedfname,
+ lineno, buffer + linecharno);
break;
}
}
@@ -7472,18 +7465,14 @@ readline (linebuffer *lbp, FILE *stream)
name = NULL;
else /* make a named tag */
name = substitute (lbp->buffer, rp->name, &rp->regs);
- if (rp->force_explicit_name)
- {
- /* Force explicit tag name, if a name is there. */
- pfnote (name, true, lbp->buffer, match, lineno, linecharno);
- if (debug)
- fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n",
- name ? name : "(unnamed)", curfdp->taggedfname,
- lineno, lbp->buffer);
- }
- else
- make_tag (name, strlen (name), true,
- lbp->buffer, match, lineno, linecharno);
+
+ /* Force explicit tag name, if a name is there. */
+ pfnote (name, true, lbp->buffer, match, lineno, linecharno);
+
+ if (debug)
+ fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n",
+ name ? name : "(unnamed)", curfdp->taggedfname,
+ lineno, lbp->buffer);
break;
}
}
diff --git a/lib-src/movemail.c b/lib-src/movemail.c
index cfdebcc..e683da1 100644
--- a/lib-src/movemail.c
+++ b/lib-src/movemail.c
@@ -270,6 +270,7 @@ main (int argc, char **argv)
You might also wish to verify that your system is one which
uses lock files for this purpose. Some systems use other methods. */
+ bool lockname_unlinked = false;
inname_len = strlen (inname);
lockname = xmalloc (inname_len + sizeof ".lock");
strcpy (lockname, inname);
@@ -312,15 +313,10 @@ main (int argc, char **argv)
Five minutes should be good enough to cope with crashes
and wedgitude, and long enough to avoid being fooled
by time differences between machines. */
- if (stat (lockname, &st) >= 0)
- {
- time_t now = time (0);
- if (st.st_ctime < now - 300)
- {
- unlink (lockname);
- lockname = 0;
- }
- }
+ if (!lockname_unlinked
+ && stat (lockname, &st) == 0
+ && st.st_ctime < time (0) - 300)
+ lockname_unlinked = unlink (lockname) == 0 || errno == ENOENT;
}
delete_lockname = lockname;
diff --git a/lib/file-has-acl.c b/lib/file-has-acl.c
new file mode 100644
index 0000000..c667ae9
--- /dev/null
+++ b/lib/file-has-acl.c
@@ -0,0 +1,510 @@
+/* Test whether a file has a nontrivial ACL. -*- coding: utf-8 -*-
+
+ Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+ Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */
+
+/* Without this pragma, gcc 4.7.0 20120126 may suggest that the
+ file_has_acl function might be candidate for attribute 'const' */
+#if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic ignored "-Wsuggest-attribute=const"
+#endif
+
+#include <config.h>
+
+#include "acl.h"
+
+#include "acl-internal.h"
+
+#if GETXATTR_WITH_POSIX_ACLS
+# include <sys/xattr.h>
+# include <linux/xattr.h>
+#endif
+
+/* Return 1 if NAME has a nontrivial access control list,
+ 0 if ACLs are not supported, or if NAME has no or only a base ACL,
+ and -1 (setting errno) on error. Note callers can determine
+ if ACLs are not supported as errno is set in that case also.
+ SB must be set to the stat buffer of NAME,
+ obtained through stat() or lstat(). */
+
+int
+file_has_acl (char const *name, struct stat const *sb)
+{
+#if USE_ACL
+ if (! S_ISLNK (sb->st_mode))
+ {
+
+# if GETXATTR_WITH_POSIX_ACLS
+
+ ssize_t ret;
+
+ ret = getxattr (name, XATTR_NAME_POSIX_ACL_ACCESS, NULL, 0);
+ if (ret < 0 && errno == ENODATA)
+ ret = 0;
+ else if (ret > 0)
+ return 1;
+
+ if (ret == 0 && S_ISDIR (sb->st_mode))
+ {
+ ret = getxattr (name, XATTR_NAME_POSIX_ACL_DEFAULT, NULL, 0);
+ if (ret < 0 && errno == ENODATA)
+ ret = 0;
+ else if (ret > 0)
+ return 1;
+ }
+
+ if (ret < 0)
+ return - acl_errno_valid (errno);
+ return ret;
+
+# elif HAVE_ACL_GET_FILE
+
+ /* POSIX 1003.1e (draft 17 -- abandoned) specific version. */
+ /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */
+ int ret;
+
+ if (HAVE_ACL_EXTENDED_FILE) /* Linux */
+ {
+ /* On Linux, acl_extended_file is an optimized function: It only
+ makes two calls to getxattr(), one for ACL_TYPE_ACCESS, one for
+ ACL_TYPE_DEFAULT. */
+ ret = acl_extended_file (name);
+ }
+ else /* FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */
+ {
+# if HAVE_ACL_TYPE_EXTENDED /* Mac OS X */
+ /* On Mac OS X, acl_get_file (name, ACL_TYPE_ACCESS)
+ and acl_get_file (name, ACL_TYPE_DEFAULT)
+ always return NULL / EINVAL. There is no point in making
+ these two useless calls. The real ACL is retrieved through
+ acl_get_file (name, ACL_TYPE_EXTENDED). */
+ acl_t acl = acl_get_file (name, ACL_TYPE_EXTENDED);
+ if (acl)
+ {
+ ret = acl_extended_nontrivial (acl);
+ acl_free (acl);
+ }
+ else
+ ret = -1;
+# else /* FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */
+ acl_t acl = acl_get_file (name, ACL_TYPE_ACCESS);
+ if (acl)
+ {
+ int saved_errno;
+
+ ret = acl_access_nontrivial (acl);
+ saved_errno = errno;
+ acl_free (acl);
+ errno = saved_errno;
+# if HAVE_ACL_FREE_TEXT /* Tru64 */
+ /* On OSF/1, acl_get_file (name, ACL_TYPE_DEFAULT) always
+ returns NULL with errno not set. There is no point in
+ making this call. */
+# else /* FreeBSD, IRIX, Cygwin >= 2.5 */
+ /* On Linux, FreeBSD, IRIX, acl_get_file (name, ACL_TYPE_ACCESS)
+ and acl_get_file (name, ACL_TYPE_DEFAULT) on a directory
+ either both succeed or both fail; it depends on the
+ file system. Therefore there is no point in making the second
+ call if the first one already failed. */
+ if (ret == 0 && S_ISDIR (sb->st_mode))
+ {
+ acl = acl_get_file (name, ACL_TYPE_DEFAULT);
+ if (acl)
+ {
+# ifdef __CYGWIN__ /* Cygwin >= 2.5 */
+ ret = acl_access_nontrivial (acl);
+ saved_errno = errno;
+ acl_free (acl);
+ errno = saved_errno;
+# else
+ ret = (0 < acl_entries (acl));
+ acl_free (acl);
+# endif
+ }
+ else
+ ret = -1;
+ }
+# endif
+ }
+ else
+ ret = -1;
+# endif
+ }
+ if (ret < 0)
+ return - acl_errno_valid (errno);
+ return ret;
+
+# elif HAVE_FACL && defined GETACL /* Solaris, Cygwin < 2.5, not HP-UX */
+
+# if defined ACL_NO_TRIVIAL
+
+ /* Solaris 10 (newer version), which has additional API declared in
+ <sys/acl.h> (acl_t) and implemented in libsec (acl_set, acl_trivial,
+ acl_fromtext, ...). */
+ return acl_trivial (name);
+
+# else /* Solaris, Cygwin, general case */
+
+ /* Solaris 2.5 through Solaris 10, Cygwin, and contemporaneous versions
+ of Unixware. The acl() call returns the access and default ACL both
+ at once. */
+ {
+ /* Initially, try to read the entries into a stack-allocated buffer.
+ Use malloc if it does not fit. */
+ enum
+ {
+ alloc_init = 4000 / sizeof (aclent_t), /* >= 3 */
+ alloc_max = MIN (INT_MAX, SIZE_MAX / sizeof (aclent_t))
+ };
+ aclent_t buf[alloc_init];
+ size_t alloc = alloc_init;
+ aclent_t *entries = buf;
+ aclent_t *malloced = NULL;
+ int count;
+
+ for (;;)
+ {
+ count = acl (name, GETACL, alloc, entries);
+ if (count < 0 && errno == ENOSPC)
+ {
+ /* Increase the size of the buffer. */
+ free (malloced);
+ if (alloc > alloc_max / 2)
+ {
+ errno = ENOMEM;
+ return -1;
+ }
+ alloc = 2 * alloc; /* <= alloc_max */
+ entries = malloced =
+ (aclent_t *) malloc (alloc * sizeof (aclent_t));
+ if (entries == NULL)
+ {
+ errno = ENOMEM;
+ return -1;
+ }
+ continue;
+ }
+ break;
+ }
+ if (count < 0)
+ {
+ if (errno == ENOSYS || errno == ENOTSUP)
+ ;
+ else
+ {
+ int saved_errno = errno;
+ free (malloced);
+ errno = saved_errno;
+ return -1;
+ }
+ }
+ else if (count == 0)
+ ;
+ else
+ {
+ /* Don't use MIN_ACL_ENTRIES: It's set to 4 on Cygwin, but Cygwin
+ returns only 3 entries for files with no ACL. But this is safe:
+ If there are more than 4 entries, there cannot be only the
+ "user::", "group::", "other:", and "mask:" entries. */
+ if (count > 4)
+ {
+ free (malloced);
+ return 1;
+ }
+
+ if (acl_nontrivial (count, entries))
+ {
+ free (malloced);
+ return 1;
+ }
+ }
+ free (malloced);
+ }
+
+# ifdef ACE_GETACL
+ /* Solaris also has a different variant of ACLs, used in ZFS and NFSv4
+ file systems (whereas the other ones are used in UFS file systems).
*/
+ {
+ /* Initially, try to read the entries into a stack-allocated buffer.
+ Use malloc if it does not fit. */
+ enum
+ {
+ alloc_init = 4000 / sizeof (ace_t), /* >= 3 */
+ alloc_max = MIN (INT_MAX, SIZE_MAX / sizeof (ace_t))
+ };
+ ace_t buf[alloc_init];
+ size_t alloc = alloc_init;
+ ace_t *entries = buf;
+ ace_t *malloced = NULL;
+ int count;
+
+ for (;;)
+ {
+ count = acl (name, ACE_GETACL, alloc, entries);
+ if (count < 0 && errno == ENOSPC)
+ {
+ /* Increase the size of the buffer. */
+ free (malloced);
+ if (alloc > alloc_max / 2)
+ {
+ errno = ENOMEM;
+ return -1;
+ }
+ alloc = 2 * alloc; /* <= alloc_max */
+ entries = malloced = (ace_t *) malloc (alloc * sizeof (ace_t));
+ if (entries == NULL)
+ {
+ errno = ENOMEM;
+ return -1;
+ }
+ continue;
+ }
+ break;
+ }
+ if (count < 0)
+ {
+ if (errno == ENOSYS || errno == EINVAL)
+ ;
+ else
+ {
+ int saved_errno = errno;
+ free (malloced);
+ errno = saved_errno;
+ return -1;
+ }
+ }
+ else if (count == 0)
+ ;
+ else
+ {
+ /* In the old (original Solaris 10) convention:
+ If there are more than 3 entries, there cannot be only the
+ ACE_OWNER, ACE_GROUP, ACE_OTHER entries.
+ In the newer Solaris 10 and Solaris 11 convention:
+ If there are more than 6 entries, there cannot be only the
+ ACE_OWNER, ACE_GROUP, ACE_EVERYONE entries, each once with
+ NEW_ACE_ACCESS_ALLOWED_ACE_TYPE and once with
+ NEW_ACE_ACCESS_DENIED_ACE_TYPE. */
+ if (count > 6)
+ {
+ free (malloced);
+ return 1;
+ }
+
+ if (acl_ace_nontrivial (count, entries))
+ {
+ free (malloced);
+ return 1;
+ }
+ }
+ free (malloced);
+ }
+# endif
+
+ return 0;
+# endif
+
+# elif HAVE_GETACL /* HP-UX */
+
+ {
+ struct acl_entry entries[NACLENTRIES];
+ int count;
+
+ count = getacl (name, NACLENTRIES, entries);
+
+ if (count < 0)
+ {
+ /* ENOSYS is seen on newer HP-UX versions.
+ EOPNOTSUPP is typically seen on NFS mounts.
+ ENOTSUP was seen on Quantum StorNext file systems (cvfs). */
+ if (errno == ENOSYS || errno == EOPNOTSUPP || errno == ENOTSUP)
+ ;
+ else
+ return -1;
+ }
+ else if (count == 0)
+ return 0;
+ else /* count > 0 */
+ {
+ if (count > NACLENTRIES)
+ /* If NACLENTRIES cannot be trusted, use dynamic memory
+ allocation. */
+ abort ();
+
+ /* If there are more than 3 entries, there cannot be only the
+ (uid,%), (%,gid), (%,%) entries. */
+ if (count > 3)
+ return 1;
+
+ {
+ struct stat statbuf;
+
+ if (stat (name, &statbuf) < 0)
+ return -1;
+
+ return acl_nontrivial (count, entries);
+ }
+ }
+ }
+
+# if HAVE_ACLV_H /* HP-UX >= 11.11 */
+
+ {
+ struct acl entries[NACLVENTRIES];
+ int count;
+
+ count = acl ((char *) name, ACL_GET, NACLVENTRIES, entries);
+
+ if (count < 0)
+ {
+ /* EOPNOTSUPP is seen on NFS in HP-UX 11.11, 11.23.
+ EINVAL is seen on NFS in HP-UX 11.31. */
+ if (errno == ENOSYS || errno == EOPNOTSUPP || errno == EINVAL)
+ ;
+ else
+ return -1;
+ }
+ else if (count == 0)
+ return 0;
+ else /* count > 0 */
+ {
+ if (count > NACLVENTRIES)
+ /* If NACLVENTRIES cannot be trusted, use dynamic memory
+ allocation. */
+ abort ();
+
+ /* If there are more than 4 entries, there cannot be only the
+ four base ACL entries. */
+ if (count > 4)
+ return 1;
+
+ return aclv_nontrivial (count, entries);
+ }
+ }
+
+# endif
+
+# elif HAVE_ACLX_GET && defined ACL_AIX_WIP /* AIX */
+
+ acl_type_t type;
+ char aclbuf[1024];
+ void *acl = aclbuf;
+ size_t aclsize = sizeof (aclbuf);
+ mode_t mode;
+
+ for (;;)
+ {
+ /* The docs say that type being 0 is equivalent to ACL_ANY, but it
+ is not true, in AIX 5.3. */
+ type.u64 = ACL_ANY;
+ if (aclx_get (name, 0, &type, aclbuf, &aclsize, &mode) >= 0)
+ break;
+ if (errno == ENOSYS)
+ return 0;
+ if (errno != ENOSPC)
+ {
+ if (acl != aclbuf)
+ {
+ int saved_errno = errno;
+ free (acl);
+ errno = saved_errno;
+ }
+ return -1;
+ }
+ aclsize = 2 * aclsize;
+ if (acl != aclbuf)
+ free (acl);
+ acl = malloc (aclsize);
+ if (acl == NULL)
+ {
+ errno = ENOMEM;
+ return -1;
+ }
+ }
+
+ if (type.u64 == ACL_AIXC)
+ {
+ int result = acl_nontrivial ((struct acl *) acl);
+ if (acl != aclbuf)
+ free (acl);
+ return result;
+ }
+ else if (type.u64 == ACL_NFS4)
+ {
+ int result = acl_nfs4_nontrivial ((nfs4_acl_int_t *) acl);
+ if (acl != aclbuf)
+ free (acl);
+ return result;
+ }
+ else
+ {
+ /* A newer type of ACL has been introduced in the system.
+ We should better support it. */
+ if (acl != aclbuf)
+ free (acl);
+ errno = EINVAL;
+ return -1;
+ }
+
+# elif HAVE_STATACL /* older AIX */
+
+ union { struct acl a; char room[4096]; } u;
+
+ if (statacl ((char *) name, STX_NORMAL, &u.a, sizeof (u)) < 0)
+ return -1;
+
+ return acl_nontrivial (&u.a);
+
+# elif HAVE_ACLSORT /* NonStop Kernel */
+
+ {
+ struct acl entries[NACLENTRIES];
+ int count;
+
+ count = acl ((char *) name, ACL_GET, NACLENTRIES, entries);
+
+ if (count < 0)
+ {
+ if (errno == ENOSYS || errno == ENOTSUP)
+ ;
+ else
+ return -1;
+ }
+ else if (count == 0)
+ return 0;
+ else /* count > 0 */
+ {
+ if (count > NACLENTRIES)
+ /* If NACLENTRIES cannot be trusted, use dynamic memory
+ allocation. */
+ abort ();
+
+ /* If there are more than 4 entries, there cannot be only the
+ four base ACL entries. */
+ if (count > 4)
+ return 1;
+
+ return acl_nontrivial (count, entries);
+ }
+ }
+
+# endif
+ }
+#endif
+
+ return 0;
+}
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 07736f9..0b9aaf6 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -98,6 +98,7 @@
# fcntl \
# fcntl-h \
# fdopendir \
+# file-has-acl \
# filemode \
# filename \
# filevercmp \
@@ -1788,6 +1789,16 @@ EXTRA_libgnu_a_SOURCES += fdopendir.c
endif
## end gnulib module fdopendir
+## begin gnulib module file-has-acl
+ifeq (,$(OMIT_GNULIB_MODULE_file-has-acl))
+
+libgnu_a_SOURCES += file-has-acl.c
+
+EXTRA_DIST += acl-internal.h
+
+endif
+## end gnulib module file-has-acl
+
## begin gnulib module filemode
ifeq (,$(OMIT_GNULIB_MODULE_filemode))
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 44dc035..79dc821 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -75,6 +75,7 @@
;;; Code:
(defvar comint-last-output-start)
+(defvar compilation-filter-start)
;; Customization
@@ -181,6 +182,24 @@ in shell buffers. You set this variable by calling one of:
:group 'ansi-colors
:version "23.2")
+(defcustom ansi-color-for-compilation-mode t
+ "Determines what to do with compilation output.
+If nil, do nothing.
+
+If the symbol `filter', then filter all ANSI graphical control
+sequences.
+
+If anything else (such as t), then translate ANSI graphical
+control sequences into text properties.
+
+In order for this to have any effect, `ansi-color-compilation-filter'
+must be in `compilation-filter-hook'."
+ :type '(choice (const :tag "Do nothing" nil)
+ (const :tag "Filter" filter)
+ (other :tag "Translate" t))
+ :group 'ansi-colors
+ :version "28.1")
+
(defvar ansi-color-apply-face-function #'ansi-color-apply-overlay-face
"Function for applying an Ansi Color face to text in a buffer.
This function should accept three arguments: BEG, END, and FACE,
@@ -228,6 +247,19 @@ This is a good function to put in
`comint-output-filter-functions'."
(t
(ansi-color-apply-on-region start-marker end-marker)))))
+;;;###autoload
+(defun ansi-color-compilation-filter ()
+ "Maybe translate SGR control sequences into text properties.
+This function depends on the `ansi-color-for-compilation-mode'
+variable, and is meant to be used in `compilation-filter-hook'."
+ (let ((inhibit-read-only t))
+ (pcase ansi-color-for-compilation-mode
+ ('nil nil)
+ ('filter
+ (ansi-color-filter-region compilation-filter-start (point)))
+ (_
+ (ansi-color-apply-on-region compilation-filter-start (point))))))
+
(define-obsolete-function-alias 'ansi-color-unfontify-region
'font-lock-default-unfontify-region "24.1")
diff --git a/lisp/apropos.el b/lisp/apropos.el
index f246064..376c1b2 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -724,22 +724,27 @@ the output includes key-bindings of commands."
;; (autoload (push (cdr x) autoloads))
('require (push (cdr x) requires))
('provide (push (cdr x) provides))
- ('t nil) ; Skip "was an autoload" entries.
+ ('t nil) ; Skip "was an autoload" entries.
;; FIXME: Print information about each individual method: both
;; its docstring and specializers (bug#21422).
('cl-defmethod (push (cadr x) provides))
(_ (push (or (cdr-safe x) x) symbols))))
- (let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal.
- (apropos-symbols-internal
- symbols apropos-do-all
- (concat
- (format-message
- "Library `%s' provides: %s\nand requires: %s"
- file
- (mapconcat #'apropos-library-button
- (or provides '(nil)) " and ")
- (mapconcat #'apropos-library-button
- (or requires '(nil)) " and ")))))))
+ (let ((apropos-pattern "") ;Dummy binding for apropos-symbols-internal.
+ (text
+ (concat
+ (format-message
+ "Library `%s' provides: %s\nand requires: %s"
+ file
+ (mapconcat #'apropos-library-button
+ (or provides '(nil)) " and ")
+ (mapconcat #'apropos-library-button
+ (or requires '(nil)) " and ")))))
+ (if (null symbols)
+ (with-output-to-temp-buffer "*Apropos*"
+ (with-current-buffer standard-output
+ (apropos-mode)
+ (apropos--preamble text)))
+ (apropos-symbols-internal symbols apropos-do-all text)))))
(defun apropos-symbols-internal (symbols keys &optional text)
;; Filter out entries that are marked as apropos-inhibit.
@@ -1154,10 +1159,7 @@ as a heading."
symbol item)
(set-buffer standard-output)
(apropos-mode)
- (insert (substitute-command-keys "Type \\[apropos-follow] on ")
- (if apropos-multi-type "a type label" "an entry")
- " to view its full documentation.\n\n")
- (if text (insert text "\n\n"))
+ (apropos--preamble text)
(dolist (apropos-item p)
(when (and spacing (not (bobp)))
(princ spacing))
@@ -1287,6 +1289,14 @@ as a heading."
(fill-region opoint (point) nil t)))
(or (bolp) (terpri)))))
+(defun apropos--preamble (text)
+ (let ((inhibit-read-only t))
+ (insert (substitute-command-keys "Type \\[apropos-follow] on ")
+ (if apropos-multi-type "a type label" "an entry")
+ " to view its full documentation.\n\n")
+ (when text
+ (insert text "\n\n"))))
+
(defun apropos-follow ()
"Invokes any button at point, otherwise invokes the nearest label button."
(interactive)
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index edd4c7e..9197ead 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -391,6 +391,10 @@ disk changes.
When a buffer is reverted, a message is generated. This can be
suppressed by setting `auto-revert-verbose' to nil.
+Reverting can sometimes fail to preserve all the markers in the buffer.
+To avoid that, set `revert-buffer-insert-file-contents-function' to
+the slower function `revert-buffer-insert-file-contents-delicately'.
+
Use `global-auto-revert-mode' to automatically revert all buffers.
Use `auto-revert-tail-mode' if you know that the file will only grow
without being changed in the part that is already in the buffer."
diff --git a/lisp/battery.el b/lisp/battery.el
index 59f6987..bf864c2 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -161,9 +161,9 @@ The full `format-spec' formatting syntax is supported."
(defcustom battery-mode-line-format
(cond ((eq battery-status-function #'battery-linux-proc-acpi)
- "[%b%p%%,%d°C]")
+ "[%b%p%%,%d°C] ")
(battery-status-function
- "[%b%p%%]"))
+ "[%b%p%%] "))
"Control string formatting the string to display in the mode line.
Ordinary characters in the control string are printed as-is, while
conversion specifications introduced by a `%' character in the control
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 06ba5d0..8e5799f 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -463,7 +463,9 @@ displayed in `mode-line-position', a component of the
default
(defcustom mode-line-position-line-format '(" L%l")
"Format used to display line numbers in the mode line.
This is used when `line-number-mode' is switched on. The \"%l\"
-format spec will be replaced by the line number."
+format spec will be replaced by the line number.
+
+Also see `mode-line-position-column-line-format'."
:type '(list string)
:version "28.1"
:group 'mode-line)
@@ -471,9 +473,10 @@ format spec will be replaced by the line number."
(defcustom mode-line-position-column-format '(" C%c")
"Format used to display column numbers in the mode line.
This is used when `column-number-mode' is switched on. The
-\"%c\" format spec will be replaced by the column number, which
-is zero-based if `column-number-indicator-zero-based' is non-nil,
-and one-based if `column-number-indicator-zero-based' is nil."
+\"%c\" format spec is replaced by the zero-based column number,
+and \"%C\" is replaced by the one-based column number.
+
+Also see `mode-line-position-column-line-format'."
:type '(list string)
:version "28.1"
:group 'mode-line)
@@ -580,7 +583,7 @@ Major modes that edit things other than ordinary files may
change this
(put 'mode-line-buffer-identification 'risky-local-variable t)
(defvar mode-line-misc-info
- '((global-mode-string ("" global-mode-string " ")))
+ '((global-mode-string ("" global-mode-string)))
"Mode line construct for miscellaneous information.
By default, this shows the information specified by `global-mode-string'.")
(put 'mode-line-misc-info 'risky-local-variable t)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 31e41a9..ff9b8ab 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -467,18 +467,18 @@ See user option `bookmark-fontify'."
"Remove a bookmark's colorized overlay.
BM is a bookmark as returned from function `bookmark-get-bookmark'.
See user option `bookmark-fontify'."
- (let ((filename (assq 'filename bm))
- (pos (assq 'position bm))
+ (let ((filename (cdr (assq 'filename bm)))
+ (pos (cdr (assq 'position bm)))
overlays found temp)
- (when filename (setq filename (expand-file-name (cdr filename))))
- (when pos (setq pos (cdr pos)))
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when (equal filename buffer-file-name)
- (setq overlays (overlays-at pos))
- (while (and (not found) (setq temp (pop overlays)))
- (when (eq 'bookmark (overlay-get temp 'category))
- (delete-overlay (setq found temp)))))))))
+ (when (and pos filename)
+ (setq filename (expand-file-name filename))
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (equal filename buffer-file-name)
+ (setq overlays (overlays-at pos))
+ (while (and (not found) (setq temp (pop overlays)))
+ (when (eq 'bookmark (overlay-get temp 'category))
+ (delete-overlay (setq found temp))))))))))
(defun bookmark-completing-read (prompt &optional default)
"Prompting with PROMPT, read a bookmark name in completion.
@@ -561,10 +561,14 @@ old one."
(set-text-properties 0 (length stripped-name) nil stripped-name)
(if (and (not no-overwrite)
(bookmark-get-bookmark stripped-name 'noerror))
- ;; already existing bookmark under that name and
- ;; no prefix arg means just overwrite old bookmark
- ;; Use the new (NAME . ALIST) format.
- (setcdr (bookmark-get-bookmark stripped-name) alist)
+ ;; Already existing bookmark under that name and
+ ;; no prefix arg means just overwrite old bookmark.
+ (let ((bm (bookmark-get-bookmark stripped-name)))
+ ;; First clean up if previously location was fontified.
+ (when bookmark-fontify
+ (bookmark--unfontify bm))
+ ;; Modify using the new (NAME . ALIST) format.
+ (setcdr bm alist))
;; otherwise just cons it onto the front (either the bookmark
;; doesn't exist already, or there is no prefix arg. In either
diff --git a/lisp/button.el b/lisp/button.el
index 69d7054..74dfb5d 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -61,6 +61,7 @@
;; might get converted to ^M when building loaddefs.el
(define-key map [(control ?m)] 'push-button)
(define-key map [mouse-2] 'push-button)
+ (define-key map [follow-link] 'mouse-face)
;; FIXME: You'd think that for keymaps coming from text-properties on the
;; mode-line or header-line, the `mode-line' or `header-line' prefix
;; shouldn't be necessary!
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index ff419c7..350b7e5 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -126,7 +126,7 @@ Defaults to today's date if DATE is not given."
"" ; pre-Bahai
(let ((m (calendar-extract-month bahai-date))
(d (calendar-extract-day bahai-date)))
- (calendar-dlet*
+ (calendar-dlet
((monthname (if (and (= m 19)
(<= d 0))
"Ayyám-i-Há"
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
index 346585e..11785c4 100644
--- a/lisp/calendar/cal-coptic.el
+++ b/lisp/calendar/cal-coptic.el
@@ -116,7 +116,7 @@ Defaults to today's date if DATE is not given."
(m (calendar-extract-month coptic-date)))
(if (< y 1)
""
- (calendar-dlet*
+ (calendar-dlet
((monthname (aref calendar-coptic-month-name-array (1- m)))
(day (number-to-string (calendar-extract-day coptic-date)))
(dayname nil)
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index 9e6c295..2986411 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -200,7 +200,7 @@ The result has the proper form for
`calendar-daylight-savings-starts'."
(calendar-persian-to-absolute `(7 1 ,(- year 621))))))))
(prevday-sec (- -1 utc-diff)) ; last sec of previous local day
new-rules)
- (calendar-dlet* ((year (1+ y)))
+ (calendar-dlet ((year (1+ y)))
;; Scan through the next few years until only one rule remains.
(while (cdr candidate-rules)
(dolist (rule candidate-rules)
@@ -397,7 +397,7 @@ This function respects the value of
`calendar-dst-check-each-year-flag'."
(or (let ((expr (if calendar-dst-check-each-year-flag
(cadr (calendar-dst-find-startend year))
(nth 4 calendar-current-time-zone-cache))))
- (calendar-dlet* ((year year))
+ (calendar-dlet ((year year))
(if expr (eval expr))))
;; New US rules commencing 2007. https://www.iana.org/time-zones
(and (not (zerop calendar-daylight-time-offset))
@@ -409,7 +409,7 @@ This function respects the value of
`calendar-dst-check-each-year-flag'."
(or (let ((expr (if calendar-dst-check-each-year-flag
(nth 2 (calendar-dst-find-startend year))
(nth 5 calendar-current-time-zone-cache))))
- (calendar-dlet* ((year year))
+ (calendar-dlet ((year year))
(if expr (eval expr))))
;; New US rules commencing 2007. https://www.iana.org/time-zones
(and (not (zerop calendar-daylight-time-offset))
@@ -419,7 +419,7 @@ This function respects the value of
`calendar-dst-check-each-year-flag'."
(defun dst-in-effect (date)
"True if on absolute DATE daylight saving time is in effect.
Fractional part of DATE is local standard time of day."
- (calendar-dlet* ((year (calendar-extract-year
+ (calendar-dlet ((year (calendar-extract-year
(calendar-gregorian-from-absolute (floor date)))))
(let* ((dst-starts-gregorian (eval calendar-daylight-savings-starts))
(dst-ends-gregorian (eval calendar-daylight-savings-ends))
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el
index 639bae7..1789f16 100644
--- a/lisp/calendar/cal-french.el
+++ b/lisp/calendar/cal-french.el
@@ -40,12 +40,13 @@
(defconst calendar-french-month-name-array
["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse"
- "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"]
+ "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"
+ "jour complémentaire"]
"Array of month names in the French calendar.")
(defconst calendar-french-day-name-array
["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi"
- "Octidi" "Nonidi" "Decadi"]
+ "Octidi" "Nonidi" "Décadi"]
"Array of day names in the French calendar.")
(define-obsolete-variable-alias 'calendar-french-multibyte-special-days-array
@@ -56,6 +57,144 @@
"de la Révolution"]
"Array of special day names in the French calendar.")
+(defconst calendar-french-feasts-array
+ [;; Vendémiaire
+ "du Raisin" "du Safran" "de la Châtaigne"
+ "de la Colchique" "du Cheval" "de la Balsamine"
+ "de la Carotte" "de l'Amarante" "du Panais"
+ "de la Cuve" "de la Pomme de terre" "de l'Immortelle"
+ "du Potiron" "du Réséda" "de l'Âne"
+ "de la Belle de nuit" "de la Citrouille" "du Sarrasin"
+ "du Tournesol" "du Pressoir" "du Chanvre"
+ "de la Pêche" "du Navet" "de l'Amaryllis"
+ "du Bœuf" "de l'Aubergine" "du Piment"
+ "de la Tomate" "de l'Orge" "du Tonneau"
+ ;; Brumaire
+ "de la Pomme" "du Céleri" "de la Poire"
+ "de la Betterave" "de l'Oie" "de l'Héliotrope"
+ "de la Figue" "de la Scorsonère" "de l'Alisier"
+ "de la Charrue" "du Salsifis" "de la Macre"
+ "du Topinambour" "de l'Endive" "du Dindon"
+ "du Chervis" "du Cresson" "de la Dentelaire"
+ "de la Grenade" "de la Herse" "de la Bacchante"
+ "de l'Azerole" "de la Garance" "de l'Orange"
+ "du Faisan" "de la Pistache" "du Macjon"
+ "du Coing" "du Cormier" "du Rouleau"
+ ;; Frimaire
+ "de la Raiponce" "du Turneps" "de la Chicorée"
+ "de la Nèfle" "du Cochon" "de la Mâche"
+ "du Chou-fleur" "du Miel" "du Genièvre"
+ "de la Pioche" "de la Cire" "du Raifort"
+ "du Cèdre" "du Sapin" "du Chevreuil"
+ "de l'Ajonc" "du Cyprès" "du Lierre"
+ "de la Sabine" "du Hoyau" "de l'Érable-sucre"
+ "de la Bruyère" "du Roseau" "de l'Oseille"
+ "du Grillon" "du Pignon" "du Liège"
+ "de la Truffe" "de l'Olive" "de la Pelle"
+ ;; Nivôse
+ "de la Tourbe" "de la Houille" "du Bitume"
+ "du Soufre" "du Chien" "de la Lave"
+ "de la Terre végétale" "du Fumier" "du Salpêtre"
+ "du Fléau" "du Granit" "de l'Argile"
+ "de l'Ardoise" "du Grès" "du Lapin"
+ "du Silex" "de la Marne" "de la Pierre à chaux"
+ "du Marbre" "du Van" "de la Pierre à plâtre"
+ "du Sel" "du Fer" "du Cuivre"
+ "du Chat" "de l'Étain" "du Plomb"
+ "du Zinc" "du Mercure" "du Crible"
+ ;; Pluviôse
+ "de la Lauréole" "de la Mousse" "du Fragon"
+ "du Perce-neige" "du Taureau" "du Laurier-thym"
+ "de l'Amadouvier" "du Mézéréon" "du Peuplier"
+ "de la Cognée" "de l'Ellébore" "du Brocoli"
+ "du Laurier" "de l'Avelinier" "de la Vache"
+ "du Buis" "du Lichen" "de l'If"
+ "de la Pulmonaire" "de la Serpette" "du Thlaspi"
+ "du Thymelé" "du Chiendent" "de la Traînasse"
+ "du Lièvre" "de la Guède" "du Noisetier"
+ "du Cyclamen" "de la Chélidoine" "du Traîneau"
+ ;; Ventôse
+ "du Tussilage" "du Cornouiller" "du Violier"
+ "du Troène" "du Bouc" "de l'Asaret"
+ "de l'Alaterne" "de la Violette" "du Marsault"
+ "de la Bêche" "du Narcisse" "de l'Orme"
+ "de la Fumeterre" "du Vélar" "de la Chèvre"
+ "de l'Épinard" "du Doronic" "du Mouron"
+ "du Cerfeuil" "du Cordeau" "de la Mandragore"
+ "du Persil" "du Cochléaria" "de la Pâquerette"
+ "du Thon" "du Pissenlit" "de la Sylvie"
+ "du Capillaire" "du Frêne" "du Plantoir"
+ ;; Germinal
+ "de la Primevère" "du Platane" "de l'Asperge"
+ "de la Tulipe" "de la Poule" "de la Blette"
+ "du Bouleau" "de la Jonquille" "de l'Aulne"
+ "du Couvoir" "de la Pervenche" "du Charme"
+ "de la Morille" "du Hêtre" "de l'Abeille"
+ "de la Laitue" "du Mélèze" "de la Ciguë"
+ "du Radis" "de la Ruche" "du Gainier"
+ "de la Romaine" "du Marronnier" "de la Roquette"
+ "du Pigeon" "du Lilas" "de l'Anémone"
+ "de la Pensée" "de la Myrtille" "du Greffoir"
+ ;; Floréal
+ "de la Rose" "du Chêne" "de la Fougère"
+ "de l'Aubépine" "du Rossignol" "de l'Ancolie"
+ "du Muguet" "du Champignon" "de la Jacinthe"
+ "du Rateau" "de la Rhubarbe" "du Sainfoin"
+ "du Bâton-d'or" "du Chamérisier" "du Ver à soie"
+ "de la Consoude" "de la Pimprenelle" "de la Corbeille-d'or"
+ "de l'Arroche" "du Sarcloir" "du Statice"
+ "de la Fritillaire" "de la Bourrache" "de la Valériane"
+ "de la Carpe" "du Fusain" "de la Civette"
+ "de la Buglosse" "du Sénevé" "de la Houlette"
+ ;; Prairial
+ "de la Luzerne" "de l'Hémérocalle" "du Trèfle"
+ "de l'Angélique" "du Canard" "de la Mélisse"
+ "du Fromental" "du Martagon" "du Serpolet"
+ "de la Faux" "de la Fraise" "de la Bétoine"
+ "du Pois" "de l'Acacia" "de la Caille"
+ "de l'Œillet" "du Sureau" "du Pavot"
+ "du Tilleul" "de la Fourche" "du Barbeau"
+ "de la Camomille" "du Chèvrefeuille" "du Caille-lait"
+ "de la Tanche" "du Jasmin" "de la Verveine"
+ "du Thym" "de la Pivoine" "du Chariot"
+ ;; Messidor
+ "du Seigle" "de l'Avoine" "de l'Oignon"
+ "de la Véronique" "du Mulet" "du Romarin"
+ "du Concombre" "de l'Échalotte" "de l'Absinthe"
+ "de la Faucille" "de la Coriandre" "de l'Artichaut"
+ "de la Giroflée" "de la Lavande" "du Chamois"
+ "du Tabac" "de la Groseille" "de la Gesse"
+ "de la Cerise" "du Parc" "de la Menthe"
+ "du Cumin" "du Haricot" "de l'Orcanète"
+ "de la Pintade" "de la Sauge" "de l'Ail"
+ "de la Vesce" "du Blé" "de la Chalémie"
+ ;; Thermidor
+ "de l'Épautre" "du Bouillon-blanc" "du Melon"
+ "de l'Ivraie" "du Bélier" "de la Prèle"
+ "de l'Armoise" "du Carthame" "de la Mûre"
+ "de l'Arrosoir" "du Panis" "du Salicor"
+ "de l'Abricot" "du Basilic" "de la Brebis"
+ "de la Guimauve" "du Lin" "de l'Amande"
+ "de la Gentiane" "de l'Écluse" "de la Carline"
+ "du Câprier" "de la Lentille" "de l'Aunée"
+ "de la Loutre" "de la Myrte" "du Colza"
+ "du Lupin" "du Coton" "du Moulin"
+ ;; Fructidor
+ "de la Prune" "du Millet" "du Lycoperdon"
+ "de l'Escourgeon" "du Saumon" "de la Tubéreuse"
+ "du Sucrion" "de l'Apocyn" "de la Réglisse"
+ "de l'Échelle" "de la Pastèque" "du Fenouil"
+ "de l'Épine-vinette" "de la Noix" "de la Truite"
+ "du Citron" "de la Cardère" "du Nerprun"
+ "du Tagette" "de la Hotte" "de l'Églantier"
+ "de la Noisette" "du Houblon" "du Sorgho"
+ "de l'Écrevisse" "de la Bagarade" "de la Verge-d'or"
+ "du Maïs" "du Marron" "du Panier"
+ ;; jour complémentaire
+ "de la Vertu" "du Génie" "du Travail"
+ "de la Raison" "des Récompenses" "de la Révolution"]
+ "Array of day feasts in the French calendar.")
+
(defun calendar-french-accents-p ()
(declare (obsolete nil "28.1"))
t)
@@ -75,6 +214,16 @@
(declare (obsolete "use the variable of the same name instead" "28.1"))
calendar-french-special-days-array)
+(defun calendar-french-trim-feast (feast)
+ "Remove the article from the FEAST.
+E.g. \"du Raisin\" -> \"Raisin\" or \"de la Vertu\" -> \"Vertu\"."
+ (cond
+ ((equal (substring feast 0 3) "du ") (substring feast 3))
+ ((equal (substring feast 0 6) "de la ") (substring feast 6))
+ ((equal (substring feast 0 5) "de l'") (substring feast 5))
+ ((equal (substring feast 0 4) "des ") (substring feast 4))
+ (t feast)))
+
(defun calendar-french-leap-year-p (year)
"True if YEAR is a leap year on the French Revolutionary calendar.
For Gregorian years 1793 to 1805, the years of actual operation of the
@@ -162,14 +311,13 @@ Defaults to today's date if DATE is not given."
(d (calendar-extract-day french-date)))
(cond
((< y 1) "")
- ((= m 13) (format "Jour %s de l'Année %d de la Révolution"
- (aref calendar-french-special-days-array (1- d))
- y))
(t (format
- "%d %s an %d de la Révolution"
+ "%s %d %s an %d de la Révolution, jour %s"
+ (aref calendar-french-day-name-array (% (1- d) 10))
d
(aref calendar-french-month-name-array (1- m))
- y)))))
+ y
+ (aref calendar-french-feasts-array (+ -31 (* 30 m) d)))))))
;;;###cal-autoload
(defun calendar-french-print-date ()
@@ -186,7 +334,7 @@ Defaults to today's date if DATE is not given."
Echo French Revolutionary date unless NOECHO is non-nil."
(interactive
(let* ((months calendar-french-month-name-array)
- (special-days calendar-french-special-days-array)
+ (feasts calendar-french-feasts-array)
(year (progn
(calendar-read-sexp
"Année de la Révolution (>0)"
@@ -199,29 +347,31 @@ Echo French Revolutionary date unless NOECHO is non-nil."
(mapcar 'list
(append months
(if (calendar-french-leap-year-p year)
- (mapcar
- (lambda (x) (concat "Jour " x))
- calendar-french-special-days-array)
+ (mapcar #'calendar-french-trim-feast feasts)
(reverse
(cdr ; we don't want rev. day in a non-leap yr
(reverse
- (mapcar
- (lambda (x)
- (concat "Jour " x))
- special-days))))))))
+ (mapcar #'calendar-french-trim-feast
+ feasts))))))))
(completion-ignore-case t)
(month (cdr (assoc-string
(completing-read
- "Mois ou Sansculottide: "
+ "Mois ou \"jour complémentaire\" ou fête: "
month-list
nil t)
(calendar-make-alist month-list 1 'car) t)))
- (day (if (> month 12)
- (- month 12)
+ (last-day (calendar-french-last-day-of-month (min month 13) year))
+ (day (if (> month 13)
+ (- month 13)
(calendar-read-sexp
- "Jour (1-30)"
- (lambda (x) (and (<= 1 x) (<= x 30))))))
- (month (if (> month 12) 13 month)))
+ (format "Jour (1-%d): " last-day)
+ (lambda (x) (<= 1 x last-day)))))
+ ;; All days in Vendémiaire and numbered 1 to 365 e.g., "Pomme"
+ ;; gives 31 Vendémiaire automatically normalized to 1 Brumaire
+ ;; "Céleri" gives 32 Vnd normalized to 2 Bru, "Raiponce" gives
+ ;; 61 Vnd normalized to 1 Frimaire, etc until "Récompences" which
+ ;; gives 365 Vnd normalized to 5 jour complémentaire.
+ (month (if (> month 13) 1 month)))
(list (list month day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-french-to-absolute date)))
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
index ca37d80..dd005e8 100644
--- a/lisp/calendar/cal-persia.el
+++ b/lisp/calendar/cal-persia.el
@@ -140,7 +140,7 @@ Gregorian date Sunday, December 31, 1 BC."
(or date (calendar-current-date)))))
(y (calendar-extract-year persian-date))
(m (calendar-extract-month persian-date)))
- (calendar-dlet*
+ (calendar-dlet
((monthname (aref calendar-persian-month-name-array (1- m)))
(day (number-to-string (calendar-extract-day persian-date)))
(year (number-to-string y))
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 3f9fe1c..76d6132 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -137,7 +137,7 @@
;; - whatever is passed to diary-sexp-entry
;; - whatever is passed to diary-remind
-(defmacro calendar-dlet* (binders &rest body)
+(defmacro calendar-dlet (binders &rest body)
"Like `dlet' but without warnings about non-prefixed var names."
(declare (indent 1) (debug let))
(let ((vars (mapcar (lambda (binder)
@@ -1499,7 +1499,7 @@ first INDENT characters on the line."
(goto-char (point-min))
(calendar-move-to-column indent)
(insert
- (calendar-dlet* ((month month) (year year))
+ (calendar-dlet ((month month) (year year))
(calendar-string-spread (list calendar-month-header)
?\s calendar-month-digit-width)))
(calendar-ensure-newline)
@@ -1516,7 +1516,7 @@ first INDENT characters on the line."
calendar-day-header-width nil ?\s)
(make-string (- calendar-column-width calendar-day-header-width) ?\s)))
(calendar-ensure-newline)
- (calendar-dlet* ((day day) (month month) (year year))
+ (calendar-dlet ((day day) (month month) (year year))
(calendar-insert-at-column indent calendar-intermonth-text trunc))
;; Add blank days before the first of the month.
(insert (make-string (* blank-days calendar-column-width) ?\s))
@@ -1527,7 +1527,7 @@ first INDENT characters on the line."
(insert (propertize
(format (format "%%%dd" calendar-day-digit-width) day)
'mouse-face 'highlight
- 'help-echo (calendar-dlet* ((day day) (month month) (year year))
+ 'help-echo (calendar-dlet ((day day) (month month) (year year))
(eval calendar-date-echo-text t))
;; 'date property prevents intermonth text confusing re-searches.
;; (Tried intangible, it did not really work.)
@@ -1538,7 +1538,7 @@ first INDENT characters on the line."
(/= day last))
(calendar-ensure-newline)
(setq day (1+ day)) ; first day of next week
- (calendar-dlet* ((day day) (month month) (year year))
+ (calendar-dlet ((day day) (month month) (year year))
(calendar-insert-at-column indent calendar-intermonth-text trunc))))))
(defun calendar-redraw ()
@@ -1833,7 +1833,7 @@ concatenated and the result truncated."
(bufferp (get-buffer calendar-buffer)))
(with-current-buffer calendar-buffer
(let ((start (- calendar-left-margin 2)))
- (calendar-dlet* ((date (condition-case nil
+ (calendar-dlet ((date (condition-case nil
(calendar-cursor-to-nearest-date)
(error (calendar-current-date)))))
(setq mode-line-format
@@ -2561,7 +2561,7 @@ and day names to be abbreviated as specified by
respectively. An optional parameter NODAYNAME, when t, omits the
name of the day of the week."
(let ((month (calendar-extract-month date)))
- (calendar-dlet*
+ (calendar-dlet
((dayname (unless nodayname (calendar-day-name date abbreviate)))
(monthname (calendar-month-name month abbreviate))
(day (number-to-string (calendar-extract-day date)))
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 4efa366..f57fe26 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -663,7 +663,7 @@ any entries were found."
(calendar-month-name-array (or months calendar-month-name-array))
(case-fold-search t)
entry-found)
- (calendar-dlet*
+ (calendar-dlet
((dayname (format "%s\\|%s\\.?" (calendar-day-name date)
(calendar-day-name date 'abbrev)))
(monthname (format "\\*\\|%s%s" (calendar-month-name month)
@@ -858,7 +858,7 @@ LIST-ONLY is non-nil, in which case it just returns the
list."
;; every time, diary-include-other-diary-files
;; binds it to nil (essentially) when it runs
;; in included files.
- (calendar-dlet* ((number number)
+ (calendar-dlet ((number number)
(list-only list-only))
(run-hooks 'diary-nongregorian-listing-hook
'diary-list-entries-hook))
@@ -877,7 +877,7 @@ LIST-ONLY is non-nil, in which case it just returns the
list."
(copy-sequence
(car display-buffer-fallback-action))))))
(funcall diary-display-function)))
- (calendar-dlet* ((number number)
+ (calendar-dlet ((number number)
(original-date original-date))
(run-hooks 'diary-hook))))))
(and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff)))
@@ -1266,7 +1266,7 @@ MARKFUNC is a function that marks entries of the
appropriate type
matching a given date pattern. MONTHS is an array of month names.
SYMBOL marks diary entries of the type in question. ABSFUNC is a
function that converts absolute dates to dates of the appropriate type."
- (calendar-dlet*
+ (calendar-dlet
((dayname (diary-name-pattern calendar-day-name-array
calendar-day-abbrev-array))
(monthname (format "%s\\|\\*"
@@ -1435,7 +1435,7 @@ marks. This is intended to deal with deleted diary
entries."
(defun diary-sexp-entry (sexp entry date)
"Process a SEXP diary ENTRY for DATE."
(let ((result
- (calendar-dlet* ((date date)
+ (calendar-dlet ((date date)
(entry entry))
(if calendar-debug-sexp
(let ((debug-on-error t))
@@ -2043,7 +2043,7 @@ calendar."
(and (integerp days)
(< days 0)
(setq days (number-sequence 1 (- days))))
- (calendar-dlet* ((diary-entry (eval sexp)))
+ (calendar-dlet ((diary-entry (eval sexp)))
(cond
;; Diary entry applies on date.
((and diary-entry
@@ -2059,7 +2059,7 @@ calendar."
(when (setq diary-entry (eval sexp))
;; Discard any mark portion from diary-anniversary, etc.
(if (consp diary-entry) (setq diary-entry (cdr diary-entry)))
- (calendar-dlet* ((days days))
+ (calendar-dlet ((days days))
(mapconcat #'eval diary-remind-message "")))))
;; Diary entry may apply to one of a list of days before date.
((and (listp days) days)
@@ -2264,7 +2264,7 @@ If given, optional SYMBOL must be a prefix to entries. If
optional ABBREV-ARRAY is present, also matches the abbreviations
from this array (with or without a final `.'), in addition to the
full month names."
- (calendar-dlet*
+ (calendar-dlet
((dayname (diary-name-pattern calendar-day-name-array
calendar-day-abbrev-array t))
(monthname (format "\\(%s\\|\\*\\)"
@@ -2400,7 +2400,7 @@ return a font-lock pattern matching array of MONTHS and
marking SYMBOL."
This depends on the calendar date style."
(declare (obsolete nil "28.1"))
(concat
- (calendar-dlet*
+ (calendar-dlet
((dayname (diary-name-pattern calendar-day-name-array nil t))
(monthname (diary-name-pattern calendar-month-name-array nil t))
(day "1")
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 4bc17de..3eae2dc 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -683,7 +683,7 @@ nil, or if the date is not visible, there is no holiday."
(y displayed-year))
(calendar-increment-month m y -1)
(holiday-filter-visible-calendar
- (calendar-dlet* (year date)
+ (calendar-dlet (year date)
(list
(progn
(setq year y
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 6eb086a..d18ec5e 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -1783,8 +1783,8 @@ entries. ENTRY-MAIN is the first line of the diary
entry."
;;BUT remove today if `diary-float'
;;expression does not hold true for today:
(when
- (null (calendar-dlet* ((date (calendar-current-date))
- (entry entry-main))
+ (null (calendar-dlet ((date (calendar-current-date))
+ (entry entry-main))
(diary-float month dayname n)))
(concat
"\nEXDATE;VALUE=DATE:"
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 372490d..b5f2f45 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -552,7 +552,7 @@ degrees to find out if polar regions have 24 hours of sun
or only night."
Format used is given by `calendar-time-display-form'."
(let* ((time (round (* 60 time)))
(24-hours (/ time 60)))
- (calendar-dlet*
+ (calendar-dlet
((time-zone time-zone)
(minutes (format "%02d" (% time 60)))
(12-hours (format "%d" (1+ (% (+ 24-hours 11) 12))))
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index dab468d..680beb8 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -191,7 +191,7 @@ The final element is \"*\", indicating an unspecified
month.")
(defconst todo-date-pattern
(let ((dayname (diary-name-pattern calendar-day-name-array nil t)))
(concat "\\(?4:\\(?5:" dayname "\\)\\|"
- (calendar-dlet*
+ (calendar-dlet
((dayname)
(monthname (format "\\(?6:%s\\)" (diary-name-pattern
todo-month-name-array
@@ -2431,7 +2431,7 @@ made in the number or names of categories."
;; changed, rebuild the date string.
(when (memq what '(year month day))
(setq ndate
- (calendar-dlet*
+ (calendar-dlet
;; Needed by calendar-date-display-form.
((year year)
(monthname monthname)
@@ -4658,7 +4658,7 @@ strings built using the default value of
(defun todo-convert-legacy-date-time ()
"Return converted date-time string.
Helper function for `todo-convert-legacy-files'."
- (calendar-dlet*
+ (calendar-dlet
((year (match-string 1))
(month (match-string 2))
(monthname (calendar-month-name (string-to-number month) t))
@@ -6036,7 +6036,7 @@ indicating an unspecified month, day, or year.
When ARG is `day', non-nil arguments MO and YR determine the
number of the last the day of the month."
- (calendar-dlet*
+ (calendar-dlet
(year monthname month day dayname) ;Needed by calendar-date-display-form.
(when (or (not arg) (eq arg 'year))
(while (if (natnump year) (< year 1) (not (eq year '*)))
diff --git a/lisp/comint.el b/lisp/comint.el
index 9e40661..40f58f2 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -2157,9 +2157,9 @@ Make backspaces delete the previous character."
'comint-highlight-prompt))
(setq comint-last-prompt
(cons (copy-marker prompt-start) (point-marker)))
- (font-lock-prepend-text-property prompt-start (point)
- 'font-lock-face
- 'comint-highlight-prompt)
+ (font-lock-append-text-property prompt-start (point)
+ 'font-lock-face
+ 'comint-highlight-prompt)
(add-text-properties prompt-start (point)
`(rear-nonsticky
,comint--prompt-rear-nonsticky)))
@@ -2471,10 +2471,13 @@ This function could be in the list
`comint-output-filter-functions'."
;; Random input hackage
-(defun comint-delete-output ()
+(defun comint-delete-output (&optional kill)
"Delete all output from interpreter since last input.
-Does not delete the prompt."
- (interactive)
+If KILL (interactively, the prefix), save the killed text in the
+kill ring.
+
+This command does not delete the prompt."
+ (interactive "P")
(let ((proc (get-buffer-process (current-buffer)))
(replacement nil)
(inhibit-read-only t))
@@ -2482,6 +2485,8 @@ Does not delete the prompt."
(let ((pmark (progn (goto-char (process-mark proc))
(forward-line 0)
(point-marker))))
+ (when kill
+ (copy-region-as-kill comint-last-input-end pmark))
(delete-region comint-last-input-end pmark)
(goto-char (process-mark proc))
(setq replacement (concat "*** output flushed ***\n"
diff --git a/lisp/completion.el b/lisp/completion.el
index dc0af36..93a869e 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -1917,68 +1917,64 @@ If file is not specified, then use
`save-completions-file-name'."
(clear-visited-file-modtime)
(erase-buffer)
- (let ((insert-okay-p nil)
- (buffer (current-buffer))
+ (let ((buffer (current-buffer))
string entry last-use-time
cmpl-entry cmpl-last-use-time
(current-completion-source cmpl-source-init-file)
(total-in-file 0) (total-perm 0))
;; insert the file into a buffer
(condition-case nil
- (progn (insert-file-contents filename t)
- (setq insert-okay-p t))
-
+ (insert-file-contents filename t)
(file-error
(message "File error trying to load completion file %s."
- filename)))
- ;; parse it
- (if insert-okay-p
- (progn
- (goto-char (point-min))
-
- (condition-case nil
- (while t
- (setq entry (read buffer))
- (setq total-in-file (1+ total-in-file))
- (cond
- ((and (consp entry)
- (stringp (setq string (car entry)))
- (cond
- ((eq (setq last-use-time (cdr entry)) 'T)
- ;; handle case sensitivity
- (setq total-perm (1+ total-perm))
- (setq last-use-time t))
- ((eq last-use-time t)
- (setq total-perm (1+ total-perm)))
- ((integerp last-use-time))))
- ;; Valid entry
- ;; add it in
- (setq cmpl-last-use-time
- (completion-last-use-time
- (setq cmpl-entry
- (add-completion-to-tail-if-new
string))))
- (if (or (eq last-use-time t)
- (and (> last-use-time
1000);;backcompatibility
- (not (eq cmpl-last-use-time t))
- (or (not cmpl-last-use-time)
- ;; more recent
- (> last-use-time
cmpl-last-use-time))))
- ;; update last-use-time
- (set-completion-last-use-time cmpl-entry
last-use-time)))
- (t
- ;; Bad format
- (message "Error: invalid saved completion - %s"
- (prin1-to-string entry))
- ;; try to get back in sync
- (search-forward "\n("))))
- (search-failed
- (message "End of file while reading completions."))
- (end-of-file
- (if (= (point) (point-max))
- (if (not no-message-p)
- (message "Loading completions from file %s . . .
Done."
- filename))
- (message "End of file while reading completions."))))))
+ filename))
+ (:success
+ ;; parse it
+ (goto-char (point-min))
+
+ (condition-case nil
+ (while t
+ (setq entry (read buffer))
+ (setq total-in-file (1+ total-in-file))
+ (cond
+ ((and (consp entry)
+ (stringp (setq string (car entry)))
+ (cond
+ ((eq (setq last-use-time (cdr entry)) 'T)
+ ;; handle case sensitivity
+ (setq total-perm (1+ total-perm))
+ (setq last-use-time t))
+ ((eq last-use-time t)
+ (setq total-perm (1+ total-perm)))
+ ((integerp last-use-time))))
+ ;; Valid entry
+ ;; add it in
+ (setq cmpl-last-use-time
+ (completion-last-use-time
+ (setq cmpl-entry
+ (add-completion-to-tail-if-new string))))
+ (if (or (eq last-use-time t)
+ (and (> last-use-time 1000);;backcompatibility
+ (not (eq cmpl-last-use-time t))
+ (or (not cmpl-last-use-time)
+ ;; more recent
+ (> last-use-time
cmpl-last-use-time))))
+ ;; update last-use-time
+ (set-completion-last-use-time cmpl-entry
last-use-time)))
+ (t
+ ;; Bad format
+ (message "Error: invalid saved completion - %s"
+ (prin1-to-string entry))
+ ;; try to get back in sync
+ (search-forward "\n("))))
+ (search-failed
+ (message "End of file while reading completions."))
+ (end-of-file
+ (if (= (point) (point-max))
+ (if (not no-message-p)
+ (message "Loading completions from file %s . . .
Done."
+ filename))
+ (message "End of file while reading completions."))))))
))))))
(defun completion-initialize ()
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 7627930..980a1cc 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1665,8 +1665,11 @@ Otherwise use brackets."
'custom-button-pressed
'custom-button-pressed-unraised))))
+(defvar custom--invocation-options nil)
+
(defun custom-buffer-create-internal (options &optional _description)
(Custom-mode)
+ (setq custom--invocation-options options)
(let ((init-file (or custom-file user-init-file)))
;; Insert verbose help at the top of the custom buffer.
(when custom-buffer-verbose-help
@@ -2821,7 +2824,7 @@ the present value is saved to its :shown-value property
instead."
(list (widget-value
(car-safe
(widget-get widget :children)))))
- (error "There are unsaved changes")))
+ (message "Note: There are unsaved changes")))
(widget-put widget :documentation-shown nil)
(widget-put widget :custom-state 'hidden))
(custom-redraw widget)
@@ -5148,11 +5151,19 @@ if that value is non-nil."
:label (nth 5 arg)))
custom-commands)
(setq custom-tool-bar-map map))))
+ (setq-local custom--invocation-options nil)
+ (setq-local revert-buffer-function #'custom--revert-buffer)
(make-local-variable 'custom-options)
(make-local-variable 'custom-local-buffer)
(custom--initialize-widget-variables)
(add-hook 'widget-edit-functions 'custom-state-buffer-message nil t))
+(defun custom--revert-buffer (_ignore-auto _noconfirm)
+ (unless custom--invocation-options
+ (error "Insufficient data to revert"))
+ (custom-buffer-create custom--invocation-options
+ (buffer-name)))
+
(put 'Custom-mode 'mode-class 'special)
(provide 'cus-edit)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 3c2625a..1997530 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -306,8 +306,8 @@ Leaving \"Default\" unchecked is equivalent with specifying
a default of
(use-short-answers menu boolean "28.1")
(focus-follows-mouse
frames (choice
- (const :tag "Off (nil)" :value nil)
- (const :tag "On (t)" :value t)
+ (const :tag "Off" :value nil)
+ (const :tag "On" :value t)
(const :tag "Auto-raise" :value auto-raise)) "26.1")
;; fontset.c
;; FIXME nil is the initial value, fontset.el setqs it.
@@ -431,6 +431,7 @@ Leaving \"Default\" unchecked is equivalent with specifying
a default of
"21.1"
:set minibuffer-prompt-properties--setter)
(minibuffer-auto-raise minibuffer boolean)
+ (read-minibuffer-restore-windows minibuffer boolean "28.1")
;; options property set at end
(read-buffer-function minibuffer
(choice (const nil)
@@ -603,27 +604,29 @@ since it could result in memory overflow and make Emacs
crash."
(next-screen-context-lines windows integer)
(scroll-preserve-screen-position
windows (choice
- (const :tag "Off (nil)" :value nil)
- (const :tag "Full screen (t)" :value t)
- (other :tag "Always" 1)) "22.1")
+ (const :tag "Off" :value nil)
+ (const :tag "Full screen" :value t)
+ (other :tag "Always" 1))
+ "22.1")
(recenter-redisplay
windows (choice
- (const :tag "Never (nil)" :value nil)
+ (const :tag "Never" :value nil)
(const :tag "Only on ttys" :value tty)
- (other :tag "Always" t)) "23.1")
+ (other :tag "Always" t))
+ "23.1")
(window-combination-resize windows boolean "24.1")
(window-combination-limit
windows (choice
- (const :tag "Never (nil)" :value nil)
- (const :tag "If requested via buffer display alist
(window-size)"
+ (const :tag "Never" :value nil)
+ (const :tag "If requested via buffer display alist"
:value window-size)
- (const :tag "With Temp Buffer Resize mode
(temp-buffer-resize)"
+ (const :tag "With Temp Buffer Resize mode"
:value temp-buffer-resize)
- (const :tag "For temporary buffers (temp-buffer)"
+ (const :tag "For temporary buffers"
:value temp-buffer)
- (const :tag "For buffer display (display-buffer)"
+ (const :tag "For buffer display"
:value display-buffer)
- (other :tag "Always (t)" :value t))
+ (other :tag "Always" :value t))
"26.1")
(fast-but-imprecise-scrolling scrolling boolean "25.1")
(window-resize-pixelwise windows boolean "24.4")
@@ -631,6 +634,12 @@ since it could result in memory overflow and make Emacs
crash."
;; The whitespace group is for whitespace.el.
(show-trailing-whitespace editing-basics boolean nil
:safe booleanp)
+ (mode-line-compact
+ mode-line
+ (choice (const :tag "Never" :value nil)
+ (const :tag "Only if wider than window" :value long)
+ (const :tag "Always" :value t))
+ "28.1")
(scroll-step windows integer)
(scroll-conservatively windows integer)
(scroll-margin windows integer)
@@ -668,7 +677,7 @@ since it could result in memory overflow and make Emacs
crash."
(underline-minimum-offset display integer "23.1")
(mouse-autoselect-window
display (choice
- (const :tag "Off (nil)" :value nil)
+ (const :tag "Off" :value nil)
(const :tag "Immediate" :value t)
(number :tag "Delay by secs" :value 0.5)) "22.1")
(tool-bar-style
@@ -713,15 +722,15 @@ since it could result in memory overflow and make Emacs
crash."
(hourglass-delay cursor number)
(resize-mini-windows
windows (choice
- (const :tag "Off (nil)" :value nil)
- (const :tag "Fit (t)" :value t)
+ (const :tag "Off" :value nil)
+ (const :tag "Fit" :value t)
(const :tag "Grow only" :value grow-only))
"25.1")
(display-raw-bytes-as-hex display boolean "26.1")
(display-line-numbers
display-line-numbers
(choice
- (const :tag "Off (nil)" :value nil)
+ (const :tag "Off" :value nil)
(const :tag "Absolute line numbers"
:value t)
(const :tag "Relative line numbers"
diff --git a/lisp/custom.el b/lisp/custom.el
index 1db3f4f..f392bd8 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -926,7 +926,7 @@ See `custom-known-themes' for a list of known themes."
;; the value to a fake theme, `changed'. If the theme is
;; later disabled, we use this to bring back the old value.
;;
- ;; For faces, we just use `face-new-frame-defaults' to
+ ;; For faces, we just use `face--new-frame-defaults' to
;; recompute when the theme is disabled.
(when (and (eq prop 'theme-value)
(boundp symbol))
diff --git a/lisp/delsel.el b/lisp/delsel.el
index 3c99dd2..93fdc6a 100644
--- a/lisp/delsel.el
+++ b/lisp/delsel.el
@@ -300,7 +300,7 @@ then it takes a second \\[keyboard-quit] to abort the
minibuffer."
(interactive)
(if (and delete-selection-mode (region-active-p))
(setq deactivate-mark t)
- (abort-recursive-edit)))
+ (abort-minibuffers)))
(define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit)
diff --git a/lisp/desktop.el b/lisp/desktop.el
index ae8d026..3b25713 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -706,8 +706,9 @@ if different)."
"\\)\\'")))
(dolist (buffer (buffer-list))
(let ((bufname (buffer-name buffer)))
- (unless (or (eq (aref bufname 0) ?\s) ;; Don't kill internal buffers
- (string-match-p preserve-regexp bufname))
+ (unless (or (null bufname)
+ (eq (aref bufname 0) ?\s) ;; Don't kill internal buffers
+ (string-match-p preserve-regexp bufname))
(kill-buffer buffer)))))
(delete-other-windows)
(when (and desktop-restore-frames
@@ -759,7 +760,10 @@ is nil, ask the user where to save the desktop."
(unless (yes-or-no-p "Error while saving the desktop. Ignore? ")
(signal (car err) (cdr err))))))
;; If we own it, we don't anymore.
- (when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock))
+ (when (eq (emacs-pid) (desktop-owner))
+ ;; Allow exiting Emacs even if we can't delete the desktop file.
+ (ignore-error 'file-error
+ (desktop-release-lock)))
t)
;; ----------------------------------------------------------------------------
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 8d99d1a..a7bfae7 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -972,38 +972,26 @@ REGEXP is matched case-sensitively."
(defun dired-guess-default (files)
"Return a shell command, or a list of commands, appropriate for FILES.
See `dired-guess-shell-alist-user'."
-
(let* ((case-fold-search dired-guess-shell-case-fold-search)
- ;; Prepend the user's alist to the default alist.
- (alist (append dired-guess-shell-alist-user
- dired-guess-shell-alist-default))
- (file (car files))
- (flist (cdr files))
- elt regexp cmds)
-
- ;; Find the first match in the alist for first file in FILES.
- (while alist
- (setq elt (car alist)
- regexp (car elt)
- alist (cdr alist))
- (if (string-match-p regexp file)
- (setq cmds (cdr elt)
- alist nil)))
-
- ;; If more than one file, see if all of FILES match regular expression.
- (while (and flist
- (string-match-p regexp (car flist)))
- (setq flist (cdr flist)))
-
- ;; If flist is still non-nil, then do not guess since this means that not
- ;; all the files in FILES were matched by the regexp.
- (setq cmds (and (not flist) cmds))
-
- ;; Return commands or nil if flist is still non-nil.
- ;; Evaluate the commands in order that any logical testing will be done.
- (if (cdr cmds)
- (delete-dups (mapcar (lambda (cmd) (eval cmd `((file . ,file)))) cmds))
- (eval (car cmds) `((file . ,file)))))) ; single command
+ (programs
+ (delete-dups
+ (mapcar
+ (lambda (command)
+ (eval command `((file . ,(car files)))))
+ (seq-reduce
+ #'append
+ (mapcar #'cdr
+ (seq-filter (lambda (elem)
+ (seq-every-p
+ (lambda (file)
+ (string-match-p (car elem) file))
+ files))
+ (append dired-guess-shell-alist-user
+ dired-guess-shell-alist-default)))
+ nil)))))
+ (if (length= programs 1)
+ (car programs)
+ programs)))
(defun dired-guess-shell-command (prompt files)
"Ask user with PROMPT for a shell command, guessing a default from FILES."
diff --git a/lisp/dired.el b/lisp/dired.el
index 9ddd2c5..28448be 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -163,7 +163,7 @@ always set this variable to t."
:type 'boolean
:group 'dired-mark)
-(defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`#")
+(defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`\\.?#")
"Regexp of files to skip when finding first file of a directory.
A value of nil means move to the subdir line.
A value of t means move to first file."
@@ -356,6 +356,11 @@ is anywhere on its Dired line, except the beginning of the
line."
:group 'dired
:version "28.1")
+(defcustom dired-kill-when-opening-new-dired-buffer nil
+ "If non-nil, kill the current buffer when selecting a new directory."
+ :type 'boolean
+ :version "28.1")
+
;;; Internal variables
@@ -615,6 +620,31 @@ Subexpression 2 must end right before the \\n.")
(list dired-re-dir
'(".+" (dired-move-to-filename) nil (0 dired-directory-face)))
;;
+ ;; Files suffixed with `completion-ignored-extensions'.
+ '(eval .
+ ;; It is quicker to first find just an extension, then go back to the
+ ;; start of that file name. So we do this complex MATCH-ANCHORED form.
+ (list (concat
+ "\\(" (regexp-opt completion-ignored-extensions)
+ "\\|#\\|\\.#.+\\)$")
+ '(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
+ ;;
+ ;; Files suffixed with `completion-ignored-extensions'
+ ;; plus a character put in by -F.
+ '(eval .
+ (list (concat "\\(" (regexp-opt completion-ignored-extensions)
+ "\\|#\\|\\.#.+\\)[*=|]$")
+ '(".+" (progn
+ (end-of-line)
+ ;; If the last character is not part of the filename,
+ ;; move back to the start of the filename
+ ;; so it can be fontified.
+ ;; Otherwise, leave point at the end of the line;
+ ;; that way, nothing is fontified.
+ (unless (get-text-property (1- (point)) 'mouse-face)
+ (dired-move-to-filename)))
+ nil (0 dired-ignored-face))))
+ ;;
;; Broken Symbolic link.
(list dired-re-sym
(list (lambda (end)
@@ -659,29 +689,6 @@ Subexpression 2 must end right before the \\n.")
(list dired-re-special
'(".+" (dired-move-to-filename) nil (0 'dired-special)))
;;
- ;; Files suffixed with `completion-ignored-extensions'.
- '(eval .
- ;; It is quicker to first find just an extension, then go back to the
- ;; start of that file name. So we do this complex MATCH-ANCHORED form.
- (list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$")
- '(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
- ;;
- ;; Files suffixed with `completion-ignored-extensions'
- ;; plus a character put in by -F.
- '(eval .
- (list (concat "\\(" (regexp-opt completion-ignored-extensions)
- "\\|#\\)[*=|]$")
- '(".+" (progn
- (end-of-line)
- ;; If the last character is not part of the filename,
- ;; move back to the start of the filename
- ;; so it can be fontified.
- ;; Otherwise, leave point at the end of the line;
- ;; that way, nothing is fontified.
- (unless (get-text-property (1- (point)) 'mouse-face)
- (dired-move-to-filename)))
- nil (0 dired-ignored-face))))
- ;;
;; Explicitly put the default face on file names ending in a colon to
;; avoid fontifying them as directory header.
(list (concat dired-re-maybe-mark dired-re-inode-size dired-re-perms ".*:$")
@@ -2377,7 +2384,7 @@ directory in another window."
(progn
(if other-window
(dired-other-window up)
- (dired up))
+ (dired--find-possibly-alternative-file up))
(dired-goto-file dir)))))
(defun dired-get-file-for-visit ()
@@ -2401,7 +2408,16 @@ directory in another window."
(defun dired-find-file ()
"In Dired, visit the file or directory named on this line."
(interactive)
- (dired--find-file #'find-file (dired-get-file-for-visit)))
+ (dired--find-possibly-alternative-file (dired-get-file-for-visit)))
+
+(defun dired--find-possibly-alternative-file (file)
+ "Find FILE, but respect `dired-kill-when-opening-new-dired-buffer'."
+ (if (and dired-kill-when-opening-new-dired-buffer
+ (file-directory-p file))
+ (progn
+ (set-buffer-modified-p nil)
+ (dired--find-file #'find-alternate-file file))
+ (dired--find-file #'find-file file)))
(defun dired--find-file (find-file-function file)
"Call FIND-FILE-FUNCTION on FILE, but bind some relevant variables."
@@ -3834,13 +3850,13 @@ object files--just `.o' will mark more than you might
think."
when (stringp file)
sum (file-attribute-size (file-attributes file)))))
(if (zerop nmarked)
- (message "No marked files"))
- (message "%d marked file%s (%s total size)"
- nmarked
- (if (= nmarked 1)
- ""
- "s")
- (funcall byte-count-to-string-function size))))
+ (message "No marked files")
+ (message "%d marked file%s (%s total size)"
+ nmarked
+ (if (= nmarked 1)
+ ""
+ "s")
+ (funcall byte-count-to-string-function size)))))
(defun dired-mark-files-containing-regexp (regexp &optional marker-char)
"Mark all files with contents containing REGEXP for use in later commands.
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 7319a27..e641b28 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -180,6 +180,7 @@ An alternative for systems that do not support unc file
names is
(if dnd-open-file-other-window
(find-file-other-window f)
(find-file f))
+ (file-name-history--add f)
'private)
(error "Can not read %s" uri))))
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index b45984b..e9a2063 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -250,7 +250,10 @@ expression, in which case we want to handle forms
differently."
(custom-autoload ',varname ,file
,(condition-case nil
(null (plist-get props :set))
- (error nil))))))
+ (error nil)))
+ ;; Propagate the :safe property to the loaddefs file.
+ ,@(when-let ((safe (plist-get props :safe)))
+ `((put ',varname 'safe-local-variable ,safe))))))
((eq car 'defgroup)
;; In Emacs this is normally handled separately by cus-dep.el, but for
@@ -623,8 +626,8 @@ Don't try to split prefixes that are already longer than
that.")
(radix-tree-iter-mappings
(cdr x) (lambda (s _)
(push (concat prefix s) dropped)))
- (message "Not registering prefix \"%s\" from %s.
Affects: %S"
- prefix file dropped)
+ (message "%s:0: Warning: Not registering prefix \"%s\".
Affects: %S"
+ file prefix dropped)
nil))))
prefixes)))
`(register-definition-prefixes ,file ',(sort (delq nil strings)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 247fb91..76c2e80 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -657,33 +657,33 @@ The port (if any) is omitted. IP can be a string, as
well."
OP can be one of: unpack', (pack VAL), or (length VAL) where VAL
is the name of a variable that will hold the value we need to pack.")
-(cl-defmethod bindat--type (op (_ (eql byte)))
+(cl-defmethod bindat--type (op (_ (eql 'byte)))
(bindat--pcase op
('unpack `(bindat--unpack-u8))
(`(length . ,_) `(cl-incf bindat-idx 1))
(`(pack . ,args) `(bindat--pack-u8 . ,args))))
-(cl-defmethod bindat--type (op (_ (eql uint)) n)
+(cl-defmethod bindat--type (op (_ (eql 'uint)) n)
(if (eq n 8) (bindat--type op 'byte)
(bindat--pcase op
('unpack `(bindat--unpack-uint ,n))
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
(`(pack . ,args) `(bindat--pack-uint ,n . ,args)))))
-(cl-defmethod bindat--type (op (_ (eql uintr)) n)
+(cl-defmethod bindat--type (op (_ (eql 'uintr)) n)
(if (eq n 8) (bindat--type op 'byte)
(bindat--pcase op
('unpack `(bindat--unpack-uintr ,n))
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
(`(pack . ,args) `(bindat--pack-uintr ,n . ,args)))))
-(cl-defmethod bindat--type (op (_ (eql str)) len)
+(cl-defmethod bindat--type (op (_ (eql 'str)) len)
(bindat--pcase op
('unpack `(bindat--unpack-str ,len))
(`(length . ,_) `(cl-incf bindat-idx ,len))
(`(pack . ,args) `(bindat--pack-str ,len . ,args))))
-(cl-defmethod bindat--type (op (_ (eql strz)) &optional len)
+(cl-defmethod bindat--type (op (_ (eql 'strz)) &optional len)
(bindat--pcase op
('unpack `(bindat--unpack-strz ,len))
(`(length ,val)
@@ -701,25 +701,25 @@ is the name of a variable that will hold the value we
need to pack.")
(bindat--pack-str ,len . ,args)
(bindat--pack-strz . ,args))))))
-(cl-defmethod bindat--type (op (_ (eql bits)) len)
+(cl-defmethod bindat--type (op (_ (eql 'bits)) len)
(bindat--pcase op
('unpack `(bindat--unpack-bits ,len))
(`(length . ,_) `(cl-incf bindat-idx ,len))
(`(pack . ,args) `(bindat--pack-bits ,len . ,args))))
-(cl-defmethod bindat--type (_op (_ (eql fill)) len)
+(cl-defmethod bindat--type (_op (_ (eql 'fill)) len)
`(progn (cl-incf bindat-idx ,len) nil))
-(cl-defmethod bindat--type (_op (_ (eql align)) len)
+(cl-defmethod bindat--type (_op (_ (eql 'align)) len)
`(progn (cl-callf bindat--align bindat-idx ,len) nil))
-(cl-defmethod bindat--type (op (_ (eql type)) exp)
+(cl-defmethod bindat--type (op (_ (eql 'type)) exp)
(bindat--pcase op
('unpack `(funcall (bindat--type-ue ,exp)))
(`(length . ,args) `(funcall (bindat--type-le ,exp) . ,args))
(`(pack . ,args) `(funcall (bindat--type-pe ,exp) . ,args))))
-(cl-defmethod bindat--type (op (_ (eql vec)) count &rest type)
+(cl-defmethod bindat--type (op (_ (eql 'vec)) count &rest type)
(unless type (setq type '(byte)))
(let ((fun (macroexpand-all (bindat--fun type) macroexpand-all-environment)))
(bindat--pcase op
@@ -743,10 +743,10 @@ is the name of a variable that will hold the value we
need to pack.")
`(dotimes (bindat--i ,count)
(funcall ,fun (elt ,val bindat--i)))))))
-(cl-defmethod bindat--type (op (_ (eql unit)) val)
+(cl-defmethod bindat--type (op (_ (eql 'unit)) val)
(pcase op ('unpack val) (_ nil)))
-(cl-defmethod bindat--type (op (_ (eql struct)) &rest args)
+(cl-defmethod bindat--type (op (_ (eql 'struct)) &rest args)
(apply #'bindat--type op args))
(cl-defmethod bindat--type (op (_ (eql :pack-var)) var &rest fields)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 2fff0bd..6475f69 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -274,6 +274,7 @@ Earlier variables shadow later ones with the same name.")
((pred byte-code-function-p)
;; (message "Inlining byte-code for %S!" 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 . ,_))
;; While byte-compile-unfold-bcf can inline dynbind byte-code into
@@ -300,21 +301,15 @@ Earlier variables shadow later ones with the same name.")
;; surrounded the `defsubst'.
(byte-compile-warnings nil))
(byte-compile name))
- `(,(symbol-function name) ,@(cdr form))))
+ (let ((bc (symbol-function name)))
+ (byte-compile--check-arity-bytecode form bc)
+ `(,bc ,@(cdr form)))))
(_ ;; Give up on inlining.
form))))
;;; implementing source-level optimizers
-(defconst byte-optimize-enable-variable-constprop t
- "If non-nil, enable constant propagation through local variables.")
-
-(defconst byte-optimize-warn-eliminated-variable nil
- "Whether to warn when a variable is optimised away entirely.
-This does usually not indicate a problem and makes the compiler
-very chatty, but can be useful for debugging.")
-
(defvar byte-optimize--vars-outside-condition nil
"Alist of variables lexically bound outside conditionally executed code.
Variables here are sensitive to mutation inside the conditional code,
@@ -399,22 +394,27 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
((and for-effect
(or byte-compile-delete-errors
(not (symbolp form))
- (eq form t)))
+ (eq form t)
+ (keywordp form)))
nil)
((symbolp form)
(let ((lexvar (assq form byte-optimize--lexvars)))
- (if (cddr lexvar) ; Value available?
- (if (assq form byte-optimize--vars-outside-loop)
- ;; Cannot substitute; mark for retention to avoid the
- ;; variable being eliminated.
- (progn
- (setcar (cdr lexvar) t)
- form)
- (caddr lexvar)) ; variable value to use
- form)))
+ (cond
+ ((not lexvar) form)
+ (for-effect nil)
+ ((cddr lexvar) ; Value available?
+ (if (assq form byte-optimize--vars-outside-loop)
+ ;; Cannot substitute; mark for retention to avoid the
+ ;; variable being eliminated.
+ (progn
+ (setcar (cdr lexvar) t)
+ form)
+ ;; variable value to use
+ (caddr lexvar)))
+ (t form))))
(t form)))
(`(quote . ,v)
- (if (cdr v)
+ (if (or (not v) (cdr v))
(byte-compile-warn "malformed quote form: `%s'"
(prin1-to-string form)))
;; Map (quote nil) to nil to simplify optimizer logic.
@@ -444,10 +444,13 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(macroexp-progn (byte-optimize-body exps for-effect))
(byte-optimize-form (car exps) for-effect)))
(`(prog1 ,exp . ,exps)
- (if exps
- `(prog1 ,(byte-optimize-form exp for-effect)
- . ,(byte-optimize-body exps t))
- (byte-optimize-form exp for-effect)))
+ (let ((exp-opt (byte-optimize-form exp for-effect)))
+ (if exps
+ (let ((exps-opt (byte-optimize-body exps t)))
+ (if (macroexp-const-p exp-opt)
+ `(progn ,@exps-opt ,exp-opt)
+ `(prog1 ,exp-opt ,@exps-opt)))
+ exp-opt)))
(`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps)
;; Those subrs which have an implicit progn; it's not quite good
@@ -564,7 +567,7 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
;; computed for effect. We want to avoid the warnings
;; that might occur if they were treated that way.
;; However, don't actually bother calling `ignore'.
- `(prog1 nil . ,(mapcar #'byte-optimize-form exps)))
+ `(progn ,@(mapcar #'byte-optimize-form exps) nil))
;; Needed as long as we run byte-optimize-form after cconv.
(`(internal-make-closure . ,_)
@@ -598,15 +601,9 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(lexvar (assq var byte-optimize--lexvars))
(value (byte-optimize-form expr nil)))
(when lexvar
- ;; Set a new value or inhibit further substitution.
- (setcdr (cdr lexvar)
- (and
- ;; Inhibit if bound outside conditional code.
- (not (assq var byte-optimize--vars-outside-condition))
- ;; The new value must be substitutable.
- (byte-optimize--substitutable-p value)
- (list value)))
- (setcar (cdr lexvar) t)) ; Mark variable to be kept.
+ (setcar (cdr lexvar) t) ; Mark variable to be kept.
+ (setcdr (cdr lexvar) nil)) ; Inhibit further substitution.
+
(push var var-expr-list)
(push value var-expr-list))
(setq args (cddr args)))
@@ -649,8 +646,15 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(byte-optimize-constant-args form)
form))))))
-(defun byte-optimize-form (form &optional for-effect)
+(defun byte-optimize-one-form (form &optional for-effect)
"The source-level pass of the optimizer."
+ ;; Make optimiser aware of lexical arguments.
+ (let ((byte-optimize--lexvars
+ (mapcar (lambda (v) (list (car v) t))
+ byte-compile--lexical-environment)))
+ (byte-optimize-form form for-effect)))
+
+(defun byte-optimize-form (form &optional for-effect)
(while
(progn
;; First, optimize all sub-forms of this one.
@@ -667,40 +671,30 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(byte-compile-log " %s\t==>\t%s" old new)
(setq form new)
(not (eq new old))))))))
- ;; Normalise (quote nil) to nil, for a single representation of constant nil.
- (and (not (equal form '(quote nil))) form))
+ form)
(defun byte-optimize-let-form (head form for-effect)
;; Recursively enter the optimizer for the bindings and body
;; of a let or let*. This for depth-firstness: forms that
;; are more deeply nested are optimized first.
- (if (and lexical-binding byte-optimize-enable-variable-constprop)
+ (if lexical-binding
(let* ((byte-optimize--lexvars byte-optimize--lexvars)
(new-lexvars nil)
(let-vars nil))
(dolist (binding (car form))
- (let (name expr)
- (cond ((consp binding)
- (setq name (car binding))
- (unless (symbolp name)
- (byte-compile-warn "let-bind nonvariable: `%S'" name))
- (setq expr (byte-optimize-form (cadr binding) nil)))
- ((symbolp binding)
- (setq name binding))
- (t (byte-compile-warn "malformed let binding: `%S'"
binding)))
- (let* (
- (value (and (byte-optimize--substitutable-p expr)
- (list expr)))
- (lexical (not (or (and (symbolp name)
- (special-variable-p name))
- (memq name byte-compile-bound-variables)
- (memq name byte-optimize--dynamic-vars))))
- (lexinfo (and lexical (cons name (cons nil value)))))
- (push (cons name (cons expr (cdr lexinfo))) let-vars)
- (when lexinfo
- (push lexinfo (if (eq head 'let*)
- byte-optimize--lexvars
- new-lexvars))))))
+ (let* ((name (car binding))
+ (expr (byte-optimize-form (cadr binding) nil))
+ (value (and (byte-optimize--substitutable-p expr)
+ (list expr)))
+ (lexical (not (or (special-variable-p name)
+ (memq name byte-compile-bound-variables)
+ (memq name byte-optimize--dynamic-vars))))
+ (lexinfo (and lexical (cons name (cons nil value)))))
+ (push (cons name (cons expr (cdr lexinfo))) let-vars)
+ (when lexinfo
+ (push lexinfo (if (eq head 'let*)
+ byte-optimize--lexvars
+ new-lexvars)))))
(setq byte-optimize--lexvars
(append new-lexvars byte-optimize--lexvars))
;; Walk the body expressions, which may mutate some of the records,
@@ -710,10 +704,8 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(bindings nil))
(dolist (var let-vars)
;; VAR is (NAME EXPR [KEEP [VALUE]])
- (if (and (nthcdr 3 var) (not (nth 2 var)))
- ;; Value present and not marked to be kept: eliminate.
- (when byte-optimize-warn-eliminated-variable
- (byte-compile-warn "eliminating local variable %S" (car
var)))
+ (when (or (not (nthcdr 3 var)) (nth 2 var))
+ ;; Value not present, or variable marked to be kept.
(push (list (nth 0 var) (nth 1 var)) bindings)))
(cons bindings opt-body)))
@@ -969,6 +961,11 @@ See Info node `(elisp) Integer Basics'."
;; Arity errors reported elsewhere.
form)))
+(defun byte-optimize-eq (form)
+ (pcase (cdr form)
+ ((or `(,x nil) `(nil ,x)) `(not ,x))
+ (_ (byte-optimize-binary-predicate form))))
+
(defun byte-optimize-member (form)
;; Replace `member' or `memql' with `memq' if the first arg is a symbol,
;; or the second arg is a list of symbols. Same with fixnums.
@@ -1056,7 +1053,7 @@ See Info node `(elisp) Integer Basics'."
(put 'min 'byte-optimizer #'byte-optimize-min-max)
(put '= 'byte-optimizer #'byte-optimize-binary-predicate)
-(put 'eq 'byte-optimizer #'byte-optimize-binary-predicate)
+(put 'eq 'byte-optimizer #'byte-optimize-eq)
(put 'eql 'byte-optimizer #'byte-optimize-equal)
(put 'equal 'byte-optimizer #'byte-optimize-equal)
(put 'string= 'byte-optimizer #'byte-optimize-binary-predicate)
@@ -1072,7 +1069,7 @@ See Info node `(elisp) Integer Basics'."
(defun byte-optimize-quote (form)
(if (or (consp (nth 1 form))
(and (symbolp (nth 1 form))
- (not (macroexp--const-symbol-p form))))
+ (not (macroexp--const-symbol-p (nth 1 form)))))
form
(nth 1 form)))
@@ -1233,18 +1230,31 @@ See Info node `(elisp) Integer Basics'."
(put 'let 'byte-optimizer #'byte-optimize-letX)
(put 'let* 'byte-optimizer #'byte-optimize-letX)
(defun byte-optimize-letX (form)
- (cond ((null (nth 1 form))
- ;; No bindings
- (cons 'progn (cdr (cdr form))))
- ((or (nth 2 form) (nthcdr 3 form))
- form)
- ;; The body is nil
- ((eq (car form) 'let)
- (append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form)))
- '(nil)))
- (t
- (let ((binds (reverse (nth 1 form))))
- (list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil)))))
+ (pcase form
+ ;; No bindings.
+ (`(,_ () . ,body)
+ `(progn . ,body))
+
+ ;; Body is empty or just contains a constant.
+ (`(,head ,bindings . ,(or '() `(,(and const (pred macroexp-const-p)))))
+ (if (eq head 'let)
+ `(progn ,@(mapcar (lambda (binding)
+ (and (consp binding) (cadr binding)))
+ bindings)
+ ,const)
+ `(let* ,(butlast bindings) ,(cadar (last bindings)) ,const)))
+
+ ;; Body is last variable.
+ (`(,head ,bindings ,(and var (pred symbolp) (pred (not keywordp))
+ (pred (not booleanp))
+ (guard (eq var (caar (last bindings))))))
+ (if (eq head 'let)
+ `(progn ,@(mapcar (lambda (binding)
+ (and (consp binding) (cadr binding)))
+ bindings))
+ `(let* ,(butlast bindings) ,(cadar (last bindings)))))
+
+ (_ form)))
(put 'nth 'byte-optimizer #'byte-optimize-nth)
@@ -1332,6 +1342,7 @@ See Info node `(elisp) Integer Basics'."
elt encode-char exp expt encode-time error-message-string
fboundp fceiling featurep ffloor
file-directory-p file-exists-p file-locked-p file-name-absolute-p
+ file-name-concat
file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
float float-time floor format format-time-string frame-first-window
frame-root-window frame-selected-window
@@ -1346,6 +1357,7 @@ See Info node `(elisp) Integer Basics'."
local-variable-if-set-p local-variable-p locale-info
log log10 logand logb logcount logior lognot logxor lsh
make-byte-code make-list make-string make-symbol mark marker-buffer max
+ match-beginning match-end
member memq memql min minibuffer-selected-window minibuffer-window
mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string
parse-colon-path plist-get plist-member
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 3e65db4..7bd642d 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -192,7 +192,7 @@ otherwise adds \".elc\"."
(autoload 'byte-compile-inline-expand "byte-opt")
;; This is the entry point to the lapcode optimizer pass1.
-(autoload 'byte-optimize-form "byte-opt")
+(autoload 'byte-optimize-one-form "byte-opt")
;; This is the entry point to the lapcode optimizer pass2.
(autoload 'byte-optimize-lapcode "byte-opt")
@@ -1477,6 +1477,30 @@ when printing the error message."
(push (list f byte-compile-last-position nargs)
byte-compile-unresolved-functions)))))
+(defun byte-compile-emit-callargs-warn (name actual-args min-args max-args)
+ (byte-compile-set-symbol-position name)
+ (byte-compile-warn
+ "%s called with %d argument%s, but %s %s"
+ name actual-args
+ (if (= 1 actual-args) "" "s")
+ (if (< actual-args min-args)
+ "requires"
+ "accepts only")
+ (byte-compile-arglist-signature-string (cons min-args max-args))))
+
+(defun byte-compile--check-arity-bytecode (form bytecode)
+ "Check that the call in FORM matches that allowed by BYTECODE."
+ (when (and (byte-code-function-p bytecode)
+ (byte-compile-warning-enabled-p 'callargs))
+ (let* ((actual-args (length (cdr form)))
+ (arity (func-arity bytecode))
+ (min-args (car arity))
+ (max-args (and (numberp (cdr arity)) (cdr arity))))
+ (when (or (< actual-args min-args)
+ (and max-args (> actual-args max-args)))
+ (byte-compile-emit-callargs-warn
+ (car form) actual-args min-args max-args)))))
+
;; Warn if the form is calling a function with the wrong number of arguments.
(defun byte-compile-callargs-warn (form)
(let* ((def (or (byte-compile-fdefinition (car form) nil)
@@ -1491,16 +1515,9 @@ when printing the error message."
(setcdr sig nil))
(if sig
(when (or (< ncall (car sig))
- (and (cdr sig) (> ncall (cdr sig))))
- (byte-compile-set-symbol-position (car form))
- (byte-compile-warn
- "%s called with %d argument%s, but %s %s"
- (car form) ncall
- (if (= 1 ncall) "" "s")
- (if (< ncall (car sig))
- "requires"
- "accepts only")
- (byte-compile-arglist-signature-string sig))))
+ (and (cdr sig) (> ncall (cdr sig))))
+ (byte-compile-emit-callargs-warn
+ (car form) ncall (car sig) (cdr sig))))
(byte-compile-format-warn form)
(byte-compile-function-warn (car form) (length (cdr form)) def)))
@@ -1627,7 +1644,7 @@ the `\\\\=[command]' ones that are assumed to be of length
`byte-compile--wide-docstring-substitution-len'. Also ignore
URLs."
(string-match
- (format "^.\\{%s,\\}$" (int-to-string (1+ col)))
+ (format "^.\\{%d,\\}$" (min (1+ col) #xffff)) ; Heed RE_DUP_MAX.
(replace-regexp-in-string
(rx (or
;; Ignore some URLs.
@@ -1840,8 +1857,8 @@ also be compiled."
(while directories
(setq directory (car directories))
(message "Checking %s..." directory)
- (dolist (file (directory-files directory))
- (let ((source (expand-file-name file directory)))
+ (dolist (source (directory-files directory t))
+ (let ((file (file-name-nondirectory source)))
(if (file-directory-p source)
(and (not (member file '("RCS" "CVS")))
(not (eq ?\. (aref file 0)))
@@ -1857,8 +1874,7 @@ also be compiled."
(file-readable-p source)
(not (string-match "\\`\\.#" file))
(not (auto-save-file-name-p source))
- (not (string-equal dir-locals-file
- (file-name-nondirectory source))))
+ (not (member source (dir-locals--all-files
directory))))
(progn (cl-incf
(pcase (byte-recompile-file source force arg)
('no-byte-compile skip-count)
@@ -2439,7 +2455,7 @@ list that represents a doc string reference.
(defun byte-compile-keep-pending (form &optional handler)
(if (memq byte-optimize '(t source))
- (setq form (byte-optimize-form form t)))
+ (setq form (byte-optimize-one-form form t)))
(if handler
(let ((byte-compile--for-effect t))
;; To avoid consing up monstrously large forms at load time, we split
@@ -3139,7 +3155,7 @@ for symbols generated by the byte compiler itself."
(byte-compile-output nil)
(byte-compile-jump-tables nil))
(if (memq byte-optimize '(t source))
- (setq form (byte-optimize-form form byte-compile--for-effect)))
+ (setq form (byte-optimize-one-form form byte-compile--for-effect)))
(while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
(setq form (nth 1 form)))
;; Set up things for a lexically-bound function.
@@ -4341,6 +4357,17 @@ Return (TAIL VAR TEST CASES), where:
(push value keys)
(push (cons (list value) (or body '(t))) cases))
t))))
+ ;; Treat (not X) as (eq X nil).
+ (`((,(or 'not 'null) ,(and var (pred symbolp))) . ,body)
+ (and (or (eq var switch-var) (not switch-var))
+ (progn
+ (setq switch-var var)
+ (setq switch-test
+ (byte-compile--common-test switch-test 'eq))
+ (unless (memq nil keys)
+ (push nil keys)
+ (push (cons (list nil) (or body '(t))) cases))
+ t)))
(`((,(and fn (or 'memq 'memql 'member)) ,var ,expr) . ,body)
(and (symbolp var)
(or (eq var switch-var) (not switch-var))
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index f663710..3abbf71 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -286,7 +286,7 @@ of converted forms."
(let (and (pred stringp) msg)
(cconv--warn-unused-msg arg "argument")))
(if (assq arg env) (push `(,arg . nil) env)) ;FIXME: Is it needed?
- (push (lambda (body) (macroexp--warn-wrap msg body)) wrappers))
+ (push (lambda (body) (macroexp--warn-wrap msg body 'lexical))
wrappers))
(_
(if (assq arg env) (push `(,arg . nil) env)))))
(setq funcbody (mapcar (lambda (form)
@@ -357,81 +357,91 @@ places where they originally did not directly appear."
"Malformed `%S' binding: %S"
letsym binder))
(setq value (cadr binder))
- (car binder)))
- (new-val
- (pcase (cconv--var-classification binder form)
- ;; Check if var is a candidate for lambda lifting.
- ((and :lambda-candidate
- (guard
- (progn
- (cl-assert (and (eq (car value) 'function)
- (eq (car (cadr value)) 'lambda)))
- (cl-assert (equal (cddr (cadr value))
- (caar cconv-freevars-alist)))
- ;; Peek at the freevars to decide whether to
λ-lift.
- (let* ((fvs (cdr (car cconv-freevars-alist)))
- (fun (cadr value))
- (funargs (cadr fun))
- (funcvars (append fvs funargs)))
+ (car binder))))
+ (cond
+ ;; Ignore bindings without a valid name.
+ ((not (symbolp var))
+ (byte-compile-warn "attempt to let-bind nonvariable `%S'" var))
+ ((or (booleanp var) (keywordp var))
+ (byte-compile-warn "attempt to let-bind constant `%S'" var))
+ (t
+ (let ((new-val
+ (pcase (cconv--var-classification binder form)
+ ;; Check if var is a candidate for lambda lifting.
+ ((and :lambda-candidate
+ (guard
+ (progn
+ (cl-assert (and (eq (car value) 'function)
+ (eq (car (cadr value))
'lambda)))
+ (cl-assert (equal (cddr (cadr value))
+ (caar cconv-freevars-alist)))
+ ;; Peek at the freevars to decide whether
+ ;; to λ-lift.
+ (let* ((fvs (cdr (car cconv-freevars-alist)))
+ (fun (cadr value))
+ (funargs (cadr fun))
+ (funcvars (append fvs funargs)))
; lambda lifting condition
- (and fvs (>= cconv-liftwhen
- (length funcvars)))))))
+ (and fvs (>= cconv-liftwhen
+ (length funcvars)))))))
; Lift.
- (let* ((fvs (cdr (pop cconv-freevars-alist)))
- (fun (cadr value))
- (funargs (cadr fun))
- (funcvars (append fvs funargs))
- (funcbody (cddr fun))
- (funcbody-env ()))
- (push `(,var . (apply-partially ,var . ,fvs)) new-env)
- (dolist (fv fvs)
- (cl-pushnew fv new-extend)
- (if (and (eq 'car-safe (car-safe (cdr (assq fv env))))
- (not (memq fv funargs)))
- (push `(,fv . (car-safe ,fv)) funcbody-env)))
- `(function (lambda ,funcvars .
- ,(cconv--convert-funcbody
- funargs funcbody funcbody-env value)))))
-
- ;; Check if it needs to be turned into a "ref-cell".
- (:captured+mutated
- ;; Declared variable is mutated and captured.
- (push `(,var . (car-safe ,var)) new-env)
- `(list ,(cconv-convert value env extend)))
-
- ;; Check if it needs to be turned into a "ref-cell".
- (:unused
- ;; Declared variable is unused.
- (if (assq var new-env) (push `(,var) new-env))
;FIXME:Needed?
- (let ((newval
- `(ignore ,(cconv-convert value env extend)))
- (msg (cconv--warn-unused-msg var "variable")))
- (if (null msg) newval
- (macroexp--warn-wrap msg newval))))
-
- ;; Normal default case.
- (_
- (if (assq var new-env) (push `(,var) new-env))
- (cconv-convert value env extend)))))
-
- (when (and (eq letsym 'let*) (memq var new-extend))
- ;; One of the lambda-lifted vars is shadowed, so add
- ;; a reference to the outside binding and arrange to use
- ;; that reference.
- (let ((closedsym (make-symbol (format "closed-%s" var))))
- (setq new-env (cconv--remap-llv new-env var closedsym))
- (setq new-extend (cons closedsym (remq var new-extend)))
- (push `(,closedsym ,var) binders-new)))
-
- ;; We push the element after redefined free variables are
- ;; processed. This is important to avoid the bug when free
- ;; variable and the function have the same name.
- (push (list var new-val) binders-new)
-
- (when (eq letsym 'let*)
- (setq env new-env)
- (setq extend new-extend))
- )) ; end of dolist over binders
+ (let* ((fvs (cdr (pop cconv-freevars-alist)))
+ (fun (cadr value))
+ (funargs (cadr fun))
+ (funcvars (append fvs funargs))
+ (funcbody (cddr fun))
+ (funcbody-env ()))
+ (push `(,var . (apply-partially ,var . ,fvs)) new-env)
+ (dolist (fv fvs)
+ (cl-pushnew fv new-extend)
+ (if (and (eq 'car-safe (car-safe
+ (cdr (assq fv env))))
+ (not (memq fv funargs)))
+ (push `(,fv . (car-safe ,fv)) funcbody-env)))
+ `(function (lambda ,funcvars .
+ ,(cconv--convert-funcbody
+ funargs funcbody funcbody-env
value)))))
+
+ ;; Check if it needs to be turned into a "ref-cell".
+ (:captured+mutated
+ ;; Declared variable is mutated and captured.
+ (push `(,var . (car-safe ,var)) new-env)
+ `(list ,(cconv-convert value env extend)))
+
+ ;; Check if it needs to be turned into a "ref-cell".
+ (:unused
+ ;; Declared variable is unused.
+ (if (assq var new-env)
+ (push `(,var) new-env)) ;FIXME:Needed?
+ (let ((newval
+ `(ignore ,(cconv-convert value env extend)))
+ (msg (cconv--warn-unused-msg var "variable")))
+ (if (null msg) newval
+ (macroexp--warn-wrap msg newval 'lexical))))
+
+ ;; Normal default case.
+ (_
+ (if (assq var new-env) (push `(,var) new-env))
+ (cconv-convert value env extend)))))
+
+ (when (and (eq letsym 'let*) (memq var new-extend))
+ ;; One of the lambda-lifted vars is shadowed, so add
+ ;; a reference to the outside binding and arrange to use
+ ;; that reference.
+ (let ((closedsym (make-symbol (format "closed-%s" var))))
+ (setq new-env (cconv--remap-llv new-env var closedsym))
+ (setq new-extend (cons closedsym (remq var new-extend)))
+ (push `(,closedsym ,var) binders-new)))
+
+ ;; We push the element after redefined free variables are
+ ;; processed. This is important to avoid the bug when free
+ ;; variable and the function have the same name.
+ (push (list var new-val) binders-new)
+
+ (when (eq letsym 'let*)
+ (setq env new-env)
+ (setq extend new-extend))))))
+ ) ; end of dolist over binders
(when (not (eq letsym 'let*))
;; We can't do the cconv--remap-llv at the same place for let and
@@ -506,7 +516,7 @@ places where they originally did not directly appear."
(newprotform (cconv-convert protected-form env extend)))
`(condition-case ,var
,(if msg
- (macroexp--warn-wrap msg newprotform)
+ (macroexp--warn-wrap msg newprotform 'lexical)
newprotform)
,@(mapcar
(lambda (handler)
@@ -598,14 +608,16 @@ FORM is the parent form that binds this var."
(`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_)
,_ ,_ ,_ ,_)
;; FIXME: Convert this warning to use `macroexp--warn-wrap'
- ;; so as to give better position information.
+ ;; so as to give better position information and obey
+ ;; `byte-compile-warnings'.
(byte-compile-warn
"%s `%S' not left unused" varkind var))
((and (let (or 'let* 'let) (car form))
`((,var) ;; (or `(,var nil) : Too many false positives: bug#47080
t nil ,_ ,_))
;; FIXME: Convert this warning to use `macroexp--warn-wrap'
- ;; so as to give better position information.
+ ;; so as to give better position information and obey
+ ;; `byte-compile-warnings'.
(unless (not (intern-soft var))
(byte-compile-warn "Variable `%S' left uninitialized" var))))
(pcase vardata
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 544704b..db5a5a0 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1158,7 +1158,17 @@ These match if the argument is a cons cell whose car is
`eql' to VAL."
(cl-defmethod cl-generic-generalizers ((specializer (head eql)))
"Support for (eql VAL) specializers.
These match if the argument is `eql' to VAL."
- (puthash (cadr specializer) specializer cl--generic-eql-used)
+ (let ((form (cadr specializer)))
+ (puthash (if (or (not (symbolp form)) (macroexp-const-p form))
+ (eval form t)
+ ;; FIXME: Compatibility with Emacs<28. For now emitting
+ ;; a warning would be annoying for third party packages
+ ;; which can't use the new form without breaking compatibility
+ ;; with older Emacsen, but in the future we should emit
+ ;; a warning.
+ ;; (message "Quoting obsolete `eql' form: %S" specializer)
+ form)
+ specializer cl--generic-eql-used))
(list cl--generic-eql-generalizer))
(cl--generic-prefill-dispatchers 0 (eql nil))
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 7f7eb96..317a4c6 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -515,111 +515,6 @@ the process stops as soon as KEYS or VALUES run out.
If ALIST is non-nil, the new pairs are prepended to it."
(nconc (cl-mapcar 'cons keys values) alist))
-;;; Generalized variables.
-
-;; These used to be in cl-macs.el since all macros that use them (like setf)
-;; were autoloaded from cl-macs.el. But now that setf, push, and pop are in
-;; core Elisp, they need to either be right here or be autoloaded via
-;; cl-loaddefs.el, which is more trouble than it is worth.
-
-;; Some more Emacs-related place types.
-(gv-define-simple-setter buffer-file-name set-visited-file-name t)
-(gv-define-setter buffer-modified-p (flag &optional buf)
- (macroexp-let2 nil buffer `(or ,buf (current-buffer))
- `(with-current-buffer ,buffer
- (set-buffer-modified-p ,flag))))
-(gv-define-simple-setter buffer-name rename-buffer t)
-(gv-define-setter buffer-string (store)
- `(insert (prog1 ,store (erase-buffer))))
-(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
-(gv-define-simple-setter current-buffer set-buffer)
-(gv-define-simple-setter current-column move-to-column t)
-(gv-define-simple-setter current-global-map use-global-map t)
-(gv-define-setter current-input-mode (store)
- `(progn (apply #'set-input-mode ,store) ,store))
-(gv-define-simple-setter current-local-map use-local-map t)
-(gv-define-simple-setter current-window-configuration
- set-window-configuration t)
-(gv-define-simple-setter default-file-modes set-default-file-modes t)
-(gv-define-simple-setter documentation-property put)
-(gv-define-setter face-background (x f &optional s)
- `(set-face-background ,f ,x ,s))
-(gv-define-setter face-background-pixmap (x f &optional s)
- `(set-face-background-pixmap ,f ,x ,s))
-(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s))
-(gv-define-setter face-foreground (x f &optional s)
- `(set-face-foreground ,f ,x ,s))
-(gv-define-setter face-underline-p (x f &optional s)
- `(set-face-underline ,f ,x ,s))
-(gv-define-simple-setter file-modes set-file-modes t)
-(gv-define-setter frame-height (x &optional frame)
- `(set-frame-height (or ,frame (selected-frame)) ,x))
-(gv-define-simple-setter frame-parameters modify-frame-parameters t)
-(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p)
-(gv-define-setter frame-width (x &optional frame)
- `(set-frame-width (or ,frame (selected-frame)) ,x))
-(gv-define-simple-setter getenv setenv t)
-(gv-define-simple-setter get-register set-register)
-(gv-define-simple-setter global-key-binding global-set-key)
-(gv-define-simple-setter local-key-binding local-set-key)
-(gv-define-simple-setter mark set-mark t)
-(gv-define-simple-setter mark-marker set-mark t)
-(gv-define-simple-setter marker-position set-marker t)
-(gv-define-setter mouse-position (store scr)
- `(set-mouse-position ,scr (car ,store) (cadr ,store)
- (cddr ,store)))
-(gv-define-simple-setter point goto-char)
-(gv-define-simple-setter point-marker goto-char t)
-(gv-define-setter point-max (store)
- `(progn (narrow-to-region (point-min) ,store) ,store))
-(gv-define-setter point-min (store)
- `(progn (narrow-to-region ,store (point-max)) ,store))
-(gv-define-setter read-mouse-position (store scr)
- `(set-mouse-position ,scr (car ,store) (cdr ,store)))
-(gv-define-simple-setter screen-height set-screen-height t)
-(gv-define-simple-setter screen-width set-screen-width t)
-(gv-define-simple-setter selected-window select-window)
-(gv-define-simple-setter selected-screen select-screen)
-(gv-define-simple-setter selected-frame select-frame)
-(gv-define-simple-setter standard-case-table set-standard-case-table)
-(gv-define-simple-setter syntax-table set-syntax-table)
-(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t)
-(gv-define-setter window-height (store)
- `(progn (enlarge-window (- ,store (window-height))) ,store))
-(gv-define-setter window-width (store)
- `(progn (enlarge-window (- ,store (window-width)) t) ,store))
-(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
-
-;; More complex setf-methods.
-
-;; This is a hack that allows (setf (eq a 7) B) to mean either
-;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
-;; This is useful when you have control over the PLACE but not over
-;; the VALUE, as is the case in define-minor-mode's :variable.
-;; It turned out that :variable needed more flexibility anyway, so
-;; this doesn't seem too useful now.
-(gv-define-expander eq
- (lambda (do place val)
- (gv-letplace (getter setter) place
- (macroexp-let2 nil val val
- (funcall do `(eq ,getter ,val)
- (lambda (v)
- `(cond
- (,v ,(funcall setter val))
- ((eq ,getter ,val) ,(funcall setter `(not ,val))))))))))
-
-(gv-define-expander substring
- (lambda (do place from &optional to)
- (gv-letplace (getter setter) place
- (macroexp-let2* nil ((start from) (end to))
- (funcall do `(substring ,getter ,start ,end)
- (lambda (v)
- (macroexp-let2 nil v v
- `(progn
- ,(funcall setter `(cl--set-substring
- ,getter ,start ,end ,v))
- ,v))))))))
-
;;; Miscellaneous.
(provide 'cl-lib)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index cff4368..caf8bba 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3623,6 +3623,14 @@ STRUCT and SLOT-NAME are symbols. INST is a structure
instance."
"use `with-eval-after-load' instead." "28.1")
(run-hooks 'cl-macs-load-hook)
+;;; Pcase type pattern.
+
+;;;###autoload
+(pcase-defmacro cl-type (type)
+ "Pcase pattern that matches objects of TYPE.
+TYPE is a type descriptor as accepted by `cl-typep', which see."
+ `(pred (pcase--flip cl-typep ',type)))
+
;; Local variables:
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 638d4b2..a04413b 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -3936,7 +3936,9 @@ display a message."
(concat "emacs-async-comp-"
(file-name-base source-file) "-")
nil ".el"))
- (expr-strings (mapcar #'prin1-to-string expr))
+ (expr-strings (let ((print-length nil)
+ (print-level nil))
+ (mapcar #'prin1-to-string expr)))
(_ (progn
(with-temp-file temp-file
(mapc #'insert expr-strings))
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index 6ba2e78..d2e4891 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -144,11 +144,16 @@ This function sets the match-data that
`copyright-update-year' uses."
(with-demoted-errors "Can't update copyright: %s"
;; (1) Need the extra \\( \\) around copyright-regexp because we
;; goto (match-end 1) below. See note (2) below.
- (copyright-re-search (concat "\\(" copyright-regexp
- "\\)\\([ \t]*\n\\)?.*\\(?:"
- copyright-names-regexp "\\)")
- (copyright-limit)
- t)))
+ (let ((regexp (concat "\\(" copyright-regexp
+ "\\)\\([ \t]*\n\\)?.*\\(?:"
+ copyright-names-regexp "\\)")))
+ (when (copyright-re-search regexp (copyright-limit) t)
+ ;; We may accidentally have landed in the middle of a
+ ;; copyright line, so re-perform the search without the
+ ;; search. (Otherwise we may be inserting the new year in the
+ ;; middle of the list of years.)
+ (goto-char (match-beginning 0))
+ (copyright-re-search regexp nil t)))))
(defun copyright-find-end ()
"Possibly adjust the search performed by `copyright-find-copyright'.
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 6ac76f1..712fa51 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -95,6 +95,8 @@ redefine OBJECT if it is a symbol."
(re-search-forward (concat "^.*"
(regexp-quote
(concat "<"
+ (when (eq system-type
'darwin)
+ "_")
(comp-c-func-name
(subr-name obj) "F" t)
">:"))))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 3a00fdb..8a2b3b4 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -497,8 +497,11 @@ on if the hook has explicitly disabled it.
,(concat (format "Toggle %s in all buffers.\n" pretty-name)
(internal--format-docstring-line
"With prefix ARG, enable %s if ARG is positive; otherwise, \
-disable it. If called from Lisp, enable the mode if ARG is omitted or
nil.\n\n"
+disable it.\n\n"
pretty-global-name)
+ "If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.\n\n"
(internal--format-docstring-line
"%s is enabled in all buffers where `%s' would do it.\n\n"
pretty-name turn-on)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 2aec819..7def9ff 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1731,7 +1731,7 @@ contains a circular object."
(defsubst edebug-match-body (cursor) (edebug-forms cursor))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&optional)) cursor specs)
;; Keep matching until one spec fails.
(edebug-&optional-wrapper cursor specs #'edebug-&optional-wrapper))
@@ -1755,7 +1755,7 @@ contains a circular object."
"Handle &foo spec operators.
&foo spec operators operate on all the subsequent SPECS.")
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&rest)) cursor specs)
;; Repeatedly use specs until failure.
(let (edebug-best-error
edebug-error-point)
@@ -1768,7 +1768,7 @@ contains a circular object."
(edebug-&optional-wrapper c (or s specs) rh)))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&or)) cursor specs)
;; Keep matching until one spec succeeds, and return its results.
;; If none match, fail.
;; This needs to be optimized since most specs spend time here.
@@ -1792,7 +1792,7 @@ contains a circular object."
(apply #'edebug-no-match cursor "Expected one of" original-specs))
))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &interpose)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&interpose)) cursor specs)
"Compute the specs for `&interpose SPEC FUN ARGS...'.
Extracts the head of the data by matching it against SPEC,
and then matches the rest by calling (FUN HEAD PF ARGS...)
@@ -1817,7 +1817,7 @@ a sequence of elements."
(append instrumented-head (edebug-match cursor newspecs)))
,@args))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql ¬)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '¬)) cursor specs)
;; If any specs match, then fail
(if (null (catch 'no-match
(let ((edebug-gate nil))
@@ -1829,7 +1829,7 @@ a sequence of elements."
;; This means nothing matched, so it is OK.
nil) ;; So, return nothing
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &key)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&key)) cursor specs)
;; Following specs must look like (<name> <spec>) ...
;; where <name> is the name of a keyword, and spec is its spec.
;; This really doesn't save much over the expanded form and takes time.
@@ -1842,7 +1842,7 @@ a sequence of elements."
(car (cdr pair))))
specs))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &error)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&error)) cursor specs)
;; Signal an error, using the following string in the spec as argument.
(let ((error-string (car specs))
(edebug-error-point (edebug-before-offset cursor)))
@@ -1942,7 +1942,7 @@ a sequence of elements."
(defun edebug-match-function (_cursor)
(error "Use function-form instead of function in edebug spec"))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &define)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&define)) cursor specs)
;; Match a defining form.
;; Normally, &define is interpreted specially other places.
;; This should only be called inside of a spec list to match the remainder
@@ -1958,7 +1958,7 @@ a sequence of elements."
;; Stop backtracking here (Bug#41988).
(setq edebug-gate t)))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&name)) cursor specs)
"Compute the name for `&name SPEC FUN` spec operator.
The full syntax of that operator is:
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 8f1e38b..b11ed33 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -742,7 +742,8 @@ Argument FN is the function calling this verifier."
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
- (format-message "Unknown slot `%S'" name) exp 'compile-only))
+ (format-message "Unknown slot `%S'" name)
+ exp nil 'compile-only))
(_ exp))))
(gv-setter eieio-oset))
(cl-check-type slot symbol)
@@ -777,12 +778,13 @@ Fills in CLASS's SLOT with its default value."
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
- (format-message "Unknown slot `%S'" name) exp 'compile-only))
+ (format-message "Unknown slot `%S'" name)
+ exp nil 'compile-only))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
(format-message "Slot `%S' is not class-allocated" name)
- exp 'compile-only))
+ exp nil 'compile-only))
(_ exp)))))
(cl-check-type class (or eieio-object class))
(cl-check-type slot symbol)
@@ -838,12 +840,13 @@ Fills in the default value in CLASS' in SLOT with VALUE."
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
- (format-message "Unknown slot `%S'" name) exp 'compile-only))
+ (format-message "Unknown slot `%S'" name)
+ exp nil 'compile-only))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
(format-message "Slot `%S' is not class-allocated" name)
- exp 'compile-only))
+ exp nil 'compile-only))
(_ exp)))))
(setq class (eieio--class-object class))
(cl-check-type class eieio--class)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 1c8c372..c16d8e1 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -53,6 +53,7 @@
(message eieio-version))
(require 'eieio-core)
+(eval-when-compile (require 'subr-x))
;;; Defining a new class
@@ -240,7 +241,8 @@ This method is obsolete."
))
`(progn
- ,@(mapcar (lambda (w) (macroexp-warn-and-return w `(progn ',w)
'compile-only))
+ ,@(mapcar (lambda (w)
+ (macroexp-warn-and-return w `(progn ',w) nil 'compile-only))
warnings)
;; This test must be created right away so we can have self-
;; referencing classes. ei, a class whose slot can contain only
@@ -740,31 +742,37 @@ Called from the constructor routine."
"Construct the new object THIS based on SLOTS.")
(cl-defmethod initialize-instance ((this eieio-default-superclass)
- &optional slots)
- "Construct the new object THIS based on SLOTS.
-SLOTS is a tagged list where odd numbered elements are tags, and
+ &optional args)
+ "Construct the new object THIS based on ARGS.
+ARGS is a property list where odd numbered elements are tags, and
even numbered elements are the values to store in the tagged slot.
If you overload the `initialize-instance', there you will need to
call `shared-initialize' yourself, or you can call `call-next-method'
to have this constructor called automatically. If these steps are
not taken, then new objects of your class will not have their values
-dynamically set from SLOTS."
- ;; First, see if any of our defaults are `lambda', and
- ;; re-evaluate them and apply the value to our slots.
+dynamically set from ARGS."
(let* ((this-class (eieio--object-class this))
+ (initargs args)
(slots (eieio--class-slots this-class)))
(dotimes (i (length slots))
- ;; For each slot, see if we need to evaluate it.
+ ;; For each slot, see if we need to evaluate its initform.
(let* ((slot (aref slots i))
+ (slot-name (eieio-slot-descriptor-name slot))
(initform (cl--slot-descriptor-initform slot)))
- ;; Those slots whose initform is constant already have the right
- ;; value set in the default-object.
- (unless (macroexp-const-p initform)
- ;; FIXME: We should be able to just do (aset this (+ i <cst>) dflt)!
- (eieio-oset this (cl--slot-descriptor-name slot)
- (eval initform t))))))
- ;; Shared initialize will parse our slots for us.
- (shared-initialize this slots))
+ (unless (or (when-let ((initarg
+ (car (rassq slot-name
+ (eieio--class-initarg-tuples
+ this-class)))))
+ (plist-get initargs initarg))
+ ;; Those slots whose initform is constant already have
+ ;; the right value set in the default-object.
+ (macroexp-const-p initform))
+ ;; FIXME: Use `aset' instead of `eieio-oset', relying on that
+ ;; vector returned by `eieio--class-slots'
+ ;; should be congruent with the object itself.
+ (eieio-oset this slot-name (eval initform t))))))
+ ;; Shared initialize will parse our args for us.
+ (shared-initialize this args))
(cl-defgeneric slot-missing (object slot-name _operation &optional _new-value)
"Method invoked when an attempt to access a slot in OBJECT fails.
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index f08f7ac..d6272a5 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -614,5 +614,105 @@ REF must have been previously obtained with `gv-ref'."
;; (,(nth 1 vars) (v) (funcall ',setter v)))
;; ,@body)))
+;;; Generalized variables.
+
+;; Some Emacs-related place types.
+(gv-define-simple-setter buffer-file-name set-visited-file-name t)
+(gv-define-setter buffer-modified-p (flag &optional buf)
+ (macroexp-let2 nil buffer `(or ,buf (current-buffer))
+ `(with-current-buffer ,buffer
+ (set-buffer-modified-p ,flag))))
+(gv-define-simple-setter buffer-name rename-buffer t)
+(gv-define-setter buffer-string (store)
+ `(insert (prog1 ,store (erase-buffer))))
+(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
+(gv-define-simple-setter current-buffer set-buffer)
+(gv-define-simple-setter current-column move-to-column t)
+(gv-define-simple-setter current-global-map use-global-map t)
+(gv-define-setter current-input-mode (store)
+ `(progn (apply #'set-input-mode ,store) ,store))
+(gv-define-simple-setter current-local-map use-local-map t)
+(gv-define-simple-setter current-window-configuration
+ set-window-configuration t)
+(gv-define-simple-setter default-file-modes set-default-file-modes t)
+(gv-define-simple-setter documentation-property put)
+(gv-define-setter face-background (x f &optional s)
+ `(set-face-background ,f ,x ,s))
+(gv-define-setter face-background-pixmap (x f &optional s)
+ `(set-face-background-pixmap ,f ,x ,s))
+(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s))
+(gv-define-setter face-foreground (x f &optional s)
+ `(set-face-foreground ,f ,x ,s))
+(gv-define-setter face-underline-p (x f &optional s)
+ `(set-face-underline ,f ,x ,s))
+(gv-define-simple-setter file-modes set-file-modes t)
+(gv-define-setter frame-height (x &optional frame)
+ `(set-frame-height (or ,frame (selected-frame)) ,x))
+(gv-define-simple-setter frame-parameters modify-frame-parameters t)
+(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p)
+(gv-define-setter frame-width (x &optional frame)
+ `(set-frame-width (or ,frame (selected-frame)) ,x))
+(gv-define-simple-setter getenv setenv t)
+(gv-define-simple-setter get-register set-register)
+(gv-define-simple-setter global-key-binding global-set-key)
+(gv-define-simple-setter local-key-binding local-set-key)
+(gv-define-simple-setter mark set-mark t)
+(gv-define-simple-setter mark-marker set-mark t)
+(gv-define-simple-setter marker-position set-marker t)
+(gv-define-setter mouse-position (store scr)
+ `(set-mouse-position ,scr (car ,store) (cadr ,store)
+ (cddr ,store)))
+(gv-define-simple-setter point goto-char)
+(gv-define-simple-setter point-marker goto-char t)
+(gv-define-setter point-max (store)
+ `(progn (narrow-to-region (point-min) ,store) ,store))
+(gv-define-setter point-min (store)
+ `(progn (narrow-to-region ,store (point-max)) ,store))
+(gv-define-setter read-mouse-position (store scr)
+ `(set-mouse-position ,scr (car ,store) (cdr ,store)))
+(gv-define-simple-setter screen-height set-screen-height t)
+(gv-define-simple-setter screen-width set-screen-width t)
+(gv-define-simple-setter selected-window select-window)
+(gv-define-simple-setter selected-screen select-screen)
+(gv-define-simple-setter selected-frame select-frame)
+(gv-define-simple-setter standard-case-table set-standard-case-table)
+(gv-define-simple-setter syntax-table set-syntax-table)
+(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t)
+(gv-define-setter window-height (store)
+ `(progn (enlarge-window (- ,store (window-height))) ,store))
+(gv-define-setter window-width (store)
+ `(progn (enlarge-window (- ,store (window-width)) t) ,store))
+(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
+
+;; More complex setf-methods.
+
+;; This is a hack that allows (setf (eq a 7) B) to mean either
+;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
+;; This is useful when you have control over the PLACE but not over
+;; the VALUE, as is the case in define-minor-mode's :variable.
+;; It turned out that :variable needed more flexibility anyway, so
+;; this doesn't seem too useful now.
+(gv-define-expander eq
+ (lambda (do place val)
+ (gv-letplace (getter setter) place
+ (macroexp-let2 nil val val
+ (funcall do `(eq ,getter ,val)
+ (lambda (v)
+ `(cond
+ (,v ,(funcall setter val))
+ ((eq ,getter ,val) ,(funcall setter `(not ,val))))))))))
+
+(gv-define-expander substring
+ (lambda (do place from &optional to)
+ (gv-letplace (getter setter) place
+ (macroexp-let2* nil ((start from) (end to))
+ (funcall do `(substring ,getter ,start ,end)
+ (lambda (v)
+ (macroexp-let2 nil v v
+ `(progn
+ ,(funcall setter `(cl--set-substring
+ ,getter ,start ,end ,v))
+ ,v))))))))
+
(provide 'gv)
;;; gv.el ends here
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index df86446..61c1ea4 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -135,15 +135,22 @@ Other uses risk returning non-nil value that point to the
wrong file."
(defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key))
-(defun macroexp--warn-wrap (msg form)
- (let ((when-compiled (lambda () (byte-compile-warn "%s" msg))))
+(defun macroexp--warn-wrap (msg form category)
+ (let ((when-compiled (lambda ()
+ (when (byte-compile-warning-enabled-p category)
+ (byte-compile-warn "%s" msg)))))
`(progn
(macroexp--funcall-if-compiled ',when-compiled)
,form)))
(define-obsolete-function-alias 'macroexp--warn-and-return
#'macroexp-warn-and-return "28.1")
-(defun macroexp-warn-and-return (msg form &optional compile-only)
+(defun macroexp-warn-and-return (msg form &optional category compile-only)
+ "Return code equivalent to FORM labeled with warning MSG.
+CATEGORY is the category of the warning, like the categories that
+can appear in `byte-compile-warnings'.
+COMPILE-ONLY non-nil means no warning should be emitted if the code
+is executed without being compiled first."
(cond
((null msg) form)
((macroexp-compiling-p)
@@ -153,7 +160,7 @@ Other uses risk returning non-nil value that point to the
wrong file."
;; macroexpand-all gets right back to macroexpanding `form'.
form
(puthash form form macroexp--warned)
- (macroexp--warn-wrap msg form)))
+ (macroexp--warn-wrap msg form category)))
(t
(unless compile-only
(message "%sWarning: %s"
@@ -205,9 +212,7 @@ Other uses risk returning non-nil value that point to the
wrong file."
(if (and (not (eq form new-form)) ;It was a macro call.
(car-safe form)
(symbolp (car form))
- (get (car form) 'byte-obsolete-info)
- (or (not (fboundp 'byte-compile-warning-enabled-p))
- (byte-compile-warning-enabled-p 'obsolete (car form))))
+ (get (car form) 'byte-obsolete-info))
(let* ((fun (car form))
(obsolete (get fun 'byte-obsolete-info)))
(macroexp-warn-and-return
@@ -215,7 +220,7 @@ Other uses risk returning non-nil value that point to the
wrong file."
fun obsolete
(if (symbolp (symbol-function fun))
"alias" "macro"))
- new-form))
+ new-form 'obsolete))
new-form)))
(defun macroexp--unfold-lambda (form &optional name)
@@ -318,16 +323,18 @@ Assumes the caller has bound
`macroexpand-all-environment'."
(`(,(or 'function 'quote) . ,_) form)
(`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
pcase--dontcare))
- (macroexp--cons fun
- (macroexp--cons (macroexp--all-clauses bindings 1)
- (if (null body)
- (macroexp-unprogn
- (macroexp-warn-and-return
- (format "Empty %s body" fun)
- nil t))
- (macroexp--all-forms body))
- (cdr form))
- form))
+ (macroexp--cons
+ fun
+ (macroexp--cons
+ (macroexp--all-clauses bindings 1)
+ (if (null body)
+ (macroexp-unprogn
+ (macroexp-warn-and-return
+ (format "Empty %s body" fun)
+ nil nil 'compile-only))
+ (macroexp--all-forms body))
+ (cdr form))
+ form))
(`(,(and fun `(lambda . ,_)) . ,args)
;; Embedded lambda in function position.
;; If the byte-optimizer is loaded, try to unfold this,
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 5c76fb9..c593428 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -407,15 +407,15 @@ See `map-into' for all supported values of TYPE."
"Convert MAP into a map of TYPE.")
;; FIXME: I wish there was a way to avoid this η-redex!
-(cl-defmethod map-into (map (_type (eql list)))
+(cl-defmethod map-into (map (_type (eql 'list)))
"Convert MAP into an alist."
(map-pairs map))
-(cl-defmethod map-into (map (_type (eql alist)))
+(cl-defmethod map-into (map (_type (eql 'alist)))
"Convert MAP into an alist."
(map-pairs map))
-(cl-defmethod map-into (map (_type (eql plist)))
+(cl-defmethod map-into (map (_type (eql 'plist)))
"Convert MAP into a plist."
(let (plist)
(map-do (lambda (k v) (setq plist `(,v ,k ,@plist))) map)
@@ -510,7 +510,7 @@ KEYWORD-ARGS are forwarded to `make-hash-table'."
map)
ht))
-(cl-defmethod map-into (map (_type (eql hash-table)))
+(cl-defmethod map-into (map (_type (eql 'hash-table)))
"Convert MAP into a hash-table with keys compared with `equal'."
(map--into-hash map (list :size (map-length map) :test #'equal)))
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
index f4f0313..1125dde 100644
--- a/lisp/emacs-lisp/memory-report.el
+++ b/lisp/emacs-lisp/memory-report.el
@@ -44,6 +44,8 @@ by counted more than once."
(pop-to-buffer "*Memory Report*")
(special-mode)
(button-mode 1)
+ (setq-local revert-buffer-function (lambda (_ignore-auto _noconfirm)
+ (memory-report)))
(setq truncate-lines t)
(message "Gathering data...")
(let ((reports (append (memory-report--garbage-collect)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index a0f1ab0..dfd2148 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1366,11 +1366,9 @@ errors signaled by ERROR-FORM or by BODY).
(kill-buffer buffer)
(goto-char (point-min))))))
(package--unless-error body
- (let ((url (expand-file-name file url)))
- (unless (file-name-absolute-p url)
- (error "Location %s is not a url nor an absolute file name"
- url))
- (insert-file-contents-literally url)))))
+ (unless (file-name-absolute-p url)
+ (error "Location %s is not a url nor an absolute file name" url))
+ (insert-file-contents-literally (expand-file-name file url)))))
(define-error 'bad-signature "Failed to verify signature")
@@ -2195,8 +2193,24 @@ Downloads and installs required packages as needed."
((derived-mode-p 'tar-mode)
(package-tar-file-info))
(t
- (save-excursion
- (package-buffer-info)))))
+ ;; Package headers should be parsed from decoded text
+ ;; (see Bug#48137) where possible.
+ (if (and (eq buffer-file-coding-system 'no-conversion)
+ buffer-file-name)
+ (let* ((package-buffer (current-buffer))
+ (decoding-system
+ (car (find-operation-coding-system
+ 'insert-file-contents
+ (cons buffer-file-name
+ package-buffer)))))
+ (with-temp-buffer
+ (insert-buffer-substring package-buffer)
+ (decode-coding-region (point-min) (point-max)
+ decoding-system)
+ (package-buffer-info)))
+
+ (save-excursion
+ (package-buffer-info))))))
(name (package-desc-name pkg-desc)))
;; Download and install the dependencies.
(let* ((requires (package-desc-reqs pkg-desc))
@@ -2222,6 +2236,7 @@ directory."
(setq default-directory file)
(dired-mode))
(insert-file-contents-literally file)
+ (set-visited-file-name file)
(when (string-match "\\.tar\\'" file) (tar-mode)))
(package-install-from-buffer)))
@@ -3954,9 +3969,14 @@ packages."
(package--ensure-package-menu-mode)
(if (or (not status) (string-empty-p status))
(package-menu--generate t t)
- (package-menu--filter-by (lambda (pkg-desc)
- (string-match-p status (package-desc-status pkg-desc)))
- (format "status:%s" status))))
+ (let ((status-list
+ (if (listp status)
+ status
+ (split-string status ","))))
+ (package-menu--filter-by
+ (lambda (pkg-desc)
+ (member (package-desc-status pkg-desc) status-list))
+ (format "status:%s" (string-join status-list ","))))))
(defun package-menu-filter-by-version (version predicate)
"Filter the \"*Packages*\" buffer by VERSION and PREDICATE.
@@ -4149,7 +4169,9 @@ activations need to be changed, such as when
`package-load-list' is modified."
;; Prefer uncompiled files (and don't accept .so files).
(let ((load-suffixes '(".el" ".elc")))
(locate-library (package--autoloads-file-name pkg))))
- (pfile (prin1-to-string file)))
+ (pfile (let ((print-length nil)
+ (print-level nil))
+ (prin1-to-string file))))
(insert "(let ((load-true-file-name " pfile ")\
(load-file-name " pfile "))\n")
(insert-file-contents file)
diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el
index fb65975..a529ed0 100644
--- a/lisp/emacs-lisp/radix-tree.el
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -240,7 +240,7 @@ PREFIX is only used internally."
(declare-function map-apply "map" (function map))
(defun radix-tree-from-map (map)
- ;; Aka (cl-defmethod map-into (map (type (eql radix-tree)))) ...)
+ ;; Aka (cl-defmethod map-into (map (type (eql 'radix-tree)))) ...)
(require 'map)
(let ((rt nil))
(map-apply (lambda (k v) (setq rt (radix-tree-insert rt k v))) map)
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 7d042a9..396949d 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -355,11 +355,16 @@ provided in the Commentary section of this library."
(reb-delete-overlays))
(setq reb-target-buffer (current-buffer)
reb-target-window (selected-window))
- (select-window (or (get-buffer-window reb-buffer)
- (progn
- (setq reb-window-config (current-window-configuration))
- (split-window (selected-window) (- (window-height)
4)))))
- (switch-to-buffer (get-buffer-create reb-buffer))
+ (select-window
+ (or (get-buffer-window reb-buffer)
+ (let ((dir (if (window-parameter nil 'window-side)
+ 'bottom 'down)))
+ (setq reb-window-config (current-window-configuration))
+ (display-buffer
+ (get-buffer-create reb-buffer)
+ `((display-buffer-in-direction)
+ (direction . ,dir)
+ (dedicated . t))))))
(font-lock-mode 1)
(reb-initialize-buffer)))
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 6c15463..e8fc4a2 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -394,14 +394,15 @@ found or not."
(setq count (+ 1 count))))
count))
-(cl-defgeneric seq-contains (sequence elt &optional testfn)
- "Return the first element in SEQUENCE that is equal to ELT.
+(with-suppressed-warnings ((obsolete seq-contains))
+ (cl-defgeneric seq-contains (sequence elt &optional testfn)
+ "Return the first element in SEQUENCE that is equal to ELT.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
- (declare (obsolete seq-contains-p "27.1"))
- (seq-some (lambda (e)
- (when (funcall (or testfn #'equal) elt e)
- e))
- sequence))
+ (declare (obsolete seq-contains-p "27.1"))
+ (seq-some (lambda (e)
+ (when (funcall (or testfn #'equal) elt e)
+ e))
+ sequence)))
(cl-defgeneric seq-contains-p (sequence elt &optional testfn)
"Return non-nil if SEQUENCE contains an element equal to ELT.
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index c1d0594..02f2ad3 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -115,9 +115,12 @@ See the documentation for `list-load-path-shadows' for
further information."
;; FILE now contains the current file name, with no suffix.
(unless (or (member file files-seen-this-dir)
;; Ignore these files.
- (member file (list "subdirs" "leim-list"
- (file-name-sans-extension
- dir-locals-file))))
+ (member file
+ (list "subdirs" "leim-list"
+ (file-name-sans-extension dir-locals-file)
+ (concat
+ (file-name-sans-extension dir-locals-file)
+ "-2"))))
;; File has not been seen yet in this directory.
;; This test prevents us declaring that XXX.el shadows
;; XXX.elc (or vice-versa) when they are in the same directory.
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 4df4040..a74a5a4 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -32,14 +32,6 @@
"Short documentation."
:group 'lisp)
-(defface shortdoc-separator
- '((((class color) (background dark))
- :height 0.1 :background "#505050" :extend t)
- (((class color) (background light))
- :height 0.1 :background "#a0a0a0" :extend t)
- (t :height 0.1 :inverse-video t :extend t))
- "Face used to separate sections.")
-
(defface shortdoc-heading
'((t :inherit variable-pitch :height 1.3 :weight bold))
"Face used for a heading."
@@ -162,6 +154,10 @@ There can be any number of :example/:result elements."
:eval (split-string "foo bar")
:eval (split-string "|foo|bar|" "|")
:eval (split-string "|foo|bar|" "|" t))
+ (split-string-and-unquote
+ :eval (split-string-and-unquote "foo \"bar zot\""))
+ (split-string-shell-command
+ :eval (split-string-shell-command "ls /tmp/'foo bar'"))
(string-lines
:eval (string-lines "foo\n\nbar")
:eval (string-lines "foo\n\nbar" t))
@@ -277,8 +273,16 @@ There can be any number of :example/:result elements."
:eval (file-relative-name "/tmp/foo" "/tmp"))
(make-temp-name
:eval (make-temp-name "/tmp/foo-"))
+ (file-name-concat
+ :eval (file-name-concat "/tmp/" "foo")
+ :eval (file-name-concat "/tmp" "foo")
+ :eval (file-name-concat "/tmp" "foo" "bar/" "zot")
+ :eval (file-name-concat "/tmp" "~"))
(expand-file-name
- :eval (expand-file-name "foo" "/tmp/"))
+ :eval (expand-file-name "foo" "/tmp/")
+ :eval (expand-file-name "foo" "/tmp///")
+ :eval (expand-file-name "foo" "/tmp/foo/.././")
+ :eval (expand-file-name "~" "/tmp/"))
(substitute-in-file-name
:eval (substitute-in-file-name "$HOME/foo"))
"Directory Functions"
@@ -499,9 +503,13 @@ There can be any number of :example/:result elements."
(flatten-tree
:eval (flatten-tree '(1 (2 3) 4)))
(car
- :eval (car '(one two three)))
+ :eval (car '(one two three))
+ :eval (car '(one . two))
+ :eval (car nil))
(cdr
- :eval (cdr '(one two three)))
+ :eval (cdr '(one two three))
+ :eval (cdr '(one . two))
+ :eval (cdr nil))
(last
:eval (last '(one two three)))
(butlast
@@ -1137,8 +1145,9 @@ There can be any number of :example/:result elements."
:eval (sqrt -1)))
;;;###autoload
-(defun shortdoc-display-group (group)
- "Pop to a buffer with short documentation summary for functions in GROUP."
+(defun shortdoc-display-group (group &optional function)
+ "Pop to a buffer with short documentation summary for functions in GROUP.
+If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)."
(interactive (list (completing-read "Show summary for functions in: "
(mapcar #'car shortdoc--groups))))
(when (stringp group)
@@ -1165,19 +1174,21 @@ There can be any number of :example/:result elements."
;; There may be functions not yet defined in the data.
((fboundp (car data))
(when prev
- (insert (propertize "\n" 'face 'shortdoc-separator)))
+ (insert (make-separator-line)))
(setq prev t)
(shortdoc--display-function data))))
(cdr (assq group shortdoc--groups))))
- (goto-char (point-min)))
+ (goto-char (point-min))
+ (when function
+ (text-property-search-forward 'shortdoc-function function t)
+ (beginning-of-line)))
(defun shortdoc--display-function (data)
(let ((function (pop data))
(start-section (point))
arglist-start)
;; Function calling convention.
- (insert (propertize "("
- 'shortdoc-function t))
+ (insert (propertize "(" 'shortdoc-function function))
(if (plist-get data :no-manual)
(insert-text-button
(symbol-name function)
@@ -1308,16 +1319,15 @@ Example:
(define-derived-mode shortdoc-mode special-mode "shortdoc"
"Mode for shortdoc.")
-(defmacro shortdoc--goto-section (arg sym &optional reverse)
- `(progn
- (unless (natnump ,arg)
- (setq ,arg 1))
- (while (< 0 ,arg)
- (,(if reverse
- 'text-property-search-backward
- 'text-property-search-forward)
- ,sym t)
- (setq ,arg (1- ,arg)))))
+(defun shortdoc--goto-section (arg sym &optional reverse)
+ (unless (natnump arg)
+ (setq arg 1))
+ (while (> arg 0)
+ (funcall
+ (if reverse 'text-property-search-backward
+ 'text-property-search-forward)
+ sym nil t t)
+ (setq arg (1- arg))))
(defun shortdoc-next (&optional arg)
"Move cursor to the next function.
diff --git a/lisp/emacs-lisp/tabulated-list.el
b/lisp/emacs-lisp/tabulated-list.el
index 0b10dfd..f0ee787 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -36,6 +36,8 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defgroup tabulated-list nil
"Tabulated-list customization group."
:group 'convenience
@@ -212,6 +214,8 @@ If ADVANCE is non-nil, move forward by one line afterwards."
special-mode-map))
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
+ (define-key map (kbd "M-<left>") 'tabulated-list-previous-column)
+ (define-key map (kbd "M-<right>") 'tabulated-list-next-column)
(define-key map "S" 'tabulated-list-sort)
(define-key map "}" 'tabulated-list-widen-current-column)
(define-key map "{" 'tabulated-list-narrow-current-column)
@@ -645,18 +649,41 @@ this is the vector stored within it."
(defun tabulated-list-sort (&optional n)
"Sort Tabulated List entries by the column at point.
-With a numeric prefix argument N, sort the Nth column."
+With a numeric prefix argument N, sort the Nth column.
+
+If the numeric prefix is -1, restore order the list was
+originally displayed in."
(interactive "P")
- (let ((name (if n
- (car (aref tabulated-list-format n))
- (get-text-property (point)
- 'tabulated-list-column-name))))
- (if (nth 2 (assoc name (append tabulated-list-format nil)))
- (tabulated-list--sort-by-column-name name)
- (user-error "Cannot sort by %s" name))))
+ (if (equal n -1)
+ ;; Restore original order.
+ (progn
+ (unless tabulated-list--original-order
+ (error "Order is already in original order"))
+ (setq tabulated-list-entries
+ (sort tabulated-list-entries
+ (lambda (e1 e2)
+ (< (gethash e1 tabulated-list--original-order)
+ (gethash e2 tabulated-list--original-order)))))
+ (setq tabulated-list-sort-key nil)
+ (tabulated-list-init-header)
+ (tabulated-list-print t))
+ ;; Sort based on a column name.
+ (let ((name (if n
+ (car (aref tabulated-list-format n))
+ (get-text-property (point)
+ 'tabulated-list-column-name))))
+ (if (nth 2 (assoc name (append tabulated-list-format nil)))
+ (tabulated-list--sort-by-column-name name)
+ (user-error "Cannot sort by %s" name)))))
(defun tabulated-list--sort-by-column-name (name)
(when (and name (derived-mode-p 'tabulated-list-mode))
+ (unless tabulated-list--original-order
+ ;; Store the original order so that we can restore it later.
+ (setq tabulated-list--original-order (make-hash-table))
+ (cl-loop for elem in tabulated-list-entries
+ for i from 0
+ do (setf (gethash elem tabulated-list--original-order) i)))
;; Flip the sort order on a second click.
(if (equal name (car tabulated-list-sort-key))
(setcdr tabulated-list-sort-key
@@ -715,8 +742,32 @@ Interactively, N is the prefix numeric argument, and
defaults to
(setq-local tabulated-list--current-lnum-width lnum-width)
(tabulated-list-init-header)))))
+(defun tabulated-list-next-column (&optional arg)
+ "Go to the start of the next column after point on the current line.
+If ARG is provided, move that many columns."
+ (interactive "p")
+ (dotimes (_ (or arg 1))
+ (let ((next (or (next-single-property-change
+ (point) 'tabulated-list-column-name)
+ (point-max))))
+ (when (<= next (line-end-position))
+ (goto-char next)))))
+
+(defun tabulated-list-previous-column (&optional arg)
+ "Go to the start of the column point is in on the current line.
+If ARG is provided, move that many columns."
+ (interactive "p")
+ (dotimes (_ (or arg 1))
+ (let ((prev (or (previous-single-property-change
+ (point) 'tabulated-list-column-name)
+ 1)))
+ (unless (< prev (line-beginning-position))
+ (goto-char prev)))))
+
;;; The mode definition:
+(defvar tabulated-list--original-order nil)
+
(define-derived-mode tabulated-list-mode special-mode "Tabulated"
"Generic major mode for browsing a list of items.
This mode is usually not used directly; instead, other major
@@ -757,6 +808,7 @@ as the ewoc pretty-printer."
(setq-local glyphless-char-display
(tabulated-list-make-glyphless-char-display-table))
(setq-local text-scale-remap-header-line t)
+ (setq-local tabulated-list--original-order nil)
;; Avoid messing up the entries' display just because the first
;; column of the first entry happens to begin with a R2L letter.
(setq bidi-paragraph-direction 'left-to-right)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index ea9f9a3..7a17ee2 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1761,7 +1761,7 @@ See `erc-display-server-message'." nil
's324 ?c channel ?m modes)))
(define-erc-response-handler (328)
- "Channel URL (on freenode network)." nil
+ "Channel URL." nil
(let ((channel (cadr (erc-response.command-args parsed)))
(url (erc-response.contents parsed)))
(erc-display-message parsed 'notice (erc-get-buffer channel proc)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index cb9af92..5953471 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -130,7 +130,8 @@ longer than `erc-fill-column'."
("<URL: *\\([^<> ]+\\) *>" 0 t browse-url-button-open-url 1)
;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
;; emacs internal
- ("[`]\\([a-zA-Z][-a-zA-Z_0-9]+\\)[']" 1 t erc-button-describe-symbol 1)
+ ("[`]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)[']"
+ 1 t erc-button-describe-symbol 1)
;; pseudo links
("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t Info-goto-node 1)
("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)"
@@ -299,7 +300,7 @@ specified by `erc-button-alist'."
(end (match-end (nth 1 entry)))
(form (nth 2 entry))
(fun (nth 3 entry))
- (data (mapcar #'match-string (nthcdr 4 entry))))
+ (data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
(when (or (eq t form)
(eval form t))
(erc-button-add-button start end fun nil data regexp)))))
diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el
index 22336ed..31e59a6 100644
--- a/lisp/erc/erc-ibuffer.el
+++ b/lisp/erc/erc-ibuffer.el
@@ -73,7 +73,7 @@
erc-track-mode)
(let ((entry (assq (current-buffer) erc-modified-channels-alist)))
(if entry
- (if (> (length entry) 1)
+ (if (cdr entry)
(cond ((eq 'pal (nth 1 entry))
(string erc-ibuffer-pal-char))
((eq 'fool (nth 1 entry))
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index aed02a9..54502b2 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -290,6 +290,13 @@
("LagNet: Random server" LagNet "irc.lagnet.org.za" 6667)
("LagNet: AF, ZA, Cape Town" LagNet "reaper.lagnet.org.za" 6667)
("LagNet: AF, ZA, Johannesburg" LagNet "mystery.lagnet.org.za" 6667)
+ ("Libera.Chat: Random server" Libera.Chat "irc.libera.chat" 6667)
+ ("Libera.Chat: Random Europe server" Libera.Chat "irc.eu.libera.chat" 6667)
+ ("Libera.Chat: Random US & Canada server" Libera.Chat "irc.us.libera.chat"
6667)
+ ("Libera.Chat: Random Australia & New Zealand server" Libera.Chat
"irc.au.libera.chat" 6667)
+ ("Libera.Chat: Random East Asia server" Libera.Chat "irc.ea.libera.chat"
6667)
+ ("Libera.Chat: IPv4 only server" Libera.Chat "irc.ipv4.libera.chat" 6667)
+ ("Libera.Chat: IPv6 only server" Libera.Chat "irc.ipv6.libera.chat" 6667)
("Librenet: Random server" Librenet "irc.librenet.net" 6667)
("LinkNet: Random server" LinkNet "irc.link-net.org" ((6667 6669)))
("LinuxChix: Random server" LinuxChix "irc.linuxchix.org" 6667)
@@ -594,6 +601,7 @@ PORTS is either a number, a list of numbers, or a list of
port ranges."
(Krono "krono.net")
(Krushnet "krushnet.org")
(LagNet "lagnet.org.za")
+ (Libera.Chat "libera.chat")
(Librenet "librenet.net")
(LinkNet "link-net.org")
(LinuxChix "cats\\.meow\\.at\\|linuxchix\\.org")
@@ -833,8 +841,8 @@ As an example:
;; think it is worth the effort.
(defvar erc-settings
- '((pals freenode ("kensanata" "shapr" "anti\\(fuchs\\|gone\\)"))
- (format-nick-function (freenode "#emacs") erc-format-@nick))
+ '((pals Libera.Chat ("kensanata" "shapr" "anti\\(fuchs\\|gone\\)"))
+ (format-nick-function (Libera.Chat "#emacs") erc-format-@nick))
"Experimental: Alist of configuration options.
The format is (VARNAME SCOPE VALUE) where
VARNAME is a symbol identifying the configuration option,
@@ -863,7 +871,7 @@ VALUE is the options value.")
items nil)))))
val))
-(erc-get 'pals 'freenode)
+(erc-get 'pals 'Libera.Chat)
(provide 'erc-networks)
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index 073d164..61006e0 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -30,10 +30,10 @@
;; are made to test if NickServ is the real NickServ for a given network or
;; server.
-;; As a default, ERC has the data for the official nickname services on
-;; the networks Austnet, BrasNET, Dalnet, freenode, GalaxyNet, GRnet,
-;; Libera.Chat and Slashnet. You can add more by using
-;; M-x customize-variable RET erc-nickserv-alist.
+;; As a default, ERC has the data for the official nickname services
+;; on the networks Austnet, BrasNET, Dalnet, freenode, GalaxyNet,
+;; GRnet, Libera.Chat, and Slashnet. You can add more by using
+;; M-x customize-variable RET erc-nickserv-alist.
;; Usage:
;;
@@ -43,9 +43,10 @@
;; (erc-services-mode 1)
;;
;; Add your nickname and NickServ password to `erc-nickserv-passwords'.
-;; Using the freenode network as an example:
+;; Using the Libera.Chat network as an example:
;;
-;; (setq erc-nickserv-passwords '((freenode (("nickname" "password")))))
+;; (setq erc-nickserv-passwords
+;; '((Libera.Chat (("nickname" "password")))))
;;
;; The default automatic identification mode is autodetection of NickServ
;; identify requests. Set the variable `erc-nickserv-identify-mode' if
@@ -181,8 +182,8 @@ passwords to be used.
Example of use:
(setq erc-nickserv-passwords
- \\='((freenode ((\"nick-one\" . \"password\")
- (\"nick-two\" . \"password\")))
+ \\='((Libera.Chat ((\"nick-one\" . \"password\")
+ (\"nick-two\" . \"password\")))
(DALnet ((\"nick\" . \"password\")))))"
:type '(repeat
(list :tag "Network"
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 31de9e8..dde2556 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -181,6 +181,11 @@ or `erc-send-modify-hook'."
(list (lambda (_window _before dir)
(erc-echo-timestamp dir ct))))))))
+(defvar-local erc-timestamp-last-window-width nil
+ "Stores the width of the last window that showed the current
+buffer. This is used by `erc-insert-timestamp-right' when the
+current buffer is not shown in any window.")
+
(defvar-local erc-timestamp-last-inserted nil
"Last timestamp inserted into the buffer.")
@@ -250,27 +255,32 @@ property to get to the POSth column."
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
-STRING is the timestamp to insert. The function is a possible value
-for `erc-insert-timestamp-function'.
-
-If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is always
-printed. If this variable is non-nil, a timestamp is only printed if
-it is different from the last.
-
-If `erc-timestamp-right-column' is set, its value will be used as the
-column at which the timestamp is to be printed. If it is nil, and
-`erc-fill-mode' is active, then the timestamp will be printed just
-before `erc-fill-column'. Otherwise, if the current buffer is
-shown in a window, that window's width is used. If the buffer is
-not shown, and `fill-column' is set, then the timestamp will be
-printed just `fill-column'. As a last resort, the timestamp will
-be printed just before the window-width."
+STRING is the timestamp to insert. This function is a possible
+value for `erc-insert-timestamp-function'.
+
+If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is
+always printed. If this variable is non-nil, a timestamp is only
+printed if it is different from the last.
+
+If `erc-timestamp-right-column' is set, its value will be used as
+the column at which the timestamp is to be printed. If it is
+nil, and `erc-fill-mode' is active, then the timestamp will be
+printed just before `erc-fill-column'. Otherwise, if the current
+buffer is shown in a window, that window's width is used as the
+right boundary. In case multiple windows show the buffer, the
+width of the most recently selected one is used. If the buffer
+is not shown, the timestamp will be printed just before the
+window width of the last window that showed it. If the buffer
+was never shown, and `fill-column' is set, it will be printed
+just before `fill-column'. As a last resort, timestamp will be
+printed just after each line's text (no alignment)."
(unless (and erc-timestamp-only-if-changed-flag
(string-equal string erc-timestamp-last-inserted))
(setq erc-timestamp-last-inserted string)
(goto-char (point-max))
- (forward-char -1);; before the last newline
+ (forward-char -1) ; before the last newline
(let* ((str-width (string-width string))
+ window ; used in computation of `pos' only
(pos (cond
(erc-timestamp-right-column erc-timestamp-right-column)
((and (boundp 'erc-fill-mode)
@@ -278,10 +288,15 @@ be printed just before the window-width."
(boundp 'erc-fill-column)
erc-fill-column)
(1+ (- erc-fill-column str-width)))
+ ((setq window (get-buffer-window nil t))
+ (setq erc-timestamp-last-window-width
+ (window-width window))
+ (- erc-timestamp-last-window-width str-width))
+ (erc-timestamp-last-window-width
+ (- erc-timestamp-last-window-width str-width))
(fill-column
(1+ (- fill-column str-width)))
- (t
- (- (window-width) str-width 1))))
+ (t (current-column))))
(from (point))
(col (current-column)))
;; The following is a kludge used to calculate whether to move
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 5245204..026c6f8 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -247,7 +247,7 @@ A typical value would be \(\"JOIN\" \"PART\" \"QUIT\")."
(defcustom erc-network-hide-list nil
"A list of IRC networks to hide message types from.
-A typical value would be \((\"freenode\" \"MODE\")
+A typical value would be \((\"Libera.Chat\" \"MODE\")
\(\"OFTC\" \"JOIN\" \"QUIT\"))."
:version "25.1"
:group 'erc-ignore
@@ -1480,7 +1480,7 @@ Defaults to the server buffer."
;; activation
-(defconst erc-default-server "chat.freenode.net"
+(defconst erc-default-server "irc.libera.chat"
"IRC server to use if it cannot be detected otherwise.")
(defconst erc-default-port 6667
@@ -2225,7 +2225,7 @@ Non-interactively, it takes the keyword arguments
That is, if called with
- (erc :server \"chat.freenode.net\" :full-name \"J. Random Hacker\")
+ (erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
then the server and full-name will be set to those values,
whereas `erc-compute-port' and `erc-compute-nick' will be invoked
@@ -2260,7 +2260,7 @@ Non-interactively, it takes the keyword arguments
That is, if called with
- (erc-tls :server \"chat.freenode.net\" :full-name \"J. Random Hacker\")
+ (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
then the server and full-name will be set to those values,
whereas `erc-compute-port' and `erc-compute-nick' will be invoked
@@ -2276,7 +2276,7 @@ authentication by various IRC networks.
Example usage:
- (erc-tls :server \"chat.freenode.net\" :port 6697
+ (erc-tls :server \"irc.libera.chat\" :port 6697
:client-certificate
'(\"/home/bandali/my-cert.key\"
\"/home/bandali/my-cert.crt\"))"
@@ -3447,8 +3447,9 @@ to send.
If only one word is given, display the mode of that target.
-A list of valid mode strings for Freenode may be found at
-URL `https://freenode.net/kb/all'."
+A list of valid mode strings for Libera.Chat may be found at
+`https://libera.chat/guides/channelmodes' and
+`https://libera.chat/guides/usermodes'."
(cond
((string-match "^\\s-\\(.*\\)$" line)
(let ((s (match-string 1 line)))
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index c04a1a6..ee9057f 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -224,7 +224,7 @@ Thus, this does not include the current directory.")
(add-hook 'eshell-exit-hook #'eshell-write-last-dir-ring nil t)
- (add-hook 'kill-emacs-hook #'eshell-save-some-last-dir))
+ (add-hook 'kill-emacs-query-functions #'eshell-save-some-last-dir))
(defun eshell-save-some-last-dir ()
"Save the list-dir-ring for any open Eshell buffers."
@@ -238,7 +238,8 @@ Thus, this does not include the current directory.")
(format-message
"Save last dir ring for Eshell buffer `%s'? "
(buffer-name buf)))))
- (eshell-write-last-dir-ring))))))
+ (eshell-write-last-dir-ring)))))
+ t)
(defun eshell-lone-directory-p (file)
"Test whether FILE is just a directory name, and not a command name."
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 18e19a9..d82946a 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -293,7 +293,7 @@ Returns nil if INPUT is prepended by blank space, otherwise
non-nil."
(add-hook 'eshell-exit-hook #'eshell-write-history nil t)
- (add-hook 'kill-emacs-hook #'eshell-save-some-history)
+ (add-hook 'kill-emacs-query-functions #'eshell-save-some-history)
(add-hook 'eshell-input-filter-functions #'eshell-add-to-history nil t))
@@ -310,7 +310,8 @@ Returns nil if INPUT is prepended by blank space, otherwise
non-nil."
(format-message
"Save input history for Eshell buffer `%s'? "
(buffer-name buf)))))
- (eshell-write-history))))))
+ (eshell-write-history)))))
+ t)
(defun eshell/history (&rest args)
"List in help buffer the buffer's input history."
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 855ce0b..7229d61 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -244,6 +244,10 @@ return a string which is inserted. It may set
`facemenu-end-add-face'."
(define-key map [fc] (cons "Face" 'facemenu-face-menu)))
(defalias 'facemenu-menu facemenu-menu)
+;;;###autoload (autoload 'facemenu-menu "facemenu" nil nil 'keymap)
+;;;###autoload
+(define-key global-map [C-down-mouse-2] 'facemenu-menu)
+
(easy-menu-add-item
menu-bar-edit-menu nil
["Text Properties" facemenu-menu])
@@ -714,7 +718,13 @@ they are used to set the face information.
As a special case, if FACE is `default', then the region is left with NO face
text property. Otherwise, selecting the default face would not have any
effect. See `facemenu-remove-face-function'."
- (interactive "*xFace: \nr")
+ (interactive (list (progn
+ (barf-if-buffer-read-only)
+ (read-face-name "Use face" (face-at-point t)))
+ (if (and mark-active (not current-prefix-arg))
+ (region-beginning))
+ (if (and mark-active (not current-prefix-arg))
+ (region-end))))
(cond
((and (eq face 'default)
(not (eq facemenu-remove-face-function t)))
diff --git a/lisp/faces.el b/lisp/faces.el
index 308da93..4bb3a2b 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -176,10 +176,28 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
;;; Creation, copying.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(make-obsolete-variable 'face-new-frame-defaults
+ "use `face--new-frame-defaults' or `face-alist' instead." "28.1")
+
+(defun frame-face-alist (&optional frame)
+ "Return an alist of frame-local faces defined on FRAME.
+This alist is a copy of the contents of `frame--face-hash-table'.
+For internal use only."
+ (declare (obsolete frame--face-hash-table "28.1"))
+ (let (faces)
+ (maphash (lambda (face spec)
+ (let ((face-id (car (gethash face face--new-frame-defaults))))
+ (push `(,face-id ,face . ,spec) faces)))
+ (frame--face-hash-table frame))
+ (mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2)))))))
(defun face-list ()
"Return a list of all defined faces."
- (mapcar #'car face-new-frame-defaults))
+ (let (faces)
+ (maphash (lambda (face spec)
+ (push `(,(car spec) . ,face) faces))
+ face--new-frame-defaults)
+ (mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2)))))))
(defun make-face (face)
"Define a new face with name FACE, a symbol.
@@ -2115,6 +2133,8 @@ the X resource \"reverseVideo\" is present, handle that."
(unwind-protect
(progn
(x-setup-function-keys frame)
+ (dolist (face (nreverse (face-list)))
+ (face-spec-recalc face frame))
(x-handle-reverse-video frame parameters)
(frame-set-background-mode frame t)
(face-set-after-frame-default frame parameters)
@@ -2145,7 +2165,7 @@ the X resource \"reverseVideo\" is present, handle that."
(defun face-set-after-frame-default (frame &optional parameters)
"Initialize the frame-local faces of FRAME.
Calculate the face definitions using the face specs, custom theme
-settings, X resources, and `face-new-frame-defaults'.
+settings, X resources, and `face--new-frame-defaults'.
Finally, apply any relevant face attributes found amongst the
frame parameters in PARAMETERS."
;; The `reverse' is so that `default' goes first.
@@ -2154,7 +2174,7 @@ frame parameters in PARAMETERS."
(progn
;; Initialize faces from face spec and custom theme.
(face-spec-recalc face frame)
- ;; Apply attributes specified by face-new-frame-defaults
+ ;; Apply attributes specified by face--new-frame-defaults
(internal-merge-in-global-face face frame))
;; Don't let invalid specs prevent frame creation.
(error nil)))
@@ -2913,23 +2933,30 @@ It is used for characters of no fonts too."
;; Faces for TTY menus.
(defface tty-menu-enabled-face
- '((t
- :foreground "yellow" :background "blue" :weight bold))
+ '((((class color))
+ :foreground "yellow" :background "blue" :weight bold)
+ (t :weight bold))
"Face for displaying enabled items in TTY menus."
- :group 'basic-faces)
+ :group 'basic-faces
+ :version "28.1")
(defface tty-menu-disabled-face
'((((class color) (min-colors 16))
:foreground "lightgray" :background "blue")
- (t
- :foreground "white" :background "blue"))
+ (((class color))
+ :foreground "white" :background "blue")
+ (t :inherit shadow))
"Face for displaying disabled items in TTY menus."
- :group 'basic-faces)
+ :group 'basic-faces
+ :version "28.1")
(defface tty-menu-selected-face
- '((t :background "red"))
+ '((((class color))
+ :background "red")
+ (t :inverse-video t))
"Face for displaying the currently selected item in TTY menus."
- :group 'basic-faces)
+ :group 'basic-faces
+ :version "28.1")
(defgroup paren-showing-faces nil
"Faces used to highlight paren matches."
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 6faf8d5..9be9c29 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -260,6 +260,7 @@ ffap most of the time."
:type 'boolean
:group 'ffap)
+;;;###autoload
(defcustom ffap-file-finder 'find-file
"The command called by `find-file-at-point' to find a file."
:type 'function
@@ -1524,24 +1525,40 @@ which may actually result in an URL rather than a
filename."
;; The solution here is to forcefully activate url-handler-mode, which
;; takes care of it for us.
+(defun ffap--url-file-handler (operation &rest args)
+ (let ((inhibit-file-name-handlers
+ (cons 'ffap--url-file-handler inhibit-file-name-handlers))
+ (inhibit-file-name-operation operation))
+ (cl-case operation
+ ;; We mainly just want to disable these bits:
+ (substitute-in-file-name (car args))
+ (expand-file-name
+ (if (equal (car args) "http://<remove>")
+ ""
+ (car args)))
+ (otherwise
+ (apply operation args)))))
+
(defun ffap-read-file-or-url (prompt guess)
"Read file or URL from minibuffer, with PROMPT and initial GUESS."
- (or guess (setq guess default-directory))
- ;; Tricky: guess may have or be a local directory, like "w3/w3.elc"
- ;; or "w3/" or "../el/ffap.el" or "../../../"
- (if (ffap-url-p guess)
- ;; FIXME: We earlier tried to make use of `url-file-handler' so
- ;; `read-file-name' could also be used for URLs, but it
- ;; introduced all kinds of subtle breakage such as:
- ;; - (file-name-directory "http://a";) returning "http://a/";
- ;; - Trying to contact remote hosts with no justification
- ;; These should be fixed in url-handler-mode before we can try
- ;; using it here again.
- (read-string prompt guess nil nil t)
- (unless (ffap-file-remote-p guess)
- (setq guess (abbreviate-file-name (expand-file-name guess))))
- (read-file-name prompt (file-name-directory guess) nil nil
- (file-name-nondirectory guess))))
+ (let ((elem (cons ffap-url-regexp #'ffap--url-file-handler)))
+ (unwind-protect
+ (progn
+ (push elem file-name-handler-alist)
+ (if (ffap-url-p guess)
+ (read-file-name prompt "http://<remove>" nil nil guess)
+ (unless guess
+ (setq guess default-directory))
+ (unless (ffap-file-remote-p guess)
+ (setq guess (abbreviate-file-name (expand-file-name guess))))
+ (read-file-name prompt
+ (file-name-directory guess) nil nil
+ (file-name-nondirectory guess))))
+ ;; Remove the special handler manually. We used to just let-bind
+ ;; file-name-handler-alist to preserve its value, but that caused
+ ;; other modifications to be lost (e.g. when Tramp gets loaded
+ ;; during the completing-read call).
+ (setq file-name-handler-alist (delq elem file-name-handler-alist)))))
;; The rest of this page is just to work with package complete.el.
;; This code assumes that you load ffap.el after complete.el.
@@ -1653,9 +1670,9 @@ See also the variables `ffap-dired-wildcards',
`ffap-newfile-prompt',
((or (not ffap-newfile-prompt)
(file-exists-p filename)
(y-or-n-p "File does not exist, create buffer? "))
- (funcall ffap-file-finder
- ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
- (expand-file-name filename)))
+ (find-file
+ ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
+ (expand-file-name filename)))
;; User does not want to find a non-existent file:
((signal 'file-missing (list "Opening file buffer"
"No such file or directory"
diff --git a/lisp/filecache.el b/lisp/filecache.el
index 62184e1..4223878 100644
--- a/lisp/filecache.el
+++ b/lisp/filecache.el
@@ -516,6 +516,16 @@ If called interactively, read the directory names one by
one."
(concat directory "/")
directory)))
+(defun file-cache-cycle (name)
+ "Cycle through the directories that NAME is available in."
+ (let ((file-name (file-cache-file-name name)))
+ (if (string= file-name (minibuffer-contents))
+ (minibuffer-message file-cache-sole-match-message)
+ (delete-minibuffer-contents)
+ (insert file-name)
+ (if file-cache-multiple-directory-message
+ (minibuffer-message file-cache-multiple-directory-message)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Minibuffer functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -545,13 +555,7 @@ the name is considered already unique; only the second
substitution
(cond
;; If it's the only match, replace the original contents
((or arg (eq completion t))
- (let ((file-name (file-cache-file-name string)))
- (if (string= file-name (minibuffer-contents))
- (minibuffer-message file-cache-sole-match-message)
- (delete-minibuffer-contents)
- (insert file-name)
- (if file-cache-multiple-directory-message
- (minibuffer-message file-cache-multiple-directory-message)))))
+ (file-cache-cycle string))
;; If it's the longest match, insert it
((consp completion)
@@ -564,10 +568,7 @@ the name is considered already unique; only the second
substitution
file-cache-ignore-case))
(if (and (eq last-command this-command)
(string= file-cache-last-completion newstring))
- (progn
- (delete-minibuffer-contents)
- (insert (file-cache-file-name newstring))
- (setq file-cache-last-completion nil))
+ (file-cache-cycle newstring)
(minibuffer-message file-cache-non-unique-message)
(setq file-cache-last-completion string))
(setq file-cache-last-completion string)
@@ -579,20 +580,12 @@ the name is considered already unique; only the second
substitution
(if (> (length completion-list) 1)
(progn
(delete-region (- (point-max) (length string)) (point-max))
- (save-excursion (insert newstring))
- (forward-char newpoint)
+ (insert newstring)
(with-output-to-temp-buffer file-cache-completions-buffer
(display-completion-list completion-list)
;; Add our own setup function to the Completions Buffer
(file-cache-completion-setup-function)))
- (let ((file-name (file-cache-file-name newstring)))
- (if (string= file-name (minibuffer-contents))
- (minibuffer-message file-cache-sole-match-message)
- (delete-minibuffer-contents)
- (insert file-name)
- (if file-cache-multiple-directory-message
- (minibuffer-message
- file-cache-multiple-directory-message)))))))))
+ (file-cache-cycle newstring))))))
;; No match
((eq completion nil)
diff --git a/lisp/fileloop.el b/lisp/fileloop.el
index 8a2755d..45b9cea 100644
--- a/lisp/fileloop.el
+++ b/lisp/fileloop.el
@@ -120,7 +120,10 @@ operating on the next file and nil otherwise."
(kill-all-local-variables)
(erase-buffer)
(setq new next)
- (insert-file-contents new nil))
+ (condition-case nil
+ (insert-file-contents new nil)
+ (file-missing
+ (fileloop-next-file novisit))))
new)))
(defun fileloop-continue ()
diff --git a/lisp/files.el b/lisp/files.el
index 859c193..b58f90d 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -465,6 +465,31 @@ If `silently', don't ask the user before saving."
:type '(choice (const t) (const nil) (const silently))
:group 'abbrev)
+(defcustom lock-file-name-transforms nil
+ "Transforms to apply to buffer file name before making a lock file name.
+This has the same syntax as
+`auto-save-file-name-transforms' (which see), but instead of
+applying to auto-save file names, it's applied to lock file names.
+
+By default, a lock file is put into the same directory as the
+file it's locking, and it has the same name, but with \".#\" prepended."
+ :group 'files
+ :type '(repeat (list (regexp :tag "Regexp")
+ (string :tag "Replacement")
+ (boolean :tag "Uniquify")))
+ :version "28.1")
+
+(defcustom remote-file-name-inhibit-locks nil
+ "Whether to use file locks for remote files."
+ :group 'files
+ :version "28.1"
+ :type 'boolean)
+
+(define-minor-mode lock-file-mode
+ "Toggle file locking in the current buffer (Lock File mode)."
+ :version "28.1"
+ (setq-local create-lockfiles (and lock-file-mode t)))
+
(defcustom find-file-run-dired t
"Non-nil means allow `find-file' to visit directories.
To visit the directory, `find-file' runs `find-directory-functions'."
@@ -757,7 +782,10 @@ nil (meaning `default-directory') as the associated list
element."
(let ((spath (substitute-env-vars search-path)))
(mapcar (lambda (f)
(if (equal "" f) nil
- (let ((dir (expand-file-name (file-name-as-directory f))))
+ (let ((dir (file-name-as-directory f)))
+ (when (file-name-absolute-p dir)
+ ;; Expand "~".
+ (setq dir (expand-file-name dir)))
;; Previous implementation used `substitute-in-file-name'
;; which collapse multiple "/" in front. Do the same for
;; backward compatibility.
@@ -1677,6 +1705,10 @@ rather than FUN itself, to `minibuffer-setup-hook'."
(list (read-file-name prompt nil default-directory mustmatch)
t))
+(defun file-name-history--add (file)
+ "Add FILE to `file-name-history'."
+ (add-to-history 'file-name-history (abbreviate-file-name file)))
+
(defun find-file (filename &optional wildcards)
"Edit file FILENAME.
Switch to a buffer visiting file FILENAME,
@@ -2133,6 +2165,19 @@ think it does, because \"free\" is pretty hard to define
in practice."
:version "25.1"
:type '(choice integer (const :tag "Never issue warning" nil)))
+(defcustom query-about-changed-file t
+ "If non-nil, query the user when re-visiting a file that has changed.
+This happens if the file is already visited in a buffer, the
+file was changed externally, and the user re-visits the file.
+
+If nil, don't prompt the user, but instead provide instructions for
+reverting, after switching to the buffer with its contents before
+the external changes."
+ :group 'files
+ :group 'find-file
+ :version "28.1"
+ :type 'boolean)
+
(declare-function x-popup-dialog "menu.c" (position contents &optional header))
(defun files--ask-user-about-large-file-help-text (op-type size)
@@ -2315,6 +2360,14 @@ the various files."
(message "Reverting file %s..." filename)
(revert-buffer t t)
(message "Reverting file %s...done" filename)))
+ ((not query-about-changed-file)
+ (message
+ (substitute-command-keys
+ "File %s changed on disk. \\[revert-buffer] to
load new contents%s")
+ (file-name-nondirectory filename)
+ (if (buffer-modified-p buf)
+ " and discard your edits"
+ "")))
((yes-or-no-p
(if (string= (file-name-nondirectory filename)
(buffer-name buf))
@@ -3145,11 +3198,70 @@ If FUNCTION is nil, then it is not called.")
"Upper limit on `magic-mode-alist' regexp matches.
Also applies to `magic-fallback-mode-alist'.")
+(defun set-auto-mode--apply-alist (alist keep-mode-if-same dir-local)
+ "Helper function for `set-auto-mode'.
+This function takes an alist of the same form as
+`auto-mode-alist'. It then tries to find the appropriate match
+in the alist for the current buffer; setting the mode if
+possible.
+Return non-nil if the mode was set, nil otherwise.
+DIR-LOCAL non-nil means this call is via directory-locals, and
+extra checks should be done."
+ (if buffer-file-name
+ (let (mode
+ (name buffer-file-name)
+ (remote-id (file-remote-p buffer-file-name))
+ (case-insensitive-p (file-name-case-insensitive-p
+ buffer-file-name)))
+ ;; Remove backup-suffixes from file name.
+ (setq name (file-name-sans-versions name))
+ ;; Remove remote file name identification.
+ (when (and (stringp remote-id)
+ (string-match (regexp-quote remote-id) name))
+ (setq name (substring name (match-end 0))))
+ (while name
+ ;; Find first matching alist entry.
+ (setq mode
+ (if case-insensitive-p
+ ;; Filesystem is case-insensitive.
+ (let ((case-fold-search t))
+ (assoc-default name alist 'string-match))
+ ;; Filesystem is case-sensitive.
+ (or
+ ;; First match case-sensitively.
+ (let ((case-fold-search nil))
+ (assoc-default name alist 'string-match))
+ ;; Fallback to case-insensitive match.
+ (and auto-mode-case-fold
+ (let ((case-fold-search t))
+ (assoc-default name alist 'string-match))))))
+ (if (and mode
+ (consp mode)
+ (cadr mode))
+ (setq mode (car mode)
+ name (substring name 0 (match-beginning 0)))
+ (setq name nil)))
+ (when (and dir-local mode
+ (not (set-auto-mode--dir-local-valid-p mode)))
+ (message "Ignoring invalid mode `%s'" mode)
+ (setq mode nil))
+ (when mode
+ (set-auto-mode-0 mode keep-mode-if-same)
+ t))))
+
+(defun set-auto-mode--dir-local-valid-p (mode)
+ "Say whether MODE can be used in a .dir-local.el `auto-mode-alist'."
+ (and (symbolp mode)
+ (string-suffix-p "-mode" (symbol-name mode))
+ (commandp mode)
+ (not (provided-mode-derived-p mode 'special-mode))))
+
(defun set-auto-mode (&optional keep-mode-if-same)
"Select major mode appropriate for current buffer.
To find the right major mode, this function checks for a -*- mode tag
checks for a `mode:' entry in the Local Variables section of the file,
+checks if there an `auto-mode-alist' entry in `.dir-locals.el',
checks if it uses an interpreter listed in `interpreter-mode-alist',
matches the buffer beginning against `magic-mode-alist',
compares the file name against the entries in `auto-mode-alist',
@@ -3206,6 +3318,14 @@ we don't actually set it to the same mode the buffer
already has."
(or (set-auto-mode-0 mode keep-mode-if-same)
;; continuing would call minor modes again, toggling them off
(throw 'nop nil))))))
+ ;; Check for auto-mode-alist entry in dir-locals.
+ (unless done
+ (with-demoted-errors "Directory-local variables error: %s"
+ ;; Note this is a no-op if enable-local-variables is nil.
+ (let* ((mode-alist (cdr (hack-dir-local--get-variables
+ (lambda (key) (eq key 'auto-mode-alist))))))
+ (setq done (set-auto-mode--apply-alist mode-alist
+ keep-mode-if-same t)))))
(and (not done)
(setq mode (hack-local-variables t (not try-locals)))
(not (memq mode modes)) ; already tried and failed
@@ -3257,45 +3377,8 @@ we don't actually set it to the same mode the buffer
already has."
(set-auto-mode-0 done keep-mode-if-same)))
;; Next compare the filename against the entries in auto-mode-alist.
(unless done
- (if buffer-file-name
- (let ((name buffer-file-name)
- (remote-id (file-remote-p buffer-file-name))
- (case-insensitive-p (file-name-case-insensitive-p
- buffer-file-name)))
- ;; Remove backup-suffixes from file name.
- (setq name (file-name-sans-versions name))
- ;; Remove remote file name identification.
- (when (and (stringp remote-id)
- (string-match (regexp-quote remote-id) name))
- (setq name (substring name (match-end 0))))
- (while name
- ;; Find first matching alist entry.
- (setq mode
- (if case-insensitive-p
- ;; Filesystem is case-insensitive.
- (let ((case-fold-search t))
- (assoc-default name auto-mode-alist
- 'string-match))
- ;; Filesystem is case-sensitive.
- (or
- ;; First match case-sensitively.
- (let ((case-fold-search nil))
- (assoc-default name auto-mode-alist
- 'string-match))
- ;; Fallback to case-insensitive match.
- (and auto-mode-case-fold
- (let ((case-fold-search t))
- (assoc-default name auto-mode-alist
- 'string-match))))))
- (if (and mode
- (consp mode)
- (cadr mode))
- (setq mode (car mode)
- name (substring name 0 (match-beginning 0)))
- (setq name nil))
- (when mode
- (set-auto-mode-0 mode keep-mode-if-same)
- (setq done t))))))
+ (setq done (set-auto-mode--apply-alist auto-mode-alist
+ keep-mode-if-same nil)))
;; Next try matching the buffer beginning against
magic-fallback-mode-alist.
(unless done
(if (setq done (save-excursion
@@ -3389,13 +3472,27 @@ Major modes can use this to examine user-specified
local variables
in order to initialize other data structure based on them.")
(defcustom safe-local-variable-values nil
- "List variable-value pairs that are considered safe.
+ "List of variable-value pairs that are considered safe.
Each element is a cons cell (VAR . VAL), where VAR is a variable
-symbol and VAL is a value that is considered safe."
+symbol and VAL is a value that is considered safe.
+
+Also see `ignored-local-variable-values'."
:risky t
:group 'find-file
:type 'alist)
+(defcustom ignored-local-variable-values nil
+ "List of variable-value pairs that should always be ignored.
+Each element is a cons cell (VAR . VAL), where VAR is a variable
+symbol and VAL is its value; if VAR is set to VAL by a file-local
+variables section, that setting should be ignored.
+
+Also see `safe-local-variable-values'."
+ :risky t
+ :group 'find-file
+ :type 'alist
+ :version "28.1")
+
(defcustom safe-local-eval-forms
;; This should be here at least as long as Emacs supports write-file-hooks.
'((add-hook 'write-file-hooks 'time-stamp)
@@ -3546,7 +3643,9 @@ n -- to ignore the local variables list.")
(if offer-save
(insert "
! -- to apply the local variables list, and permanently mark these
- values (*) as safe (in the future, they will be set automatically.)\n\n")
+ values (*) as safe (in the future, they will be set automatically.)
+i -- to ignore the local variables list, and permanently mark these
+ values (*) as ignored\n\n")
(insert "\n\n"))
(dolist (elt all-vars)
(cond ((member elt unsafe-vars)
@@ -3570,16 +3669,24 @@ n -- to ignore the local variables list.")
(pop-to-buffer buf '(display-buffer--maybe-at-bottom))
(let* ((exit-chars '(?y ?n ?\s))
(prompt (format "Please type %s%s: "
- (if offer-save "y, n, or !" "y or n")
+ (if offer-save "y, n, ! or i" "y or n")
(if (< (line-number-at-pos (point-max))
(window-body-height))
""
", or C-v/M-v to scroll")))
char)
- (if offer-save (push ?! exit-chars))
+ (when offer-save
+ (push ?i exit-chars)
+ (push ?! exit-chars))
(setq char (read-char-choice prompt exit-chars))
- (when (and offer-save (= char ?!) unsafe-vars)
- (customize-push-and-save 'safe-local-variable-values unsafe-vars))
+ (when (and offer-save
+ (or (= char ?!) (= char ?i))
+ unsafe-vars)
+ (customize-push-and-save
+ (if (= char ?!)
+ 'safe-local-variable-values
+ 'ignored-local-variable-values)
+ unsafe-vars))
(prog1 (memq char '(?! ?\s ?y))
(quit-window t)))))))
@@ -3672,13 +3779,18 @@ If these settings come from directory-local variables,
then
DIR-NAME is the name of the associated directory. Otherwise it is nil."
;; Find those variables that we may want to save to
;; `safe-local-variable-values'.
- (let (all-vars risky-vars unsafe-vars)
+ (let (all-vars risky-vars unsafe-vars ignored)
(dolist (elt variables)
(let ((var (car elt))
(val (cdr elt)))
(cond ((memq var ignored-local-variables)
;; Ignore any variable in `ignored-local-variables'.
nil)
+ ((seq-some (lambda (elem)
+ (and (eq (car elem) var)
+ (eq (cdr elem) val)))
+ ignored-local-variable-values)
+ nil)
;; Obey `enable-local-eval'.
((eq var 'eval)
(when enable-local-eval
@@ -4087,10 +4199,13 @@ Returns the new list."
;; Need a new cons in case we setcdr later.
(push (cons variable value) variables)))))
-(defun dir-locals-collect-variables (class-variables root variables)
+(defun dir-locals-collect-variables (class-variables root variables
+ &optional predicate)
"Collect entries from CLASS-VARIABLES into VARIABLES.
ROOT is the root directory of the project.
-Return the new variables list."
+Return the new variables list.
+If PREDICATE is given, it is used to test a symbol key in the alist
+to see whether it should be considered."
(let* ((file-name (or (buffer-file-name)
;; Handle non-file buffers, too.
(expand-file-name default-directory)))
@@ -4109,9 +4224,11 @@ Return the new variables list."
(>= (length sub-file-name) (length key))
(string-prefix-p key sub-file-name))
(setq variables (dir-locals-collect-variables
- (cdr entry) root variables))))
- ((or (not key)
- (derived-mode-p key))
+ (cdr entry) root variables predicate))))
+ ((if predicate
+ (funcall predicate key)
+ (or (not key)
+ (derived-mode-p key)))
(let* ((alist (cdr entry))
(subdirs (assq 'subdirs alist)))
(if (or (not subdirs)
@@ -4408,13 +4525,13 @@ Return the new class name, which is a symbol named DIR."
(defvar hack-dir-local-variables--warned-coding nil)
-(defun hack-dir-local-variables ()
+(defun hack-dir-local--get-variables (predicate)
"Read per-directory local variables for the current buffer.
-Store the directory-local variables in `dir-local-variables-alist'
-and `file-local-variables-alist', without applying them.
-
-This does nothing if either `enable-local-variables' or
-`enable-dir-local-variables' are nil."
+Return a cons of the form (DIR . ALIST), where DIR is the
+directory name (maybe nil) and ALIST is an alist of all variables
+that might apply. These will be filtered according to the
+buffer's directory, but not according to its mode.
+PREDICATE is passed to `dir-locals-collect-variables'."
(when (and enable-local-variables
enable-dir-local-variables
(or enable-remote-dir-locals
@@ -4433,21 +4550,33 @@ This does nothing if either `enable-local-variables' or
(setq dir-name (nth 0 dir-or-cache))
(setq class (nth 1 dir-or-cache))))
(when class
- (let ((variables
- (dir-locals-collect-variables
- (dir-locals-get-class-variables class) dir-name nil)))
- (when variables
- (dolist (elt variables)
- (if (eq (car elt) 'coding)
- (unless hack-dir-local-variables--warned-coding
- (setq hack-dir-local-variables--warned-coding t)
- (display-warning 'files
- "Coding cannot be specified by
dir-locals"))
- (unless (memq (car elt) '(eval mode))
- (setq dir-local-variables-alist
- (assq-delete-all (car elt) dir-local-variables-alist)))
- (push elt dir-local-variables-alist)))
- (hack-local-variables-filter variables dir-name)))))))
+ (cons dir-name
+ (dir-locals-collect-variables
+ (dir-locals-get-class-variables class)
+ dir-name nil predicate))))))
+
+(defun hack-dir-local-variables ()
+ "Read per-directory local variables for the current buffer.
+Store the directory-local variables in `dir-local-variables-alist'
+and `file-local-variables-alist', without applying them.
+
+This does nothing if either `enable-local-variables' or
+`enable-dir-local-variables' are nil."
+ (let* ((items (hack-dir-local--get-variables nil))
+ (dir-name (car items))
+ (variables (cdr items)))
+ (when variables
+ (dolist (elt variables)
+ (if (eq (car elt) 'coding)
+ (unless hack-dir-local-variables--warned-coding
+ (setq hack-dir-local-variables--warned-coding t)
+ (display-warning 'files
+ "Coding cannot be specified by dir-locals"))
+ (unless (memq (car elt) '(eval mode))
+ (setq dir-local-variables-alist
+ (assq-delete-all (car elt) dir-local-variables-alist)))
+ (push elt dir-local-variables-alist)))
+ (hack-local-variables-filter variables dir-name))))
(defun hack-dir-local-variables-non-file-buffer ()
"Apply directory-local variables to a non-file buffer.
@@ -6199,9 +6328,6 @@ This undoes all changes since the file was visited or
saved.
With a prefix argument, offer to revert from latest auto-save file, if
that is more recent than the visited file.
-Reverting a buffer will try to preserve markers in the buffer;
-see the Info node `(elisp)Reverting' for details.
-
This command also implements an interface for special buffers
that contain text that doesn't come from a file, but reflects
some other data instead (e.g. Dired buffers, `buffer-list'
@@ -6227,7 +6353,12 @@ This function binds `revert-buffer-in-progress-p'
non-nil while it operates.
This function calls the function that `revert-buffer-function' specifies
to do the work, with arguments IGNORE-AUTO and NOCONFIRM.
The default function runs the hooks `before-revert-hook' and
-`after-revert-hook'."
+`after-revert-hook'
+
+Reverting a buffer will try to preserve markers in the buffer,
+but it cannot always preserve all of them. For better results,
+use `revert-buffer-with-fine-grain', which tries harder to
+preserve markers and overlays, at the price of being slower."
;; I admit it's odd to reverse the sense of the prefix argument, but
;; there is a lot of code out there that assumes that the first
;; argument should be t to avoid consulting the auto-save file, and
@@ -6405,7 +6536,8 @@ see `replace-buffer-contents'."
;; See comments in revert-buffer-with-fine-grain for an explanation.
(defun revert-buffer-with-fine-grain-success-p ()
success))
- (set-buffer-modified-p nil))))
+ (set-buffer-modified-p nil)
+ (set-visited-file-modtime))))
(defun revert-buffer-with-fine-grain (&optional ignore-auto noconfirm)
"Revert buffer preserving markers, overlays, etc.
@@ -6487,7 +6619,8 @@ details on the arguments, see `revert-buffer'."
(coding-system-for-read 'auto-save-coding))
(erase-buffer)
(insert-file-contents file-name nil)
- (set-buffer-file-coding-system coding-system))
+ (set-buffer-file-coding-system coding-system)
+ (set-buffer-auto-saved))
(after-find-file nil nil t))
(t (user-error "Recover-file canceled")))))
@@ -6664,67 +6797,15 @@ Does not consider `auto-save-visited-file-name' as that
variable is checked
before calling this function.
See also `auto-save-file-name-p'."
(if buffer-file-name
- (let ((handler (find-file-name-handler buffer-file-name
- 'make-auto-save-file-name)))
+ (let ((handler (find-file-name-handler
+ buffer-file-name 'make-auto-save-file-name)))
(if handler
(funcall handler 'make-auto-save-file-name)
- (let ((list auto-save-file-name-transforms)
- (filename buffer-file-name)
- result uniq)
- ;; Apply user-specified translations
- ;; to the file name.
- (while (and list (not result))
- (if (string-match (car (car list)) filename)
- (setq result (replace-match (cadr (car list)) t nil
- filename)
- uniq (car (cddr (car list)))))
- (setq list (cdr list)))
- (if result
- (setq filename
- (cond
- ((memq uniq (secure-hash-algorithms))
- (concat
- (file-name-directory result)
- (secure-hash uniq filename)))
- (uniq
- (concat
- (file-name-directory result)
- (subst-char-in-string
- ?/ ?!
- (replace-regexp-in-string
- "!" "!!" filename))))
- (t result))))
- (setq result
- (if (and (eq system-type 'ms-dos)
- (not (msdos-long-file-names)))
- ;; We truncate the file name to DOS 8+3 limits
- ;; before doing anything else, because the regexp
- ;; passed to string-match below cannot handle
- ;; extensions longer than 3 characters, multiple
- ;; dots, and other atrocities.
- (let ((fn (dos-8+3-filename
- (file-name-nondirectory buffer-file-name))))
- (string-match
- "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
- fn)
- (concat (file-name-directory buffer-file-name)
- "#" (match-string 1 fn)
- "." (match-string 3 fn) "#"))
- (concat (file-name-directory filename)
- "#"
- (file-name-nondirectory filename)
- "#")))
- ;; Make sure auto-save file names don't contain characters
- ;; invalid for the underlying filesystem.
- (if (and (memq system-type '(ms-dos windows-nt cygwin))
- ;; Don't modify remote filenames
- (not (file-remote-p result)))
- (convert-standard-filename result)
- result))))
-
+ (files--transform-file-name
+ buffer-file-name auto-save-file-name-transforms
+ "#" "#")))
;; Deal with buffers that don't have any associated files. (Mail
;; mode tends to create a good number of these.)
-
(let ((buffer-name (buffer-name))
(limit 0)
file-name)
@@ -6772,6 +6853,74 @@ See also `auto-save-file-name-p'."
(file-error nil))
file-name)))
+(defun files--transform-file-name (filename transforms prefix suffix)
+ "Transform FILENAME according to TRANSFORMS.
+See `auto-save-file-name-transforms' for the format of
+TRANSFORMS. PREFIX is prepended to the non-directory portion of
+the resulting file name, and SUFFIX is appended."
+ (save-match-data
+ (let (result uniq)
+ ;; Apply user-specified translations to the file name.
+ (while (and transforms (not result))
+ (if (string-match (car (car transforms)) filename)
+ (setq result (replace-match (cadr (car transforms)) t nil
+ filename)
+ uniq (car (cddr (car transforms)))))
+ (setq transforms (cdr transforms)))
+ (when result
+ (setq filename
+ (cond
+ ((memq uniq (secure-hash-algorithms))
+ (concat
+ (file-name-directory result)
+ (secure-hash uniq filename)))
+ (uniq
+ (concat
+ (file-name-directory result)
+ (subst-char-in-string
+ ?/ ?!
+ (replace-regexp-in-string
+ "!" "!!" filename))))
+ (t result))))
+ (setq result
+ (if (and (eq system-type 'ms-dos)
+ (not (msdos-long-file-names)))
+ ;; We truncate the file name to DOS 8+3 limits before
+ ;; doing anything else, because the regexp passed to
+ ;; string-match below cannot handle extensions longer
+ ;; than 3 characters, multiple dots, and other
+ ;; atrocities.
+ (let ((fn (dos-8+3-filename
+ (file-name-nondirectory buffer-file-name))))
+ (string-match
+ "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
+ fn)
+ (concat (file-name-directory buffer-file-name)
+ prefix (match-string 1 fn)
+ "." (match-string 3 fn) suffix))
+ (concat (file-name-directory filename)
+ prefix
+ (file-name-nondirectory filename)
+ suffix)))
+ ;; Make sure auto-save file names don't contain characters
+ ;; invalid for the underlying filesystem.
+ (expand-file-name
+ (if (and (memq system-type '(ms-dos windows-nt cygwin))
+ ;; Don't modify remote filenames
+ (not (file-remote-p result)))
+ (convert-standard-filename result)
+ result)))))
+
+(defun make-lock-file-name (filename)
+ "Make a lock file name for FILENAME.
+By default, this just prepends \".#\" to the non-directory part
+of FILENAME, but the transforms in `lock-file-name-transforms'
+are done first."
+ (let ((handler (find-file-name-handler filename 'make-lock-file-name)))
+ (if handler
+ (funcall handler 'make-lock-file-name filename)
+ (files--transform-file-name filename lock-file-name-transforms ".#"
""))))
+
(defun auto-save-file-name-p (filename)
"Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
FILENAME should lack slashes.
@@ -7981,16 +8130,16 @@ Otherwise, trash FILENAME using the freedesktop.org
conventions,
;; exists, but the file name may exist in the trash
;; directory even if there is no info file for it.
(when (file-exists-p
- (expand-file-name files-base trash-files-dir))
+ (file-name-concat trash-files-dir files-base))
(setq overwrite t
files-base (file-name-nondirectory
(make-temp-file
- (expand-file-name
- files-base trash-files-dir)
+ (file-name-concat
+ trash-files-dir files-base)
is-directory))))
- (setq info-fn (expand-file-name
- (concat files-base ".trashinfo")
- trash-info-dir))
+ (setq info-fn (file-name-concat
+ trash-info-dir
+ (concat files-base ".trashinfo")))
;; Re-check the existence (sort of).
(condition-case nil
(write-region nil nil info-fn nil 'quiet info-fn 'excl)
@@ -7999,14 +8148,14 @@ Otherwise, trash FILENAME using the freedesktop.org
conventions,
;; like Emacs-style backup file names. E.g.:
;; https://bugs.kde.org/170956
(setq info-fn (make-temp-file
- (expand-file-name files-base trash-info-dir)
+ (file-name-concat trash-info-dir files-base)
nil ".trashinfo"))
(setq files-base (substring (file-name-nondirectory info-fn)
0 (- (length ".trashinfo"))))
(write-region nil nil info-fn nil 'quiet info-fn)))
;; Finally, try to move the file to the trashcan.
(let ((delete-by-moving-to-trash nil)
- (new-fn (expand-file-name files-base trash-files-dir)))
+ (new-fn (file-name-concat trash-files-dir files-base)))
(rename-file fn new-fn overwrite)))))))))
(defsubst file-attribute-type (attributes)
diff --git a/lisp/frame.el b/lisp/frame.el
index aff1d47..146fe27 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -36,7 +36,7 @@ as its argument.")
(cl-generic-define-context-rewriter window-system (value)
;; If `value' is a `consp', it's probably an old-style specializer,
;; so just use it, and anyway `eql' isn't very useful on cons cells.
- `(window-system ,(if (consp value) value `(eql ,value))))
+ `(window-system ,(if (consp value) value `(eql ',value))))
(cl-defmethod frame-creation-function (params &context (window-system nil))
;; It's tempting to get rid of tty-create-frame-with-faces and turn it into
@@ -1231,7 +1231,7 @@ face specs for the new background mode."
;; during startup with -rv on the command
;; line for the initial frame, because frames
;; are not recorded in the pdump file.
- (assq face (frame-face-alist frame))
+ (gethash face (frame--face-hash-table))
(face-spec-match-p face
(face-user-default-spec face)
frame)))
@@ -1397,7 +1397,7 @@ FRAME defaults to the selected frame."
(declare-function x-list-fonts "xfaces.c"
(pattern &optional face frame maximum width))
-(defun set-frame-font (font &optional keep-size frames)
+(defun set-frame-font (font &optional keep-size frames inhibit-customize)
"Set the default font to FONT.
When called interactively, prompt for the name of a font, and use
that font on the selected frame. When called from Lisp, FONT
@@ -1414,7 +1414,10 @@ If FRAMES is non-nil, it should be a list of frames to
act upon,
or t meaning all existing graphical frames.
Also, if FRAMES is non-nil, alter the user's Customization settings
as though the font-related attributes of the `default' face had been
-\"set in this session\", so that the font is applied to future frames."
+\"set in this session\", so that the font is applied to future frames.
+
+If INHIBIT-CUSTOMIZE is non-nil, don't update the user's
+Customization settings."
(interactive
(let* ((completion-ignore-case t)
(default (frame-parameter nil 'font))
@@ -1451,7 +1454,8 @@ as though the font-related attributes of the `default'
face had been
f
(list (cons 'height (round height (frame-char-height f)))
(cons 'width (round width (frame-char-width f))))))))
- (when frames
+ (when (and frames
+ (not inhibit-customize))
;; Alter the user's Custom setting of the `default' face, but
;; only for font-related attributes.
(let ((specs (cadr (assq 'user (get 'default 'theme-face))))
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index f2ec946..fb0295d 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -6039,7 +6039,28 @@ If nil, don't show those extra buttons."
(ignored gnus-ignored-mime-types)
(mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight))
(not-attachment t)
- display text)
+ ;; Arrange a callback from `mm-inline-message' if we're
+ ;; displaying a message/rfc822 part.
+ (mm-inline-message-prepare-function
+ (lambda (charset)
+ (let ((handles
+ (let (gnus-article-mime-handles
+ ;; disable prepare hook
+ gnus-article-prepare-hook
+ (gnus-newsgroup-charset
+ ;; mm-uu might set it.
+ (unless (eq charset 'gnus-decoded)
+ (or charset gnus-newsgroup-charset))))
+ (let ((gnus-original-article-buffer
+ (mm-handle-buffer handle)))
+ (run-hooks 'gnus-article-decode-hook))
+ (gnus-article-prepare-display)
+ gnus-article-mime-handles)))
+ (when handles
+ (setq gnus-article-mime-handles
+ (mm-merge-handles gnus-article-mime-handles handles))))))
+ display text
+ gnus-displaying-mime)
(catch 'ignored
(progn
(while ignored
@@ -6217,8 +6238,9 @@ If nil, don't show those extra buttons."
(gnus-display-mime preferred)
(let ((mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
- (with-current-buffer gnus-summary-buffer
- gnus-newsgroup-ignored-charsets)))
+ (and (buffer-live-p gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-ignored-charsets))))
(gnus-bind-mm-vars (mm-display-part preferred))
;; Do highlighting.
(save-excursion
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index c8b95d9..6202567 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -589,8 +589,8 @@ simple manner."
"\M-p" gnus-group-prev-unread-group-same-level
"," gnus-group-best-unread-group
"." gnus-group-first-unread-group
- "u" gnus-group-unsubscribe-current-group
- "U" gnus-group-unsubscribe-group
+ "u" gnus-group-toggle-subscription-at-point
+ "U" gnus-group-toggle-subscription
"c" gnus-group-catchup-current
"C" gnus-group-catchup-current-all
"\M-c" gnus-group-clear-data
@@ -767,8 +767,8 @@ simple manner."
(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
"l" gnus-group-set-current-level
- "t" gnus-group-unsubscribe-current-group
- "s" gnus-group-unsubscribe-group
+ "t" gnus-group-toggle-subscription-at-point
+ "s" gnus-group-toggle-subscription
"k" gnus-group-kill-group
"y" gnus-group-yank-group
"w" gnus-group-kill-region
@@ -814,7 +814,7 @@ simple manner."
["Check for new articles " gnus-topic-get-new-news-this-topic
:included (gnus-topic-mode-p)
:help "Check for new messages in current group or topic"]
- ["Toggle subscription" gnus-group-unsubscribe-current-group
+ ["Toggle subscription" gnus-group-toggle-subscription-at-point
(gnus-group-group-name)]
["Kill" gnus-group-kill-group :active (gnus-group-group-name)
:help "Kill (remove) current group"]
@@ -907,7 +907,7 @@ simple manner."
["Execute command" gnus-group-universal-argument
(or gnus-group-marked (gnus-group-group-name))])
("Subscribe"
- ["Subscribe to a group..." gnus-group-unsubscribe-group t]
+ ["Toggle subscription..." gnus-group-toggle-subscription t]
["Kill all newsgroups in region" gnus-group-kill-region
:active mark-active]
["Kill all zombie groups" gnus-group-kill-all-zombies
@@ -1042,7 +1042,7 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome'
and
;; (gnus-group-find-new-groups "???" nil)
(gnus-group-save-newsrc "save")
(gnus-group-describe-group "describe")
- (gnus-group-unsubscribe-current-group "gnus/toggle-subscription")
+ (gnus-group-toggle-subscription-at-point "gnus/toggle-subscription")
(gnus-group-prev-unread-group "left-arrow")
(gnus-group-next-unread-group "right-arrow")
(gnus-group-exit "exit")
@@ -1119,7 +1119,7 @@ The group buffer lists (some of) the groups available.
For instance,
lists all zombie groups.
Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To
subscribe
-to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
+to a group not displayed, type `\\[gnus-group-toggle-subscription]'.
For more in-depth information on this mode, read the manual
(`\\[gnus-info-find-node]').
@@ -3857,61 +3857,90 @@ Uses the process/prefix convention."
(defun gnus-group-unsubscribe (&optional n)
"Unsubscribe the current group."
(interactive "P" gnus-group-mode)
- (gnus-group-unsubscribe-current-group n 'unsubscribe))
+ (gnus-group-set-subscription-at-point n 'unsubscribe))
(defun gnus-group-subscribe (&optional n)
"Subscribe the current group."
(interactive "P" gnus-group-mode)
- (gnus-group-unsubscribe-current-group n 'subscribe))
+ (gnus-group-set-subscription-at-point n 'subscribe))
-(defun gnus-group-unsubscribe-current-group (&optional n do-sub)
+(defsubst gnus-group-unsubscribe-current-group (&optional n do-sub)
+ (if do-sub
+ (gnus-group-set-subscription-at-point n do-sub)
+ (gnus-group-toggle-subscription-at-point n)))
+
+(defsubst gnus-group-unsubscribe-group (group &optional level silent)
+ (if level
+ (gnus-group-set-subscription group level silent)
+ (gnus-group-toggle-subscription group silent)))
+
+(make-obsolete 'gnus-group-unsubscribe-current-group
+ 'gnus-group-toggle-subscription-at-point "28.1")
+
+(make-obsolete 'gnus-group-unsubscribe-group
+ 'gnus-group-toggle-subscription "28.1")
+
+(defun gnus-group-toggle-subscription-at-point (&optional n)
"Toggle subscription of the current group.
If given numerical prefix, toggle the N next groups."
(interactive "P" gnus-group-mode)
+ (gnus-group-set-subscription-at-point n 'toggle))
+
+(defun gnus-group-set-subscription-at-point (n do-sub)
+ "Set subscription of the current group for next N groups."
(dolist (group (gnus-group-process-prefix n))
(gnus-group-remove-mark group)
- (gnus-group-unsubscribe-group
+ (gnus-group-set-subscription
group
- (cond
- ((eq do-sub 'unsubscribe)
- gnus-level-default-unsubscribed)
- ((eq do-sub 'subscribe)
- gnus-level-default-subscribed)
- ((<= (gnus-group-group-level) gnus-level-subscribed)
- gnus-level-default-unsubscribed)
- (t
- gnus-level-default-subscribed))
+ (cl-case do-sub
+ (unsubscribe gnus-level-default-unsubscribed)
+ (subscribe gnus-level-default-subscribed)
+ (toggle (if (<= (gnus-group-group-level) gnus-level-subscribed)
+ gnus-level-default-unsubscribed
+ gnus-level-default-subscribed))
+ (t (error "Unknown subscription setting %s" do-sub)))
t)
(gnus-group-update-group-line))
(gnus-group-next-group 1))
-(defun gnus-group-unsubscribe-group (group &optional level silent)
- "Toggle subscription to GROUP.
-Killed newsgroups are subscribed. If SILENT, don't try to update the
-group line."
+(defun gnus-group-toggle-subscription (group &optional silent)
(interactive (list (gnus-group-completing-read
nil nil (gnus-read-active-file-p)))
gnus-group-mode)
+ (let* ((newsrc (gnus-group-entry group))
+ (level (cond
+ (newsrc
+ ;; Toggle subscription flag.
+ (if (<= (gnus-info-level (nth 1 newsrc))
+ gnus-level-subscribed)
+ (1+ gnus-level-subscribed)
+ gnus-level-default-subscribed))
+ ((and (stringp group)
+ (or (not (gnus-read-active-file-p))
+ (gnus-active group)))
+ ;; Add new newsgroup.
+ gnus-level-default-subscribed)
+ (t 'unsubscribe))))
+ (gnus-group-set-subscription group level silent)))
+
+(defun gnus-group-set-subscription (group level &optional silent)
+ "Set subscription of GROUP to LEVEL.
+Killed newsgroups are subscribed. If SILENT, don't try to update the
+group line."
(let ((newsrc (gnus-group-entry group)))
(cond
((string-match "\\`[ \t]*\\'" group)
(error "Empty group name"))
(newsrc
- ;; Toggle subscription flag.
- (gnus-group-change-level
- newsrc (or level (if (<= (gnus-info-level (nth 1 newsrc))
- gnus-level-subscribed)
- (1+ gnus-level-subscribed)
- gnus-level-default-subscribed)))
+ (gnus-group-change-level newsrc level)
(unless silent
(gnus-group-update-group group)))
((and (stringp group)
(or (not (gnus-read-active-file-p))
(gnus-active group)))
- ;; Add new newsgroup.
(gnus-group-change-level
group
- (or level gnus-level-default-subscribed)
+ level
(or (and (member group gnus-zombie-list)
gnus-level-zombie)
gnus-level-killed)
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index bac987e..db54237 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1597,6 +1597,10 @@ this is a reply."
(if (stringp gnus-gcc-externalize-attachments)
(string-match gnus-gcc-externalize-attachments group)
gnus-gcc-externalize-attachments))
+ ;; If we want to externalize stuff when GCC-ing, then we
+ ;; can't use the cache, because that has all the contents.
+ (when mml-externalize-attachments
+ (setq encoded-cache nil))
(save-excursion
(nnheader-set-temp-buffer " *acc*")
(setq message-options (with-current-buffer cur message-options))
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 70bde26..8182630 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -448,10 +448,10 @@ auto-completion of contact names and addresses for keys
like
Date values (any key in `gnus-search-date-keys') can be provided
in any format that `parse-time-string' can parse (note that this
can produce weird results). Dates with missing bits will be
-interpreted as the most recent occurence thereof (ie \"march 03\"
-is the most recent March 3rd). Lastly, relative specifications
-such as 1d (one day ago) are understood. This also accepts w, m,
-and y. m is assumed to be 30 days.
+interpreted as the most recent occurrence thereof (i.e. \"march
+03\" is the most recent March 3rd). Lastly, relative
+specifications such as 1d (one day ago) are understood. This
+also accepts w, m, and y. m is assumed to be 30 days.
This function will accept pretty much anything as input. Its
only job is to parse the query into a sexp, and pass that on --
@@ -629,25 +629,30 @@ gnus-*-mark marks, and return an appropriate string."
mark))
(defun gnus-search-query-expand-key (key)
- (cond ((test-completion key gnus-search-expandable-keys)
- ;; We're done!
- key)
- ;; There is more than one possible completion.
- ((consp (cdr (completion-all-completions
- key gnus-search-expandable-keys #'stringp 0)))
- (signal 'gnus-search-parse-error
- (list (format "Ambiguous keyword: %s" key))))
- ;; Return KEY, either completed or untouched.
- ((car-safe (completion-try-completion
- key gnus-search-expandable-keys
- #'stringp 0)))))
+ "Attempt to expand KEY to a full keyword.
+Use `gnus-search-expandable-keys' as a completion table; return
+KEY directly if it can't be completed. Raise an error if KEY is
+ambiguous, meaning that it is a prefix of multiple known
+keywords. This means that it's not possible to enter a custom
+keyword that happens to be a prefix of a known keyword."
+ (let ((comp (try-completion key gnus-search-expandable-keys)))
+ (if (or (eql comp 't) ; Already a key.
+ (null comp)) ; An unknown key.
+ key
+ (if (null (member comp gnus-search-expandable-keys))
+ ;; KEY is a prefix of multiple known keywords, and could not
+ ;; be completed to something unique.
+ (signal 'gnus-search-parse-error
+ (list (format "Ambiguous keyword: %s" key)))
+ ;; We completed to a unique known key.
+ comp))))
(defun gnus-search-query-return-string (&optional delimited trim)
"Return a string from the current buffer.
If DELIMITED is non-nil, assume the next character is a delimiter
character, and return everything between point and the next
-occurence of the delimiter, including the delimiters themselves.
-If TRIM is non-nil, do not return the delimiters. Otherwise,
+occurrence of the delimiter, including the delimiters themselves.
+If TRIM is non-nil, do not return the delimiters. Otherwise,
return one word."
;; This function cannot handle nested delimiters, as it's not a
;; proper parser. Ie, you cannot parse "to:bob or (from:bob or
@@ -975,7 +980,7 @@ Responsible for handling and, or, and parenthetical
expressions.")
;; Most search engines use implicit ANDs.
(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
- (_expr (eql and)))
+ (_expr (eql 'and)))
nil)
;; Most search engines use explicit infixed ORs.
@@ -1351,68 +1356,61 @@ Returns a list of [group article score] vectors."
(cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed)
server query &optional groups)
- (let ((prefix (slot-value engine 'remove-prefix))
- (group-regexp (when groups
- (mapconcat
- (lambda (group-name)
- (mapconcat #'regexp-quote
- (split-string
- (gnus-group-real-name group-name)
- "[.\\/]")
- "[.\\\\/]"))
- groups
- "\\|")))
- artlist vectors article group)
+ (let ((prefix (or (slot-value engine 'remove-prefix)
+ ""))
+ (groups (mapcar #'gnus-group-short-name groups))
+ artlist article group)
(goto-char (point-min))
+ ;; Prep prefix, we want to at least be removing the root
+ ;; filesystem separator.
+ (when (stringp prefix)
+ (setq prefix (file-name-as-directory
+ (expand-file-name prefix "/"))))
(while (not (or (eobp)
(looking-at-p
"\\(?:[[:space:]\n]+\\)?Process .+ finished")))
(pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine)))
(when (and f-name
(file-readable-p f-name)
- (null (file-directory-p f-name))
- (or (null groups)
- (and (gnus-search-single-p query)
- (alist-get 'thread query))
- (string-match-p group-regexp f-name)))
- (push (list f-name score) artlist))))
+ (null (file-directory-p f-name)))
+ (setq group
+ (replace-regexp-in-string
+ "[/\\]" "."
+ (replace-regexp-in-string
+ "/?\\(cur\\|new\\|tmp\\)?/\\'" ""
+ (replace-regexp-in-string
+ "\\`\\." ""
+ (string-remove-prefix
+ prefix (file-name-directory f-name))
+ nil t)
+ nil t)
+ nil t))
+ (setq article (file-name-nondirectory f-name)
+ article
+ ;; TODO: Provide a cleaner way of producing final
+ ;; article numbers for the various backends.
+ (if (string-match-p "\\`[[:digit:]]+\\'" article)
+ (string-to-number article)
+ (nnmaildir-base-name-to-article-number
+ (substring article 0 (string-match ":" article))
+ group (string-remove-prefix "nnmaildir:" server))))
+ (when (and (numberp article)
+ (or (null groups)
+ (member group groups)))
+ (push (list f-name article group score)
+ artlist)))))
;; Are we running an additional grep query?
(when-let ((grep-reg (alist-get 'grep query)))
(setq artlist (gnus-search-grep-search engine artlist grep-reg)))
- ;; Prep prefix.
- (when (and prefix (null (string-empty-p prefix)))
- (setq prefix (file-name-as-directory (expand-file-name prefix))))
- ;; Turn (file-name score) into [group article score].
- (pcase-dolist (`(,f-name ,score) artlist)
- (setq article (file-name-nondirectory f-name)
- group (file-name-directory f-name))
- ;; Remove prefix.
- (when prefix
- (setq group (string-remove-prefix prefix group)))
- ;; Break the directory name down until it's something that
- ;; (probably) can be used as a group name.
- (setq group
- (replace-regexp-in-string
- "[/\\]" "."
- (replace-regexp-in-string
- "/?\\(cur\\|new\\|tmp\\)?/\\'" ""
- (replace-regexp-in-string
- "^[./\\]" ""
- group nil t)
- nil t)
- nil t))
-
- (push (vector (gnus-group-full-name group server)
- (if (string-match-p "\\`[[:digit:]]+\\'" article)
- (string-to-number article)
- (nnmaildir-base-name-to-article-number
- (substring article 0 (string-match ":" article))
- group (string-remove-prefix "nnmaildir:" server)))
- (if (numberp score)
- score
- (string-to-number score)))
- vectors))
- vectors))
+ ;; Munge into the list of vectors expected by nnselect.
+ (mapcar (pcase-lambda (`(,_ ,article ,group ,score))
+ (vector
+ (gnus-group-full-name group server)
+ article
+ (if (numberp score)
+ score
+ (string-to-number score))))
+ artlist)))
(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed))
"Base implementation treats the whole line as a filename, and
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index f66f842..1c75abb 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -716,7 +716,7 @@ claim them."
"\M-n" gnus-browse-next-group
"\M-p" gnus-browse-prev-group
"\r" gnus-browse-select-group
- "u" gnus-browse-unsubscribe-current-group
+ "u" gnus-browse-toggle-subscription-at-point
"l" gnus-browse-exit
"L" gnus-browse-exit
"q" gnus-browse-exit
@@ -735,7 +735,7 @@ claim them."
(easy-menu-define
gnus-browse-menu gnus-browse-mode-map ""
'("Browse"
- ["Subscribe" gnus-browse-unsubscribe-current-group t]
+ ["Toggle Subscribe" gnus-browse-toggle-subscription-at-point t]
["Read" gnus-browse-read-group t]
["Select" gnus-browse-select-group t]
["Describe" gnus-browse-describe-group t]
@@ -881,9 +881,9 @@ All normal editing commands are switched off.
\\<gnus-browse-mode-map>
The only things you can do in this buffer is
-1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group.
-The group will be inserted into the group buffer upon exit from this
-buffer.
+1) `\\[gnus-browse-toggle-subscription-at-point]' to subscribe or unsubscribe
to
+a group. The group will be inserted into the group buffer upon exit from
+this buffer.
2) `\\[gnus-browse-read-group]' to read a group ephemerally.
@@ -933,7 +933,12 @@ If NUMBER, fetch this number of articles."
(interactive "p" gnus-browse-mode)
(gnus-browse-next-group (- n)))
-(defun gnus-browse-unsubscribe-current-group (arg)
+(define-obsolete-function-alias 'gnus-browse-unsubscribe-current-group
+ 'gnus-browse-toggle-subscription-at-point "28.1")
+(define-obsolete-function-alias 'gnus-browse-unsubscribe-group
+ 'gnus-browse-toggle-subscription "28.1")
+
+(defun gnus-browse-toggle-subscription-at-point (arg)
"(Un)subscribe to the next ARG groups.
The variable `gnus-browse-subscribe-newsgroup-method' determines
how new groups will be entered into the group buffer."
@@ -944,7 +949,7 @@ how new groups will be entered into the group buffer."
(arg (abs arg)))
(while (and (> arg 0)
(not (eobp))
- (gnus-browse-unsubscribe-group)
+ (gnus-browse-toggle-subscription)
(zerop (gnus-browse-next-group ward)))
(cl-decf arg))
(gnus-group-position-point)
@@ -976,7 +981,7 @@ doing the deletion."
gnus-browse-mode)
(gnus-group-delete-group group force))
-(defun gnus-browse-unsubscribe-group ()
+(defun gnus-browse-toggle-subscription ()
"Toggle subscription of the current group in the browse buffer."
(let ((sub nil)
(buffer-read-only nil)
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 7dde799..8b93acc 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -525,25 +525,26 @@ be set in `.emacs' instead."
;; Summary mode faces.
-(defface gnus-summary-selected '((t (:underline t)))
+(defface gnus-summary-selected '((t (:underline t :extend t)))
"Face used for selected articles."
:group 'gnus-summary)
(defface gnus-summary-cancelled
'((((class color))
- (:foreground "yellow" :background "black")))
+ (:foreground "yellow" :background "black" :extend t))
+ (t (:extend t)))
"Face used for canceled articles."
:group 'gnus-summary)
(defface gnus-summary-normal-ticked
'((((class color)
(background dark))
- (:foreground "pink"))
+ (:foreground "pink" :extend t))
(((class color)
(background light))
- (:foreground "firebrick"))
+ (:foreground "firebrick" :extend t))
(t
- ()))
+ (:extend t)))
"Face used for normal interest ticked articles."
:group 'gnus-summary)
@@ -560,12 +561,12 @@ be set in `.emacs' instead."
(defface gnus-summary-normal-ancient
'((((class color)
(background dark))
- (:foreground "SkyBlue"))
+ (:foreground "SkyBlue" :extend t))
(((class color)
(background light))
- (:foreground "RoyalBlue"))
+ (:foreground "RoyalBlue" :extend t))
(t
- ()))
+ (:extend t)))
"Face used for normal interest ancient articles."
:group 'gnus-summary)
@@ -582,10 +583,10 @@ be set in `.emacs' instead."
(defface gnus-summary-normal-undownloaded
'((((class color)
(background light))
- (:foreground "cyan4" :bold nil))
+ (:foreground "cyan4" :bold nil :extend t))
(((class color) (background dark))
- (:foreground "LightGray" :bold nil))
- (t (:inverse-video t)))
+ (:foreground "LightGray" :bold nil :extend t))
+ (t (:inverse-video t :extend t)))
"Face used for normal interest uncached articles."
:group 'gnus-summary)
@@ -601,7 +602,7 @@ be set in `.emacs' instead."
(defface gnus-summary-normal-unread
'((t
- ()))
+ (:extend t)))
"Face used for normal interest unread articles."
:group 'gnus-summary)
@@ -618,12 +619,12 @@ be set in `.emacs' instead."
(defface gnus-summary-normal-read
'((((class color)
(background dark))
- (:foreground "PaleGreen"))
+ (:foreground "PaleGreen" :extend t))
(((class color)
(background light))
- (:foreground "DarkGreen"))
+ (:foreground "DarkGreen" :extend t))
(t
- ()))
+ (:extend t)))
"Face used for normal interest read articles."
:group 'gnus-summary)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index a9be2d6..bcbf747 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1658,6 +1658,11 @@ starting with `not' and followed by regexps."
"Face used for displaying MML."
:group 'message-faces)
+(defface message-signature-separator '((t :bold t))
+ "Face used for displaying the signature separator."
+ :group 'message-faces
+ :version "28.1")
+
(defun message-match-to-eoh (_limit)
(let ((start (point)))
(rfc822-goto-eoh)
@@ -1751,9 +1756,22 @@ number of levels specified in the faces
`message-cited-text-*'."
(0 ',cited-text-face))
keywords))
(setq level (1+ level)))
- keywords))
+ keywords)
+ ;; Match signature. This `field' stuff ensures that hitting `RET'
+ ;; after the signature separator doesn't remove the trailing space.
+ (list
+ '(message--match-signature (0 '( face message-signature-separator
+ rear-nonsticky t
+ field signature)))))
"Additional expressions to highlight in Message mode.")
+(defun message--match-signature (limit)
+ (save-excursion
+ (and (re-search-forward message-signature-separator limit t)
+ ;; It's the last one in the buffer.
+ (not (save-excursion
+ (re-search-forward message-signature-separator nil t))))))
+
(defvar message-face-alist
'((bold . message-bold-region)
(underline . underline-region)
@@ -4904,6 +4922,7 @@ Each line should be no more than 79 characters long."
(defvar smtpmail-smtp-service)
(defvar smtpmail-smtp-user)
(defvar smtpmail-stream-type)
+(defvar smtpmail-store-queue-variables)
(defun message-multi-smtp-send-mail ()
"Send the current buffer to `message-send-mail-function'.
@@ -4919,7 +4938,8 @@ that instead."
(message-send-mail-with-sendmail))
((equal (car method) "smtp")
(require 'smtpmail)
- (let* ((smtpmail-smtp-server (nth 1 method))
+ (let* ((smtpmail-store-queue-variables t)
+ (smtpmail-smtp-server (nth 1 method))
(service (nth 2 method))
(port (string-to-number service))
;; If we're talking to the TLS SMTP port, then force a
@@ -5337,7 +5357,7 @@ Otherwise, generate and save a value for
`canlock-password' first."
;; Check "Shoot me".
(message-check 'shoot
(if (re-search-forward
- "Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" nil t)
+ "Message-ID.*.mail-host-address-is-not-set" nil t)
(y-or-n-p "You appear to have a misconfigured system. Really post? ")
t))
;; Check for Approved.
@@ -6048,8 +6068,7 @@ give as trustworthy answer as possible."
user-domain)
;; Default to this bogus thing.
(t
- (concat sysname
- ".i-did-not-set--mail-host-address--so-tickle-me")))))
+ (concat sysname ".mail-host-address-is-not-set")))))
(defun message-make-domain ()
"Return the domain name."
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 3e36d67..2ec75a0 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -418,16 +418,18 @@ This is only used if `mm-inline-large-images' is set to
(fundamental-mode)
(goto-char (point-min)))
-(defvar gnus-original-article-buffer)
-(defvar gnus-article-prepare-hook)
-(defvar gnus-displaying-mime)
+(defvar mm-inline-message-prepare-function nil
+ "Function called by `mm-inline-message' to do client specific setup.
+It is called with one parameter -- the charset.")
(defun mm-inline-message (handle)
+ "Insert HANDLE (a message/rfc822 part) into the current buffer.
+This function will call `mm-inline-message-prepare-function'
+after inserting the part."
(let ((b (point))
(bolp (bolp))
(charset (mail-content-type-get
- (mm-handle-type handle) 'charset))
- gnus-displaying-mime handles)
+ (mm-handle-type handle) 'charset)))
(when (and charset
(stringp charset))
(setq charset (intern (downcase charset)))
@@ -437,16 +439,8 @@ This is only used if `mm-inline-large-images' is set to
(save-restriction
(narrow-to-region b b)
(mm-insert-part handle)
- (let (gnus-article-mime-handles
- ;; disable prepare hook
- gnus-article-prepare-hook
- (gnus-newsgroup-charset
- (unless (eq charset 'gnus-decoded) ;; mm-uu might set it.
- (or charset gnus-newsgroup-charset))))
- (let ((gnus-original-article-buffer (mm-handle-buffer handle)))
- (run-hooks 'gnus-article-decode-hook))
- (gnus-article-prepare-display)
- (setq handles gnus-article-mime-handles))
+ (when mm-inline-message-prepare-function
+ (funcall mm-inline-message-prepare-function charset))
(goto-char (point-min))
(unless bolp
(insert "\n"))
@@ -454,9 +448,6 @@ This is only used if `mm-inline-large-images' is set to
(unless (bolp)
(insert "\n"))
(insert "----------\n\n")
- (when handles
- (setq gnus-article-mime-handles
- (mm-merge-handles gnus-article-mime-handles handles)))
(mm-handle-set-undisplayer
handle
(let ((beg (point-min-marker))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 3e2a202..3cf6545 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -599,6 +599,13 @@ during splitting, which may be slow."
(eq nnimap-authenticator 'anonymous)
(eq nnimap-authenticator 'login)))
(nnimap-command "LOGIN %S %S" user password))
+ ((and (nnimap-capability "AUTH=XOAUTH2")
+ (eq nnimap-authenticator 'xoauth2))
+ (nnimap-command "AUTHENTICATE XOAUTH2 %s"
+ (base64-encode-string
+ (format "user=%s\001auth=Bearer %s\001\001"
+ (nnimap-quote-specials user)
+ (nnimap-quote-specials password)))))
((and (nnimap-capability "AUTH=CRAM-MD5")
(or (null nnimap-authenticator)
(eq nnimap-authenticator 'cram-md5)))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index afdb0d1..d7fb038 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -752,7 +752,7 @@ FILE is the file where FUNCTION was probably defined."
(insert-text-button
(symbol-name group)
'action (lambda (_)
- (shortdoc-display-group group))
+ (shortdoc-display-group group object))
'follow-link t
'help-echo (purecopy "mouse-1, RET: show documentation group")))
groups)
@@ -1078,6 +1078,9 @@ it is displayed along with the global value."
(with-current-buffer standard-output
(setq help-mode--current-data
(list :symbol variable
+ :type (if (eq file-name 'C-source)
+ 'variable
+ 'defvar)
:file file-name))
(save-excursion
(re-search-backward (substitute-command-keys
@@ -1089,7 +1092,8 @@ it is displayed along with the global value."
"It is void as a variable."
"Its "))
(with-current-buffer standard-output
- (setq help-mode--current-data (list :symbol
variable)))
+ (setq help-mode--current-data (list :symbol variable
+ :type 'variable)))
(if valvoid
" is void as a variable."
(substitute-command-keys "'s ")))))
@@ -1573,11 +1577,7 @@ current buffer and the selected frame, respectively."
(insert doc)
(delete-region (point)
(progn (skip-chars-backward " \t\n") (point)))
- (insert "\n\n"
- (eval-when-compile
- (propertize "\n" 'face
- '(:height 0.1 :inverse-video t :extend t)))
- "\n")
+ (insert "\n\n" (make-separator-line) "\n")
(when name
(insert (symbol-name symbol)
" is also a " name "." "\n\n"))))
@@ -1901,7 +1901,7 @@ documentation for the major and minor modes of that
buffer."
;; Ignore aliases.
(not (symbolp (symbol-function sym)))
;; Ignore everything bound.
- (not (where-is-internal sym))
+ (not (where-is-internal sym nil t))
(apply #'derived-mode-p (command-modes sym)))
(push sym functions))))
(with-temp-buffer
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 4e73551..8206115 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -35,7 +35,6 @@
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (make-composed-keymap button-buffer-map
special-mode-map))
- (define-key map [mouse-2] 'help-follow-mouse)
(define-key map "l" 'help-go-back)
(define-key map "r" 'help-go-forward)
(define-key map "\C-c\C-b" 'help-go-back)
@@ -43,7 +42,6 @@
(define-key map [XF86Back] 'help-go-back)
(define-key map [XF86Forward] 'help-go-forward)
(define-key map "\C-c\C-c" 'help-follow-symbol)
- (define-key map "\r" 'help-follow)
(define-key map "s" 'help-view-source)
(define-key map "i" 'help-goto-info)
(define-key map "c" 'help-customize)
@@ -88,20 +86,20 @@
(defvar-local help-xref-stack nil
"A stack of ways by which to return to help buffers after following xrefs.
-Used by `help-follow' and `help-xref-go-back'.
+Used by `help-follow-symbol' and `help-xref-go-back'.
An element looks like (POSITION FUNCTION ARGS...).
To use the element, do (apply FUNCTION ARGS) then goto the point.")
(put 'help-xref-stack 'permanent-local t)
(defvar-local help-xref-forward-stack nil
"A stack used to navigate help forwards after using the back button.
-Used by `help-follow' and `help-xref-go-forward'.
+Used by `help-follow-symbol' and `help-xref-go-forward'.
An element looks like (POSITION FUNCTION ARGS...).
To use the element, do (apply FUNCTION ARGS) then goto the point.")
(put 'help-xref-forward-stack 'permanent-local t)
(defvar-local help-xref-stack-item nil
- "An item for `help-follow' in this buffer to push onto `help-xref-stack'.
+ "An item for `help-follow-symbok' to push onto `help-xref-stack'.
The format is (FUNCTION ARGS...).")
(put 'help-xref-stack-item 'permanent-local t)
@@ -466,7 +464,7 @@ Each element has the form (NAME TESTFUN DESCFUN) where:
"Parse and hyperlink documentation cross-references in the given BUFFER.
Find cross-reference information in a buffer and activate such cross
-references for selection with `help-follow'. Cross-references have
+references for selection with `help-follow-symbol'. Cross-references have
the canonical form `...' and the type of reference may be
disambiguated by the preceding word(s) used in
`help-xref-symbol-regexp'. Faces only get cross-referenced if
@@ -738,8 +736,10 @@ See `help-make-xrefs'."
(interactive nil help-mode)
(unless (plist-get help-mode--current-data :file)
(error "Source file for the current help item is not defined"))
- (help-function-def--button-function (plist-get help-mode--current-data
:symbol)
- (plist-get help-mode--current-data
:file)))
+ (help-function-def--button-function
+ (plist-get help-mode--current-data :symbol)
+ (plist-get help-mode--current-data :file)
+ (plist-get help-mode--current-data :type)))
(defun help-goto-info ()
"View the *info* node of the current help item."
@@ -772,6 +772,7 @@ a proper [back] button."
;; The doc string is meant to explain what buttons do.
(defun help-follow-mouse ()
"Follow the cross-reference that you click on."
+ (declare (obsolete nil "28.1"))
(interactive)
(error "No cross-reference here"))
@@ -780,6 +781,7 @@ a proper [back] button."
"Follow cross-reference at point.
For the cross-reference format, see `help-make-xrefs'."
+ (declare (obsolete nil "28.1"))
(interactive)
(user-error "No cross-reference here"))
diff --git a/lisp/help.el b/lisp/help.el
index 1bb1b30..ba27fc5 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -943,12 +943,7 @@ current buffer."
(when defn
(when (> (length info-list) 1)
(with-current-buffer standard-output
- (insert "\n\n"
- ;; FIXME: Can't use eval-when-compile because purified
- ;; strings lose their text properties :-(
- (propertize "\n" 'face
- '(:height 0.1 :inverse-video t :extend t))
- "\n")))
+ (insert "\n\n" (make-separator-line) "\n")))
(princ brief-desc)
(when locus
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 68f8cc5..37b88b3 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -111,7 +111,7 @@ highlighting will be applied throughout the buffer."
:group 'hi-lock)
(defcustom hi-lock-exclude-modes
- '(rmail-mode mime/viewer-mode gnus-article-mode)
+ '(rmail-mode mime/viewer-mode gnus-article-mode term-mode)
"List of major modes in which hi-lock will not run.
For security reasons since font lock patterns can specify function
calls."
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index 3c3c407..8919e98 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -492,9 +492,9 @@ This allows you to manually remove highlighting from
uninteresting changes."
;; otherwise an undone change shows up as changed. While the properties
;; are automatically restored by undo, we must fix up the overlay.
(save-match-data
- (let (;;(beg-decr 1)
- (end-incr 1)
- (type 'hilit-chg))
+ (let ((end-incr 1)
+ (type 'hilit-chg)
+ (property 'hilit-chg))
(if undo-in-progress
(if (and highlight-changes-mode
highlight-changes-visible-mode)
@@ -515,7 +515,8 @@ This allows you to manually remove highlighting from
uninteresting changes."
;; (setq beg-decr 0))))
;; (setq beg (max (- beg beg-decr) (point-min)))
(setq end (min (+ end end-incr) (point-max)))
- (setq type 'hilit-chg-delete))
+ (setq type 'hilit-chg-delete
+ property 'hilit-chg-delete))
;; Not a deletion.
;; Most of the time the following is not necessary, but
;; if the current text was marked as a deletion then
@@ -523,14 +524,15 @@ This allows you to manually remove highlighting from
uninteresting changes."
;; text where she earlier deleted text, we have to remove the
;; deletion marking, and replace it explicitly with a `changed'
;; marking, otherwise its highlighting would disappear.
- (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete)
- (save-restriction
- (widen)
- (put-text-property end (+ end 1) 'hilit-chg 'hilit-chg)
- (if highlight-changes-visible-mode
- (hilit-chg-fixup end (+ end 1))))))
+ (when (eq (get-text-property end 'hilit-chg-delete)
+ 'hilit-chg-delete)
+ (save-restriction
+ (widen)
+ (put-text-property end (+ end 1) 'hilit-chg-delete nil)
+ (if highlight-changes-visible-mode
+ (hilit-chg-fixup end (+ end 1))))))
(unless no-property-change
- (put-text-property beg end 'hilit-chg type))
+ (put-text-property beg end property type))
(if (or highlight-changes-visible-mode no-property-change)
(hilit-chg-make-ov type beg end)))))))
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 576fced..adea150 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -97,6 +97,12 @@ Otherwise this should be a list of the completion tables
(e.g.,
:type '(choice (const :tag "All" t)
(repeat function)))
+(defcustom icomplete-matches-format "%s/%s "
+ "Format of the current/total number of matches for the prompt prefix."
+ :version "28.1"
+ :type '(choice (const :tag "No prefix" nil)
+ (string :tag "Prefix format string")))
+
(defface icomplete-first-match '((t :weight bold))
"Face used by Icomplete for highlighting first match."
:version "24.4")
@@ -696,12 +702,12 @@ See `icomplete-mode' and `minibuffer-setup-hook'."
(overlay-put
icomplete-overlay 'before-string
(and icomplete-scroll
- (let ((past (length icomplete--scrolled-past)))
- (format
- "%s/%s "
- (1+ past)
- (+ past
- (safe-length completion-all-sorted-completions))))))
+ icomplete-matches-format
+ (let* ((past (length icomplete--scrolled-past))
+ (current (1+ past))
+ (total (+ past (safe-length
+
completion-all-sorted-completions))))
+ (format icomplete-matches-format current total))))
(overlay-put icomplete-overlay 'after-string text))))))))
(defun icomplete--affixate (md prospects)
diff --git a/lisp/ido.el b/lisp/ido.el
index 9362904..ea5ff32 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1521,6 +1521,10 @@ Removes badly formatted data and ignored directories."
:global t
(remove-function read-file-name-function #'ido-read-file-name)
(remove-function read-buffer-function #'ido-read-buffer)
+ (when (boundp 'ffap-file-finder)
+ (remove-function ffap-file-finder #'ido-find-file)
+ (when ido-mode
+ (add-function :override ffap-file-finder #'ido-find-file)))
(when ido-everywhere
(if (not ido-mode)
(ido-mode 'both)
diff --git a/lisp/image.el b/lisp/image.el
index ee15294..494c26a 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1191,7 +1191,9 @@ rotations by only multiples of 90 degrees."
360)))))
(defun image-save ()
- "Save the image under point."
+ "Save the image under point.
+This writes the original image data to a file. Rotating or
+changing the displayed image size does not affect the saved image."
(interactive)
(let ((image (image--get-image)))
(with-temp-buffer
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el
index e47f1f7..97bf1ac 100644
--- a/lisp/image/image-converter.el
+++ b/lisp/image/image-converter.el
@@ -133,7 +133,7 @@ data is returned as a string."
(list value)
value)))
-(cl-defmethod image-converter--probe ((type (eql graphicsmagick)))
+(cl-defmethod image-converter--probe ((type (eql 'graphicsmagick)))
"Check whether the system has GraphicsMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -151,7 +151,7 @@ data is returned as a string."
(push (downcase (match-string 1)) formats)))
(nreverse formats)))))
-(cl-defmethod image-converter--probe ((type (eql imagemagick)))
+(cl-defmethod image-converter--probe ((type (eql 'imagemagick)))
"Check whether the system has ImageMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -171,7 +171,7 @@ data is returned as a string."
(push (downcase (match-string 1)) formats)))
(nreverse formats))))
-(cl-defmethod image-converter--probe ((type (eql ffmpeg)))
+(cl-defmethod image-converter--probe ((type (eql 'ffmpeg)))
"Check whether the system has ffmpeg installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -212,12 +212,12 @@ Only suffixes that map to `image-mode' are returned."
'image-mode)
collect suffix))
-(cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source
+(cl-defmethod image-converter--convert ((type (eql 'graphicsmagick)) source
image-format)
"Convert using GraphicsMagick."
(image-converter--convert-magick type source image-format))
-(cl-defmethod image-converter--convert ((type (eql imagemagick)) source
+(cl-defmethod image-converter--convert ((type (eql 'imagemagick)) source
image-format)
"Convert using ImageMagick."
(image-converter--convert-magick type source image-format))
@@ -249,7 +249,7 @@ Only suffixes that map to `image-mode' are returned."
;; error message.
(buffer-string))))
-(cl-defmethod image-converter--convert ((type (eql ffmpeg)) source
+(cl-defmethod image-converter--convert ((type (eql 'ffmpeg)) source
image-format)
"Convert using ffmpeg."
(let ((command (image-converter--value type :command)))
diff --git a/lisp/info.el b/lisp/info.el
index cdf339f..b65728b 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -391,6 +391,14 @@ where SUPPORTS-INDEX-COOKIES can be either t or nil.")
(defvar-local Info-index-alternatives nil
"List of possible matches for last `Info-index' command.")
+(defvar-local Info--current-index-alternative 0
+ "Current displayed index alternative.")
+
+(defcustom Info-warn-on-index-alternatives-wrap t
+ "Warn when wrapping to the beginning/end when displaying index alternatives."
+ :type 'boolean
+ :version "28.1")
+
(defvar Info-point-loc nil
"Point location within a selected node.
If string, the point is moved to the proper occurrence of the
@@ -3375,39 +3383,56 @@ Give an empty topic name to go to the Index node
itself."
(setq exact (cons found exact)
matches (delq found matches)))
(setq Info-history-list ohist-list)
- (setq Info-index-alternatives (nconc exact (nreverse matches)))
+ (setq Info-index-alternatives (nconc exact (nreverse matches))
+ Info--current-index-alternative 0)
(Info-index-next 0)))))
(defun Info-index-next (num)
- "Go to the next matching index item from the last
\\<Info-mode-map>\\[Info-index] command."
+ "Go to the next matching index item from the last
\\<Info-mode-map>\\[Info-index] command.
+If given a numeric prefix, skip that many index items forward (or
+backward).
+
+Also see the `Info-warn-on-index-alternatives-wrap' user option."
(interactive "p" Info-mode)
- (or Info-index-alternatives
- (user-error "No previous `i' command"))
- (while (< num 0)
- (setq num (+ num (length Info-index-alternatives))))
- (while (> num 0)
- (setq Info-index-alternatives
- (nconc (cdr Info-index-alternatives)
- (list (car Info-index-alternatives)))
- num (1- num)))
- (Info-goto-node (nth 1 (car Info-index-alternatives)))
- (if (> (nth 3 (car Info-index-alternatives)) 0)
- ;; Forward 2 lines less because `Info-find-node-2' initially
- ;; puts point to the 2nd line.
- (forward-line (- (nth 3 (car Info-index-alternatives)) 2))
- (forward-line 3) ; don't search in headers
- (let ((name (car (car Info-index-alternatives))))
- (Info-find-index-name name)))
- (message "Found `%s' in %s. %s"
- (car (car Info-index-alternatives))
- (nth 2 (car Info-index-alternatives))
- (if (cdr Info-index-alternatives)
- (format-message
- "(%s total; use `%s' for next)"
- (length Info-index-alternatives)
- (key-description (where-is-internal
- 'Info-index-next overriding-local-map t)))
- "(Only match)")))
+ (unless Info-index-alternatives
+ (user-error "No previous `i' command"))
+ (let ((index (+ Info--current-index-alternative num))
+ (total (length Info-index-alternatives))
+ (next-key (key-description (where-is-internal
+ 'Info-index-next overriding-local-map t))))
+ (if (and Info-warn-on-index-alternatives-wrap
+ (> total 1)
+ (cond
+ ((< index 0)
+ (setq Info--current-index-alternative (- total 2))
+ (message
+ "No previous matches, use `%s' to continue from end of list"
+ next-key)
+ t)
+ ((>= index total)
+ (setq Info--current-index-alternative -1)
+ (message
+ "No previous matches, use `%s' to continue from start of list"
+ next-key)
+ t)))
+ () ; Do nothing
+ (setq index (mod index total)
+ Info--current-index-alternative index)
+ (let ((entry (nth index Info-index-alternatives)))
+ (Info-goto-node (nth 1 entry))
+ (if (> (nth 3 entry) 0)
+ ;; Forward 2 lines less because `Info-find-node-2' initially
+ ;; puts point to the 2nd line.
+ (forward-line (- (nth 3 entry) 2))
+ (forward-line 3) ; don't search in headers
+ (Info-find-index-name (car entry)))
+ (message "Found `%s' in %s. %s"
+ (car entry)
+ (nth 2 entry)
+ (if (> total 1)
+ (format-message
+ "(%s total; use `%s' for next)" total next-key)
+ "(Only match)"))))))
(defun Info-find-index-name (name)
"Move point to the place within the current node where NAME is defined."
diff --git a/lisp/isearch.el b/lisp/isearch.el
index c8bd628..922ab0f 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -233,6 +233,7 @@ called with the positions of the start and the end of the
text
matched by Isearch and replace commands. If this function
returns nil, Isearch and replace commands will continue searching
without stopping at resp. replacing this match.
+This function is expected to be careful not to clobber the match data.
If you use `add-function' to modify this variable, you can use the
`isearch-message-prefix' advice property to specify the prefix string
@@ -3529,11 +3530,14 @@ Optional third argument, if t, means if fail just
return nil (no error).
;; Clear RETRY unless the search predicate says
;; to skip this search hit.
(if (or (not isearch-success)
- (bobp) (eobp)
- (= (match-beginning 0) (match-end 0))
(funcall isearch-filter-predicate
(match-beginning 0) (match-end 0)))
- (setq retry nil)))
+ (setq retry nil)
+ ;; Advance point on empty matches before retrying
+ (when (= (match-beginning 0) (match-end 0))
+ (if (if isearch-forward (eobp) (bobp))
+ (setq retry nil isearch-success nil)
+ (forward-char (if isearch-forward 1 -1))))))
(setq isearch-just-started nil)
(when isearch-success
(setq isearch-other-end
@@ -4044,7 +4048,6 @@ Attempt to do the search exactly the way the pending
Isearch would."
;; Clear RETRY unless the search predicate says
;; to skip this search hit.
(if (or (not success)
- (= (point) bound) ; like (bobp) (eobp) in `isearch-search'.
(= (match-beginning 0) (match-end 0))
(funcall isearch-filter-predicate
(match-beginning 0) (match-end 0)))
diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el
index 11d93a6..6933a7c 100644
--- a/lisp/jka-cmpr-hook.el
+++ b/lisp/jka-cmpr-hook.el
@@ -104,6 +104,9 @@ Otherwise, it is nil.")
(defun jka-compr-info-can-append (info) (aref info 7))
(defun jka-compr-info-strip-extension (info) (aref info 8))
(defun jka-compr-info-file-magic-bytes (info) (aref info 9))
+(defun jka-compr-info-uncompress-function (info)
+ (and (> (length info) 10)
+ (aref info 10)))
(defun jka-compr-get-compression-info (filename)
@@ -197,13 +200,15 @@ options through Custom does this automatically."
;;[regexp
;; compr-message compr-prog compr-args
;; uncomp-message uncomp-prog uncomp-args
- ;; can-append strip-extension-flag file-magic-bytes]
+ ;; can-append strip-extension-flag file-magic-bytes
+ ;; uncompress-function]
(mapcar 'purecopy
'(["\\.Z\\'"
"compressing" "compress" ("-c")
;; gzip is more common than uncompress. It can only read, not write.
"uncompressing" "gzip" ("-c" "-q" "-d")
- nil t "\037\235"]
+ nil t "\037\235"
+ zlib-decompress-region]
;; Formerly, these had an additional arg "-c", but that fails with
;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and
;; "Version 0.9.0b, 9-Sept-98".
@@ -218,11 +223,13 @@ options through Custom does this automatically."
["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'"
"compressing" "gzip" ("-c" "-q")
"uncompressing" "gzip" ("-c" "-q" "-d")
- t nil "\037\213"]
+ t nil "\037\213"
+ zlib-decompress-region]
["\\.g?z\\'"
"compressing" "gzip" ("-c" "-q")
"uncompressing" "gzip" ("-c" "-q" "-d")
- t t "\037\213"]
+ t t "\037\213"
+ zlib-decompress-region]
["\\.lz\\'"
"Lzip compressing" "lzip" ("-c" "-q")
"Lzip uncompressing" "lzip" ("-c" "-q" "-d")
@@ -259,7 +266,7 @@ options through Custom does this automatically."
Each element, which describes a compression technique, is a vector of
the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
-APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
+APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS UNCOMPRESS-FUNCTION], where:
regexp is a regexp that matches filenames that are
compressed with this format
@@ -275,7 +282,7 @@ APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
uncompress-msg is the message to issue to the user when doing this
type of uncompression (nil means no message)
- uncompress-program is a program that performs this compression
+ uncompress-program is a program that performs this uncompression
uncompress-args is a list of args to pass to the uncompress program
@@ -288,6 +295,9 @@ APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
file-magic-chars is a string of characters that you would find
at the beginning of a file compressed in this way.
+ uncompress-function is a function that performs uncompression, if
+ uncompress-program is not found.
+
If you set this outside Custom while Auto Compression mode is
already enabled \(as it is by default), you have to call
`jka-compr-update' after setting it to properly update other
@@ -309,9 +319,12 @@ variables. Setting this through Custom does that
automatically."
(repeat :tag "Uncompress Arguments" string)
(boolean :tag "Append")
(boolean :tag "Strip Extension")
- (string :tag "Magic Bytes")))
+ (string :tag "Magic Bytes")
+ (choice :tag "Uncompress Function"
+ (symbol)
+ (const :tag "None" nil))))
:set 'jka-compr-set
- :version "24.1" ; removed version extension piece
+ :version "28.1" ; add uncompress-function
:group 'jka-compr)
(defcustom jka-compr-mode-alist-additions
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 2f98c8d..658ea44 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -386,6 +386,7 @@ There should be no more than seven characters after the
final `/'."
(let ((uncompress-message (jka-compr-info-uncompress-message info))
(uncompress-program (jka-compr-info-uncompress-program info))
+ (uncompress-function (jka-compr-info-uncompress-function info))
(uncompress-args (jka-compr-info-uncompress-args info))
(base-name (file-name-nondirectory filename))
(notfound nil)
@@ -409,58 +410,76 @@ There should be no more than seven characters after the
final `/'."
jka-compr-verbose
(message "%s %s..." uncompress-message base-name))
- (condition-case error-code
-
- (let ((coding-system-for-read 'no-conversion))
- (if replace
- (goto-char (point-min)))
- (setq start (point))
- (if (or beg end)
- (jka-compr-partial-uncompress uncompress-program
- (concat
uncompress-message
- " " base-name)
- uncompress-args
- local-file
- (or beg 0)
- (if (and beg end)
- (- end beg)
- end))
- ;; If visiting, bind off buffer-file-name so that
- ;; file-locking will not ask whether we should
- ;; really edit the buffer.
- (let ((buffer-file-name
- (if visit nil buffer-file-name)))
- (jka-compr-call-process uncompress-program
- (concat uncompress-message
- " " base-name)
- local-file
- t
- nil
- uncompress-args)))
- (setq size (- (point) start))
- (if replace
- (delete-region (point) (point-max)))
- (goto-char start))
- (error
- ;; If the file we wanted to uncompress does not exist,
- ;; handle that according to VISIT as `insert-file-contents'
- ;; would, maybe signaling the same error it normally would.
- (if (and (eq (car error-code) 'file-missing)
- (eq (nth 3 error-code) local-file))
- (if visit
- (setq notfound error-code)
- (signal 'file-missing
- (cons "Opening input file"
- (nthcdr 2 error-code))))
- ;; If the uncompression program can't be found,
- ;; signal that as a non-file error
- ;; so that find-file-noselect-1 won't handle it.
- (if (and (memq 'file-error (get (car error-code)
- 'error-conditions))
- (equal (cadr error-code) "Searching for program"))
- (error "Uncompression program `%s' not found"
- (nth 3 error-code)))
- (signal (car error-code) (cdr error-code))))))
+ (if (and (not (executable-find uncompress-program))
+ uncompress-function
+ (fboundp uncompress-function))
+ ;; If we don't have the uncompression program, then use the
+ ;; internal uncompression function (if we have one).
+ (let ((buf (current-buffer)))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally file)
+ (funcall uncompress-function (point-min) (point-max))
+ (when end
+ (delete-region end (point-max)))
+ (when beg
+ (delete-region (point-min) beg))
+ (setq size (buffer-size))
+ (insert-into-buffer buf))
+ (goto-char (point-min)))
+ ;; Use the external uncompression program.
+ (condition-case error-code
+
+ (let ((coding-system-for-read 'no-conversion))
+ (if replace
+ (goto-char (point-min)))
+ (setq start (point))
+ (if (or beg end)
+ (jka-compr-partial-uncompress
+ uncompress-program
+ (concat uncompress-message " " base-name)
+ uncompress-args
+ local-file
+ (or beg 0)
+ (if (and beg end)
+ (- end beg)
+ end))
+ ;; If visiting, bind off buffer-file-name so that
+ ;; file-locking will not ask whether we should
+ ;; really edit the buffer.
+ (let ((buffer-file-name
+ (if visit nil buffer-file-name)))
+ (jka-compr-call-process uncompress-program
+ (concat uncompress-message
+ " " base-name)
+ local-file
+ t
+ nil
+ uncompress-args)))
+ (setq size (- (point) start))
+ (if replace
+ (delete-region (point) (point-max)))
+ (goto-char start))
+ (error
+ ;; If the file we wanted to uncompress does not exist,
+ ;; handle that according to VISIT as `insert-file-contents'
+ ;; would, maybe signaling the same error it normally would.
+ (if (and (eq (car error-code) 'file-missing)
+ (eq (nth 3 error-code) local-file))
+ (if visit
+ (setq notfound error-code)
+ (signal 'file-missing
+ (cons "Opening input file"
+ (nthcdr 2 error-code))))
+ ;; If the uncompression program can't be found,
+ ;; signal that as a non-file error
+ ;; so that find-file-noselect-1 won't handle it.
+ (if (and (memq 'file-error (get (car error-code)
+ 'error-conditions))
+ (equal (cadr error-code) "Searching for
program"))
+ (error "Uncompression program `%s' not found"
+ (nth 3 error-code)))
+ (signal (car error-code) (cdr error-code)))))))
(and
local-copy
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index 89154ae..e6ac5d5 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -952,6 +952,11 @@ This is a good function to put in
`comint-output-filter-functions'.
\(fn IGNORED)" nil nil)
+(autoload 'ansi-color-compilation-filter "ansi-color" "\
+Maybe translate SGR control sequences into text properties.
+This function depends on the `ansi-color-for-compilation-mode'
+variable, and is meant to be used in `compilation-filter-hook'." nil nil)
+
(register-definition-prefixes "ansi-color" '("ansi-color-"))
;;;***
@@ -1548,7 +1553,7 @@ ENTRY is the name of a password-store entry.
The key used to retrieve the password is the symbol `secret'.
The convention used as the format for a password-store file is
-the following (see https://www.passwordstore.org/#organization):
+the following (see URL `https://www.passwordstore.org/#organization'):
secret
key1: value1
@@ -1788,6 +1793,10 @@ disk changes.
When a buffer is reverted, a message is generated. This can be
suppressed by setting `auto-revert-verbose' to nil.
+Reverting can sometimes fail to preserve all the markers in the buffer.
+To avoid that, set `revert-buffer-insert-file-contents-function' to
+the slower function `revert-buffer-insert-file-contents-delicately'.
+
Use `global-auto-revert-mode' to automatically revert all buffers.
Use `auto-revert-tail-mode' if you know that the file will only grow
without being changed in the part that is already in the buffer.
@@ -5215,7 +5224,7 @@ Normally display output in temp buffer, but
prefix arg means replace the region with it.
`c-macro-preprocessor' specifies the preprocessor to use.
-Tf the user option `c-macro-prompt-flag' is non-nil
+If the user option `c-macro-prompt-flag' is non-nil
prompt for arguments to the preprocessor (e.g. `-DDEBUG -I ./include'),
otherwise use `c-macro-cppflags'.
@@ -10888,7 +10897,7 @@ Non-interactively, it takes the keyword arguments
That is, if called with
- (erc :server \"chat.freenode.net\" :full-name \"J. Random Hacker\")
+ (erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
then the server and full-name will be set to those values,
whereas `erc-compute-port' and `erc-compute-nick' will be invoked
@@ -10915,7 +10924,7 @@ Non-interactively, it takes the keyword arguments
That is, if called with
- (erc-tls :server \"chat.freenode.net\" :full-name \"J. Random Hacker\")
+ (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
then the server and full-name will be set to those values,
whereas `erc-compute-port' and `erc-compute-nick' will be invoked
@@ -10931,7 +10940,7 @@ authentication by various IRC networks.
Example usage:
- (erc-tls :server \"chat.freenode.net\" :port 6697
+ (erc-tls :server \"irc.libera.chat\" :port 6697
:client-certificate
'(\"/home/bandali/my-cert.key\"
\"/home/bandali/my-cert.crt\"))
@@ -11216,6 +11225,8 @@ Any other value means use the setting of
`case-fold-search'.")
(custom-autoload 'tags-case-fold-search "etags" t)
+(put 'tags-case-fold-search 'safe-local-variable 'symbolp)
+
(defvar tags-table-list nil "\
List of file names of tags tables to search.
An element that is a directory means the file \"TAGS\" in that directory.
@@ -12269,6 +12280,9 @@ Besides the choice of face, it is the same as
`buffer-face-mode'.
;;;### (autoloads nil "facemenu" "facemenu.el" (0 0 0 0))
;;; Generated autoloads from facemenu.el
+ (autoload 'facemenu-menu "facemenu" nil nil 'keymap)
+
+(define-key global-map [C-down-mouse-2] 'facemenu-menu)
(autoload 'list-colors-display "facemenu" "\
Display names of defined colors, and show what they look like.
@@ -12387,6 +12401,11 @@ reminders, you can set `feedmail-queue-reminder-alist'
to nil.
;;;### (autoloads nil "ffap" "ffap.el" (0 0 0 0))
;;; Generated autoloads from ffap.el
+(defvar ffap-file-finder 'find-file "\
+The command called by `find-file-at-point' to find a file.")
+
+(custom-autoload 'ffap-file-finder "ffap" t)
+
(autoload 'ffap-next "ffap" "\
Search buffer for next file or URL, and run ffap.
Optional argument BACK says to search backwards.
@@ -15348,7 +15367,7 @@ List of hook functions run by `grep-process-setup' (see
`run-hooks').")
(custom-autoload 'grep-setup-hook "grep" t)
-(defconst grep-regexp-alist `((,(concat "^\\(?:"
"\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:"
"\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:"
"\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end
0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg
(text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (-
mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg
(match-end [...]
+(defconst grep-regexp-alist `((,(concat "^\\(?:"
"\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:"
"\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:"
"\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end
0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg
(text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (-
mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg
(match-end [...]
Regexp used to match grep hits.
See `compilation-error-regexp-alist' for format details.")
@@ -16169,7 +16188,7 @@ it does not already exist." nil nil)
Parse and hyperlink documentation cross-references in the given BUFFER.
Find cross-reference information in a buffer and activate such cross
-references for selection with `help-follow'. Cross-references have
+references for selection with `help-follow-symbol'. Cross-references have
the canonical form `...' and the type of reference may be
disambiguated by the preceding word(s) used in
`help-xref-symbol-regexp'. Faces only get cross-referenced if
@@ -18657,9 +18676,14 @@ Convert old Emacs Devanagari characters to UCS.
Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'.
If there is a process already running in `*inferior-lisp*', just switch
to that buffer.
+
With argument, allows you to edit the command line (default is value
of `inferior-lisp-program'). Runs the hooks from
`inferior-lisp-mode-hook' (after the `comint-mode-hook' is run).
+
+If any parts of the command name contains spaces, they should be
+quoted using shell quote syntax.
+
\(Type \\[describe-mode] in the process buffer for a list of commands.)
\(fn CMD)" t nil)
@@ -27308,7 +27332,11 @@ If ARG is non-nil, instead prompt for connection
parameters.
(defalias 'irc 'rcirc)
(autoload 'rcirc-connect "rcirc" "\
-
+Connect to SERVER.
+The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD,
+ENCRYPTION, SERVER-ALIAS are interpreted as in
+`rcirc-server-alist'. STARTUP-CHANNELS is a list of channels
+that are joined after authentication.
\(fn SERVER &optional PORT NICK USER-NAME FULL-NAME STARTUP-CHANNELS PASSWORD
ENCRYPTION SERVER-ALIAS)" nil nil)
@@ -27341,7 +27369,7 @@ disabled.
\(fn &optional ARG)" t nil)
-(register-definition-prefixes "rcirc" '("defun-rcirc-command" "rcirc-"
"set-rcirc-" "with-rcirc-"))
+(register-definition-prefixes "rcirc" '("rcirc-" "with-rcirc-"))
;;;***
@@ -27782,8 +27810,8 @@ This means the number of non-shy regexp grouping
constructs
(autoload 'remember "remember" "\
Remember an arbitrary piece of data.
-INITIAL is the text to initially place in the *Remember* buffer,
-or nil to bring up a blank *Remember* buffer.
+INITIAL is the text to initially place in the `remember-buffer',
+or nil to bring up a blank `remember-buffer'.
With a prefix or a visible region, use the region as INITIAL.
@@ -27884,7 +27912,7 @@ disabled.
\(fn &optional ARG)" t nil)
-(register-definition-prefixes "repeat" '("describe-repeat" "repeat-"))
+(register-definition-prefixes "repeat" '("describe-repeat-maps" "repeat-"))
;;;***
@@ -30312,6 +30340,13 @@ arguments.")
(custom-autoload 'shell-dumb-shell-regexp "shell" t)
+(autoload 'split-string-shell-command "shell" "\
+Split STRING (a shell command) into a list of strings.
+General shell syntax, like single and double quoting, as well as
+backslash quoting, is respected.
+
+\(fn STRING)" nil nil)
+
(autoload 'shell "shell" "\
Run an inferior shell, with I/O through BUFFER (which defaults to `*shell*').
Interactively, a prefix arg means to prompt for BUFFER.
@@ -30358,8 +30393,9 @@ Make the shell buffer the current buffer, and return it.
(autoload 'shortdoc-display-group "shortdoc" "\
Pop to a buffer with short documentation summary for functions in GROUP.
+If FUNCTION is non-nil, place point on the entry for FUNCTION (if any).
-\(fn GROUP)" t nil)
+\(fn GROUP &optional FUNCTION)" t nil)
(register-definition-prefixes "shortdoc" '("alist" "buffer"
"define-short-documentation-group" "file" "hash-table" "list" "number"
"overlay" "process" "regexp" "sequence" "shortdoc-" "string" "vector"))
@@ -34761,7 +34797,7 @@ Add archive file name handler to
`file-name-handler-alist'." (when tramp-archive
;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
;;; Generated autoloads from net/trampver.el
-(push (purecopy '(tramp 2 5 1)) package--builtin-versions)
+(push (purecopy '(tramp 2 5 2 -1)) package--builtin-versions)
(register-definition-prefixes "trampver" '("tramp-"))
@@ -35885,11 +35921,14 @@ instead of just \"key\" as in the example above.
\(fn QUERY &optional SEMICOLONS KEEP-EMPTY)" nil nil)
(autoload 'url-unhex-string "url-util" "\
-Remove %XX embedded spaces, etc in a URL.
+Decode %XX sequences in a percent-encoded URL.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
decoding of carriage returns and line feeds in the string, which is normally
forbidden in URL encoding.
+The resulting string in general requires decoding using an
+appropriate coding-system; see `decode-coding-string'.
+
\(fn STR &optional ALLOW-NEWLINES)" nil nil)
(autoload 'url-hexify-string "url-util" "\
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 24d49ea..9041b9a 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -276,7 +276,9 @@ supports ordinary shell wildcards if
`ls-lisp-support-shell-wildcards'
is non-nil; otherwise, it interprets wildcards as regular expressions
to match file names. It does not support all `ls' switches -- those
that work are: A a B C c F G g h i n R r S s t U u v X. The l switch
-is assumed to be always present and cannot be turned off."
+is assumed to be always present and cannot be turned off.
+Long variants of the above switches, as documented for GNU `ls',
+are also supported; unsupported long options are silently ignored."
(if ls-lisp-use-insert-directory-program
(funcall orig-fun
file switches wildcard full-directory-p)
@@ -284,13 +286,21 @@ is assumed to be always present and cannot be turned off."
(let ((handler (find-file-name-handler (expand-file-name file)
'insert-directory))
(orig-file file)
- wildcard-regexp)
+ wildcard-regexp
+ (ls-lisp-dirs-first
+ (or ls-lisp-dirs-first
+ (string-match "--group-directories-first" switches))))
(if handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p)
- ;; Remove --dired switch
- (if (string-match "--dired " switches)
- (setq switches (replace-match "" nil nil switches)))
+ (when (string-match "--group-directories-first" switches)
+ ;; if ls-lisp-dirs-first is nil, dirs are grouped but come out in
+ ;; reverse order:
+ (setq ls-lisp-dirs-first t)
+ (setq switches (replace-match "" nil nil switches)))
+ ;; Remove unrecognized long options, and convert the
+ ;; recognized ones to their short variants.
+ (setq switches (ls-lisp--sanitize-switches switches))
;; Convert SWITCHES to a list of characters.
(setq switches (delete ?\ (delete ?- (append switches nil))))
;; Sometimes we get ".../foo*/" as FILE. While the shell and
@@ -890,6 +900,60 @@ All ls time options, namely c, t and u, are handled."
;; Continue standard unloading.
nil)
+(defun ls-lisp--sanitize-switches (switches)
+ "Convert long options of GNU 'ls' to their short form.
+Conversion is done only for flags supported by ls-lisp.
+Long options not supported by ls-lisp are removed.
+Supported options are: A a B C c F G g h i n R r S s t U u v X.
+The l switch is assumed to be always present and cannot be turned off."
+ (let ((lsflags '(("-a" . "--all")
+ ("-A" . "--almost-all")
+ ("-B" . "--ignore-backups")
+ ("-C" . "--color")
+ ("-F" . "--classify")
+ ("-G" . "--no-group")
+ ("-h" . "--human-readable")
+ ("-H" . "--dereference-command-line")
+ ("-i" . "--inode")
+ ("-n" . "--numeric-uid-gid")
+ ("-r" . "--reverse")
+ ("-R" . "--recursive")
+ ("-s" . "--size")
+ ("-S" . "--sort.*[ \\\t]")
+ ("" . "--group-directories-first")
+ ("" . "--author")
+ ("" . "--escape")
+ ("" . "--directory")
+ ("" . "--dired")
+ ("" . "--file-type")
+ ("" . "--format")
+ ("" . "--full-time")
+ ("" . "--si")
+ ("" . "--dereference-command-line-symlink-to-dir")
+ ("" . "--hide")
+ ("" . "--hyperlink")
+ ("" . "--ignore")
+ ("" . "--kibibytes")
+ ("" . "--dereference")
+ ("" . "--literal")
+ ("" . "--hide-control-chars")
+ ("" . "--show-control-chars")
+ ("" . "--quote-name")
+ ("" . "--context")
+ ("" . "--help")
+ ;; ("" . "--indicator-style.*[ \\\t]")
+ ;; ("" . "--quoting-style.*[ \t\\]")
+ ;; ("" . "--time.*[ \\\t]")
+ ;; ("" . "--time-style.*[ \\\t]")
+ ;; ("" . "--tabsize.*[ \\\t]")
+ ;; ("" . "--width.*[ \\\t]")
+ ("" . "--.*=.*[ \\\t\n]?") ;; catch all with '=' sign in
+ ("" . "--version"))))
+ (dolist (f lsflags)
+ (if (string-match (cdr f) switches)
+ (setq switches (replace-match (car f) nil nil switches))))
+ (string-trim switches)))
+
(provide 'ls-lisp)
;;; ls-lisp.el ends here
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 44cff21..ac933b9 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -758,7 +758,8 @@ the message being processed."
len mch lo newline)
;; If there are multiple lines in FROM,
;; discard up to the last newline in it.
- (while (setq newline (string-match "\n" from))
+ (while (and (stringp from)
+ (setq newline (string-match "\n" from)))
(setq from (substring from (1+ newline))))
(if (or (null from)
(string-match
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index c1e2280..8e3927c 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -135,8 +135,9 @@ Used for the value of `sendmail-coding-system' when
(defcustom smtpmail-queue-mail nil
"Non-nil means mail is queued; otherwise it is sent immediately.
-If queued, it is stored in the directory `smtpmail-queue-dir'
-and sent with `smtpmail-send-queued-mail'."
+If queued, it is stored in the directory `smtpmail-queue-dir' and
+sent with `smtpmail-send-queued-mail'. Also see
+`smtpmail-store-queue-variables'."
:type 'boolean)
(defcustom smtpmail-queue-dir "~/Mail/queued-mail/"
@@ -173,10 +174,21 @@ mean \"try again\"."
:type 'integer
:version "27.1")
+(defcustom smtpmail-store-queue-variables nil
+ "If non-nil, store SMTP variables when queueing mail.
+These will then be used when sending the queue."
+ :type 'boolean
+ :version "28.1")
+
;;; Variables
(defvar smtpmail-address-buffer)
-(defvar smtpmail-recipient-address-list)
+(defvar smtpmail-recipient-address-list nil)
+(defvar smtpmail--stored-queue-variables
+ '(smtpmail-smtp-server
+ smtpmail-stream-type
+ smtpmail-smtp-service
+ smtpmail-smtp-user))
(defvar smtpmail-queue-counter 0)
@@ -387,11 +399,17 @@ for `smtpmail-try-auth-method'.")
nil t)
(insert-buffer-substring tembuf)
(write-file file-data)
- (write-region
- (concat "(setq smtpmail-recipient-address-list '"
- (prin1-to-string smtpmail-recipient-address-list)
- ")\n")
- nil file-elisp nil 'silent)
+ (let ((coding-system-for-write 'utf-8))
+ (with-temp-buffer
+ (insert "(setq ")
+ (dolist (var (cons 'smtpmail-recipient-address-list
+ ;; Perhaps store the server etc.
+ (and smtpmail-store-queue-variables
+ smtpmail--stored-queue-variables)))
+ (insert (format " %s %S\n" var (symbol-value var))))
+ (insert ")\n")
+ (write-region (point-min) (point-max) file-elisp
+ nil 'silent)))
(write-region (concat file-data "\n") nil
(expand-file-name smtpmail-queue-index-file
smtpmail-queue-dir)
@@ -411,26 +429,30 @@ for `smtpmail-try-auth-method'.")
(let (file-data file-elisp
(qfile (expand-file-name smtpmail-queue-index-file
smtpmail-queue-dir))
+ (stored (cons 'smtpmail-recipient-address-list
+ smtpmail--stored-queue-variables))
+ smtpmail-recipient-address-list
+ (smtpmail-smtp-server smtpmail-smtp-server)
+ (smtpmail-stream-type smtpmail-stream-type)
+ (smtpmail-smtp-service smtpmail-smtp-service)
+ (smtpmail-smtp-user smtpmail-smtp-user)
result)
(insert-file-contents qfile)
(goto-char (point-min))
(while (not (eobp))
(setq file-data (buffer-substring (point) (line-end-position)))
(setq file-elisp (concat file-data ".el"))
- ;; FIXME: Avoid `load' which can execute arbitrary code and is hence
- ;; a source of security holes. Better read the file and extract the
- ;; data "by hand".
- ;;(load file-elisp)
- (with-temp-buffer
- (insert-file-contents file-elisp)
- (goto-char (point-min))
- (pcase (read (current-buffer))
- (`(setq smtpmail-recipient-address-list ',v)
- (skip-chars-forward " \n\t")
- (unless (eobp) (message "Ignoring trailing text in %S"
- file-elisp))
- (setq smtpmail-recipient-address-list v))
- (sexp (error "Unexpected code in %S: %S" file-elisp sexp))))
+ (let ((coding-system-for-read 'utf-8))
+ (with-temp-buffer
+ (insert-file-contents file-elisp)
+ (let ((form (read (current-buffer))))
+ (when (or (not (consp form))
+ (not (eq (car form) 'setq))
+ (not (consp (cdr form))))
+ (error "Unexpected code in %S: %S" file-elisp form))
+ (cl-loop for (var val) on (cdr form) by #'cddr
+ when (memq var stored)
+ do (set var val)))))
;; Insert the message literally: it is already encoded as per
;; the MIME headers, and code conversions might guess the
;; encoding wrongly.
@@ -445,13 +467,13 @@ for `smtpmail-try-auth-method'.")
(message-narrow-to-headers)
(mail-envelope-from)))
user-mail-address)))
- (if (not (null smtpmail-recipient-address-list))
- (when (setq result (smtpmail-via-smtp
- smtpmail-recipient-address-list
- (current-buffer)))
- (error "Sending failed: %s"
- (smtpmail--sanitize-error-message result)))
- (error "Sending failed; no recipients"))))
+ (if (not smtpmail-recipient-address-list)
+ (error "Sending failed; no recipients")
+ (when (setq result (smtpmail-via-smtp
+ smtpmail-recipient-address-list
+ (current-buffer)))
+ (error "Sending failed: %s"
+ (smtpmail--sanitize-error-message result))))))
(delete-file file-data)
(delete-file file-elisp)
(delete-region (point-at-bol) (point-at-bol 2)))
@@ -574,7 +596,7 @@ USER and PASSWORD should be non-nil."
(error "Mechanism %S not implemented" mech))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql cram-md5)) user password)
+ (process (_mech (eql 'cram-md5)) user password)
(let ((ret (smtpmail-command-or-throw process "AUTH CRAM-MD5")))
(when (eq (car ret) 334)
(let* ((challenge (substring (cadr ret) 4))
@@ -596,13 +618,13 @@ USER and PASSWORD should be non-nil."
(smtpmail-command-or-throw process encoded)))))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql login)) user password)
+ (process (_mech (eql 'login)) user password)
(smtpmail-command-or-throw process "AUTH LOGIN")
(smtpmail-command-or-throw process (base64-encode-string user t))
(smtpmail-command-or-throw process (base64-encode-string password t)))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql plain)) user password)
+ (process (_mech (eql 'plain)) user password)
;; We used to send an empty initial request, and wait for an
;; empty response, and then send the password, but this
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
@@ -614,6 +636,14 @@ USER and PASSWORD should be non-nil."
(base64-encode-string (concat "\0" user "\0" password) t))
235))
+(cl-defmethod smtpmail-try-auth-method
+ (process (_mech (eql xoauth2)) user password)
+ (smtpmail-command-or-throw
+ process
+ (concat "AUTH XOAUTH2 "
+ (base64-encode-string
+ (concat "user=" user "\1auth=Bearer " password "\1\1") t))))
+
(defun smtpmail-response-code (string)
(when string
(with-temp-buffer
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 739e751..8def157 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -570,7 +570,9 @@
(defun clipboard-yank ()
"Insert the clipboard contents, or the last stretch of killed text."
(interactive "*")
- (let ((select-enable-clipboard t))
+ (let ((select-enable-clipboard t)
+ ;; Ensure that we defeat the DWIM login in `gui-selection-value'.
+ (gui--last-selected-text-clipboard nil))
(yank)))
(defun clipboard-kill-ring-save (beg end &optional region)
diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1
index f1aeca6..b0fdd02 100644
--- a/lisp/mh-e/ChangeLog.1
+++ b/lisp/mh-e/ChangeLog.1
@@ -11196,7 +11196,7 @@
instead of "0 msgs". Do not try to print a range when there are
no messages.
* mh-e.el (mh-regenerate-headers): Bug fix. Catch and remove the
- "scan: band message list" message.
+ "scan: bad message list" message.
2001-11-13 Jeffrey C Honig <jch@honig.net>
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index e935cfd..949787a 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -229,7 +229,7 @@ User's mail folder directory.")
(defvar mh-arrow-marker nil
"Marker for arrow display in fringe.")
-(defvar mh-blacklist nil
+(defvar mh-blocklist nil
"List of messages to use to train the junk filter.
This variable can be used by
`mh-before-commands-processed-hook'.")
@@ -295,7 +295,7 @@ Elements have the form (SEQUENCE . MESSAGES).")
"Stack of operations that change the folder view.
These operations include narrowing or threading.")
-(defvar mh-whitelist nil
+(defvar mh-allowlist nil
"List of messages to use to train the junk filter.
This variable can be used by
`mh-before-commands-processed-hook'.")
@@ -1687,13 +1687,13 @@ fashion."
;; Available spam filter interfaces
(defvar mh-junk-function-alist
- '((spamassassin mh-spamassassin-blacklist mh-spamassassin-whitelist)
- (bogofilter mh-bogofilter-blacklist mh-bogofilter-whitelist)
- (spamprobe mh-spamprobe-blacklist mh-spamprobe-whitelist))
+ '((spamassassin mh-spamassassin-blocklist mh-spamassassin-allowlist)
+ (bogofilter mh-bogofilter-blocklist mh-bogofilter-allowlist)
+ (spamprobe mh-spamprobe-blocklist mh-spamprobe-allowlist))
"Available choices of spam programs to use.
This is an alist. For each element there are functions that
-blacklist a message as spam and whitelist a message incorrectly
+blocklist a message as spam and allowlist a message incorrectly
classified as spam.")
(defun mh-junk-choose (symbol value)
@@ -1718,8 +1718,8 @@ be slow when junking large numbers of messages. If you
have
enough memory or don't junk that many messages at the same time,
you might try turning on this option.
-Note that this option is used as the \"display\" argument in the
-call to `call-process'. Therefore, turning on this option means
+Note that this option is used as the \"destination\" argument in
+the call to `call-process'. Therefore, turning on this option means
setting its value to \"0\". You can also set its value to t to
direct the programs' output to the \"*MH-E Log*\" buffer; this
may be useful for debugging."
@@ -2236,11 +2236,11 @@ commands."
:group 'mh-sequences
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-whitelist-preserves-sequences-flag t
- "Non-nil means that sequences are preserved when messages are whitelisted.
+(defcustom-mh mh-allowlist-preserves-sequences-flag t
+ "Non-nil means that sequences are preserved when messages are allowlisted.
If a message is in any sequence (except \"Previous-Sequence:\"
-and \"cur\") when it is whitelisted, then it will still be in
+and \"cur\") when it is allowlisted, then it will still be in
those sequences in the destination folder. If this behavior is
not desired, then turn off this option."
:type 'boolean
@@ -3195,7 +3195,7 @@ annotated messages with `mh-annotate-list'."
"Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] before performing
outstanding refile and delete requests.
Variables that are useful in this hook include `mh-delete-list',
-`mh-refile-list', `mh-blacklist', and `mh-whitelist' which can be
+`mh-refile-list', `mh-blocklist', and `mh-allowlist' which can be
used to see which changes will be made to the current folder,
`mh-current-folder'."
:type 'hook
@@ -3227,8 +3227,8 @@ before sending, add the `ispell-message' function."
:group 'mh-letter
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-blacklist-msg-hook nil
- "Hook run by \\<mh-letter-mode-map>\\[mh-junk-blacklist] after marking each
message for blacklisting."
+(defcustom-mh mh-blocklist-msg-hook nil
+ "Hook run by \\<mh-letter-mode-map>\\[mh-junk-blocklist] after marking each
message for blocklisting."
:type 'hook
:group 'mh-hooks
:group 'mh-show
@@ -3400,8 +3400,8 @@ sequence."
:group 'mh-sequences
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-whitelist-msg-hook nil
- "Hook run by \\<mh-letter-mode-map>\\[mh-junk-whitelist] after marking each
message for whitelisting."
+(defcustom-mh mh-allowlist-msg-hook nil
+ "Hook run by \\<mh-letter-mode-map>\\[mh-junk-allowlist] after marking each
message for allowlisting."
:type 'hook
:group 'mh-hooks
:group 'mh-show
@@ -3627,9 +3627,9 @@ specified colors."
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-blacklisted
+(defface-mh mh-folder-blocklisted
(mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number))))
- "Blacklisted message face."
+ "Blocklisted message face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.4"))
@@ -3723,9 +3723,9 @@ format `mh-scan-format-nmh' and the regular expression
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-whitelisted
+(defface-mh mh-folder-allowlisted
(mh-face-data 'mh-folder-refiled '((t (:inherit mh-folder-refiled))))
- "Whitelisted message face."
+ "Allowlisted message face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.4"))
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index ce77f9c..35277ae 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -278,7 +278,8 @@ annotation.")
(gnus-define-keys (mh-junk-map "J" mh-folder-mode-map)
"?" mh-prefix-help
- "b" mh-junk-blacklist
+ "a" mh-junk-allowlist
+ "b" mh-junk-blocklist
"w" mh-junk-whitelist)
(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map)
@@ -386,7 +387,7 @@ annotation.")
(?K "[v]iew, [i]nline, with [e]xternal viewer; \n"
"[o]utput/save MIME part; save [a]ll parts; \n"
"[t]oggle buttons; [TAB] next; [SHIFT-TAB] previous")
- (?J "[b]lacklist, [w]hitelist message"))
+ (?J "[b]locklist, [a]llowlist message"))
"Key binding cheat sheet.
See `mh-set-help'.")
@@ -405,12 +406,12 @@ See `mh-set-help'.")
;; Marked for deletion
(list (concat mh-scan-deleted-msg-regexp ".*")
'(0 'mh-folder-deleted))
- ;; Marked for blacklisting
- (list (concat mh-scan-blacklisted-msg-regexp ".*")
- '(0 'mh-folder-blacklisted))
- ;; Marked for whitelisting
- (list (concat mh-scan-whitelisted-msg-regexp ".*")
- '(0 'mh-folder-whitelisted))
+ ;; Marked for blocklisting
+ (list (concat mh-scan-blocklisted-msg-regexp ".*")
+ '(0 'mh-folder-blocklisted))
+ ;; Marked for allowlisting
+ (list (concat mh-scan-allowlisted-msg-regexp ".*")
+ '(0 'mh-folder-allowlisted))
;; After subject
(list mh-scan-body-regexp
'(1 'mh-folder-body nil t))
@@ -616,8 +617,8 @@ perform the operation on all messages in that region.
'mh-showing-mode nil ; Show message also?
'mh-refile-list nil ; List of folder names in mh-seq-list
'mh-delete-list nil ; List of msgs nums to delete
- 'mh-blacklist nil ; List of messages to process as spam
- 'mh-whitelist nil ; List of messages to process as ham
+ 'mh-blocklist nil ; List of messages to process as spam
+ 'mh-allowlist nil ; List of messages to process as ham
'mh-seq-list nil ; Alist of (seq . msgs) nums
'mh-seen-list nil ; List of displayed messages
'mh-next-direction 'forward ; Direction to move to next message
@@ -714,8 +715,8 @@ RANGE is read in interactive use."
(defun mh-execute-commands ()
"Perform outstanding operations\\<mh-folder-mode-map>.
-If you've marked messages to be refiled, deleted, blacklisted, or
-whitelisted and you want to go ahead and perform these operations
+If you've marked messages to be refiled, deleted, blocklisted, or
+allowlisted and you want to go ahead and perform these operations
on these messages, use this command. Many MH-E commands that may
affect the numbering of the messages (such as
\\[mh-rescan-folder] or \\[mh-pack-folder]) will ask if you want
@@ -1188,16 +1189,16 @@ RANGE is read in interactive use."
(beginning-of-line)
(while (not (or (looking-at mh-scan-refiled-msg-regexp)
(looking-at mh-scan-deleted-msg-regexp)
- (looking-at mh-scan-blacklisted-msg-regexp)
- (looking-at mh-scan-whitelisted-msg-regexp)
+ (looking-at mh-scan-blocklisted-msg-regexp)
+ (looking-at mh-scan-allowlisted-msg-regexp)
(and (eq mh-next-direction 'forward) (bobp))
(and (eq mh-next-direction 'backward)
(save-excursion (forward-line) (eobp)))))
(forward-line (if (eq mh-next-direction 'forward) -1 1)))
(if (or (looking-at mh-scan-refiled-msg-regexp)
(looking-at mh-scan-deleted-msg-regexp)
- (looking-at mh-scan-blacklisted-msg-regexp)
- (looking-at mh-scan-whitelisted-msg-regexp))
+ (looking-at mh-scan-blocklisted-msg-regexp)
+ (looking-at mh-scan-allowlisted-msg-regexp))
(progn
(mh-undo-msg (mh-get-msg-num t))
(mh-maybe-show))
@@ -1529,7 +1530,7 @@ is updated."
(save-excursion
(when (eq major-mode 'mh-show-mode)
(set-buffer mh-show-folder-buffer))
- (or mh-delete-list mh-refile-list mh-blacklist mh-whitelist)))
+ (or mh-delete-list mh-refile-list mh-blocklist mh-allowlist)))
;;;###mh-autoload
(defun mh-set-folder-modified-p (flag)
@@ -1555,12 +1556,12 @@ after the commands are processed."
(folders-changed (list mh-current-folder))
(seq-map (and
(or (and mh-refile-list mh-refile-preserves-sequences-flag)
- (and mh-whitelist
- mh-whitelist-preserves-sequences-flag))
+ (and mh-allowlist
+ mh-allowlist-preserves-sequences-flag))
(mh-create-sequence-map mh-seq-list)))
(dest-map (and mh-refile-list mh-refile-preserves-sequences-flag
(make-hash-table)))
- (white-map (and mh-whitelist mh-whitelist-preserves-sequences-flag
+ (allow-map (and mh-allowlist mh-allowlist-preserves-sequences-flag
(make-hash-table))))
;; Remove invalid scan lines if we are in an index folder and then remove
;; the real messages
@@ -1609,11 +1610,11 @@ after the commands are processed."
(mh-delete-scan-msgs mh-delete-list)
(setq mh-delete-list nil)))
- ;; Blacklist messages.
- (when mh-blacklist
- (let ((msg-list (mh-coalesce-msg-list mh-blacklist))
- (dest (mh-junk-blacklist-disposition)))
- (mh-junk-process-blacklist mh-blacklist)
+ ;; Blocklist messages.
+ (when mh-blocklist
+ (let ((msg-list (mh-coalesce-msg-list mh-blocklist))
+ (dest (mh-junk-blocklist-disposition)))
+ (mh-junk-process-blocklist mh-blocklist)
;; TODO I wonder why mh-exec-cmd is used instead of the following:
;; (mh-refile-a-msg nil (intern dest))
;; (mh-delete-a-msg nil)))
@@ -1622,35 +1623,35 @@ after the commands are processed."
(apply #'mh-exec-cmd "refile" "-src" folder dest msg-list)
(push dest folders-changed))
(setq redraw-needed-flag t)
- (mh-delete-scan-msgs mh-blacklist)
- (setq mh-blacklist nil)))
+ (mh-delete-scan-msgs mh-blocklist)
+ (setq mh-blocklist nil)))
- ;; Whitelist messages.
- (when mh-whitelist
- (let ((msg-list (mh-coalesce-msg-list mh-whitelist))
+ ;; Allowlist messages.
+ (when mh-allowlist
+ (let ((msg-list (mh-coalesce-msg-list mh-allowlist))
(last (car (mh-translate-range mh-inbox "last"))))
- (mh-junk-process-whitelist mh-whitelist)
+ (mh-junk-process-allowlist mh-allowlist)
(apply #'mh-exec-cmd "refile" "-src" folder mh-inbox msg-list)
(push mh-inbox folders-changed)
(setq redraw-needed-flag t)
- (mh-delete-scan-msgs mh-whitelist)
- (when mh-whitelist-preserves-sequences-flag
- (clrhash white-map)
+ (mh-delete-scan-msgs mh-allowlist)
+ (when mh-allowlist-preserves-sequences-flag
+ (clrhash allow-map)
(cl-loop for i from (1+ (or last 0))
- for msg in (sort (copy-sequence mh-whitelist) #'<)
+ for msg in (sort (copy-sequence mh-allowlist) #'<)
do (cl-loop for seq-name in (gethash msg seq-map)
- do (push i (gethash seq-name white-map))))
+ do (push i (gethash seq-name allow-map))))
(maphash
#'(lambda (seq msgs)
;; Can't be run in background, since the current
;; folder is changed by mark this could lead to a
- ;; race condition with the next refile/whitelist.
+ ;; race condition with the next refile/allowlist.
(apply #'mh-exec-cmd "mark"
"-sequence" (symbol-name seq) mh-inbox
"-add" (mapcar #'(lambda(x) (format "%s" x))
(mh-coalesce-msg-list msgs))))
- white-map))
- (setq mh-whitelist nil)))
+ allow-map))
+ (setq mh-allowlist nil)))
;; Don't need to remove sequences since delete and refile do so.
;; Mark cur message
@@ -1961,10 +1962,10 @@ once when he kept statistics on his mail usage."
(setq message (mh-get-msg-num t)))
(if (looking-at mh-scan-refiled-msg-regexp)
(error "Message %d is refiled; undo refile before deleting" message))
- (if (looking-at mh-scan-blacklisted-msg-regexp)
- (error "Message %d is blacklisted; undo before deleting" message))
- (if (looking-at mh-scan-whitelisted-msg-regexp)
- (error "Message %d is whitelisted; undo before deleting" message))
+ (if (looking-at mh-scan-blocklisted-msg-regexp)
+ (error "Message %d is blocklisted; undo before deleting" message))
+ (if (looking-at mh-scan-allowlisted-msg-regexp)
+ (error "Message %d is allowlisted; undo before deleting" message))
(if (looking-at mh-scan-deleted-msg-regexp)
nil
(mh-set-folder-modified-p t)
@@ -1986,10 +1987,10 @@ be refiled."
(setq message (mh-get-msg-num t)))
(cond ((looking-at mh-scan-deleted-msg-regexp)
(error "Message %d is deleted; undo delete before moving" message))
- ((looking-at mh-scan-blacklisted-msg-regexp)
- (error "Message %d is blacklisted; undo before moving" message))
- ((looking-at mh-scan-whitelisted-msg-regexp)
- (error "Message %d is whitelisted; undo before moving" message))
+ ((looking-at mh-scan-blocklisted-msg-regexp)
+ (error "Message %d is blocklisted; undo before moving" message))
+ ((looking-at mh-scan-allowlisted-msg-regexp)
+ (error "Message %d is allowlisted; undo before moving" message))
((looking-at mh-scan-refiled-msg-regexp)
(if (y-or-n-p
(format "Message %d already refiled; copy to %s as well? "
@@ -2008,7 +2009,7 @@ be refiled."
(run-hooks 'mh-refile-msg-hook)))))
(defun mh-undo-msg (msg)
- "Undo the deletion, refile, black- or whitelisting of one MSG.
+ "Undo the deletion, refile, block- or allowlisting of one MSG.
If MSG is nil then act on the message at point"
(save-excursion
(if (numberp msg)
@@ -2017,10 +2018,10 @@ If MSG is nil then act on the message at point"
(setq msg (mh-get-msg-num t)))
(cond ((memq msg mh-delete-list)
(setq mh-delete-list (delq msg mh-delete-list)))
- ((memq msg mh-blacklist)
- (setq mh-blacklist (delq msg mh-blacklist)))
- ((memq msg mh-whitelist)
- (setq mh-whitelist (delq msg mh-whitelist)))
+ ((memq msg mh-blocklist)
+ (setq mh-blocklist (delq msg mh-blocklist)))
+ ((memq msg mh-allowlist)
+ (setq mh-allowlist (delq msg mh-allowlist)))
(t
(dolist (folder-msg-list mh-refile-list)
(setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 0e5ffc9..4a5e670 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -354,8 +354,8 @@ Arguments are IGNORED (for `revert-buffer')."
(yes-or-no-p "Undo all commands in folder? "))
(setq mh-delete-list nil
mh-refile-list nil
- mh-blacklist nil
- mh-whitelist nil
+ mh-blocklist nil
+ mh-allowlist nil
mh-seq-list nil
mh-next-direction 'forward)
(with-mh-folder-updating (nil)
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index 95a9bb4..6c36748 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -32,8 +32,8 @@
(require 'mh-scan)
;;;###mh-autoload
-(defun mh-junk-blacklist (range)
- "Blacklist RANGE as spam.
+(defun mh-junk-blocklist (range)
+ "Blocklist RANGE as spam.
This command trains the spam program in use (see the option
`mh-junk-program') with the content of RANGE and then handles the
@@ -45,44 +45,44 @@ read in interactive use.
For more information about using your particular spam fighting
program, see:
- - `mh-spamassassin-blacklist'
- - `mh-bogofilter-blacklist'
- - `mh-spamprobe-blacklist'"
- (interactive (list (mh-interactive-range "Blacklist")))
- (mh-iterate-on-range () range (mh-blacklist-a-msg nil))
- (if (looking-at mh-scan-blacklisted-msg-regexp)
+ - `mh-spamassassin-blocklist'
+ - `mh-bogofilter-blocklist'
+ - `mh-spamprobe-blocklist'"
+ (interactive (list (mh-interactive-range "Blocklist")))
+ (mh-iterate-on-range () range (mh-junk-blocklist-a-msg nil))
+ (if (looking-at mh-scan-blocklisted-msg-regexp)
(mh-next-msg)))
-(defun mh-blacklist-a-msg (message)
- "Blacklist MESSAGE.
-If MESSAGE is nil then the message at point is blacklisted.
-The hook `mh-blacklist-msg-hook' is called after you mark a message
-for blacklisting."
+(defun mh-junk-blocklist-a-msg (message)
+ "Blocklist MESSAGE.
+If MESSAGE is nil then the message at point is blocklisted.
+The hook `mh-blocklist-msg-hook' is called after you mark a message
+for blocklisting."
(save-excursion
(if (numberp message)
(mh-goto-msg message nil t)
(beginning-of-line)
(setq message (mh-get-msg-num t)))
(cond ((looking-at mh-scan-refiled-msg-regexp)
- (error "Message %d is refiled; undo refile before blacklisting"
+ (error "Message %d is refiled; undo refile before blocklisting"
message))
((looking-at mh-scan-deleted-msg-regexp)
- (error "Message %d is deleted; undo delete before blacklisting"
+ (error "Message %d is deleted; undo delete before blocklisting"
message))
- ((looking-at mh-scan-whitelisted-msg-regexp)
- (error "Message %d is whitelisted; undo before blacklisting"
+ ((looking-at mh-scan-allowlisted-msg-regexp)
+ (error "Message %d is allowlisted; undo before blocklisting"
message))
- ((looking-at mh-scan-blacklisted-msg-regexp) nil)
+ ((looking-at mh-scan-blocklisted-msg-regexp) nil)
(t
(mh-set-folder-modified-p t)
- (setq mh-blacklist (cons message mh-blacklist))
+ (setq mh-blocklist (cons message mh-blocklist))
(if (not (memq message mh-seen-list))
(setq mh-seen-list (cons message mh-seen-list)))
- (mh-notate nil mh-note-blacklisted mh-cmd-note)
- (run-hooks 'mh-blacklist-msg-hook)))))
+ (mh-notate nil mh-note-blocklisted mh-cmd-note)
+ (run-hooks 'mh-blocklist-msg-hook)))))
;;;###mh-autoload
-(defun mh-junk-blacklist-disposition ()
+(defun mh-junk-blocklist-disposition ()
"Determines the fate of the selected spam."
(cond ((null mh-junk-disposition) nil)
((equal mh-junk-disposition "") "+")
@@ -94,73 +94,76 @@ for blacklisting."
(t (concat "+" mh-junk-disposition))))
;;;###mh-autoload
-(defun mh-junk-process-blacklist (range)
- "Blacklist RANGE as spam.
+(defun mh-junk-process-blocklist (range)
+ "Blocklist RANGE as spam.
This command trains the spam program in use (see the option
`mh-junk-program') with the content of RANGE and then handles the
message(s) as specified by the option `mh-junk-disposition'."
- (let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist))))
- (unless blacklist-func
+ (let ((blocklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist))))
+ (unless blocklist-func
(error "Customize `mh-junk-program' appropriately"))
(mh-iterate-on-range msg range
- (message "Blacklisting message %d..." msg)
- (funcall (symbol-function blacklist-func) msg)
- (message "Blacklisting message %d...done" msg))))
+ (funcall (symbol-function blocklist-func) msg))))
;;;###mh-autoload
(defun mh-junk-whitelist (range)
- "Whitelist RANGE as ham.
+ "Old name for `mh-junk-allowlist'; use \\[mh-junk-allowlist] instead."
+ (declare (obsolete mh-junk-allowlist "28.1"))
+ (interactive (list (mh-interactive-range "Allowlist")))
+ (mh-junk-allowlist range))
-This command reclassifies the RANGE as ham if it were incorrectly
+;;;###mh-autoload
+(defun mh-junk-allowlist (range)
+ "Allowlist RANGE as ham.
+
+This command reclassifies the RANGE as ham if it has been incorrectly
classified as spam (see the option `mh-junk-program'). It then
refiles the message into the \"+inbox\" folder.
Check the documentation of `mh-interactive-range' to see how
RANGE is read in interactive use."
- (interactive (list (mh-interactive-range "Whitelist")))
- (mh-iterate-on-range () range (mh-junk-whitelist-a-msg nil))
- (if (looking-at mh-scan-whitelisted-msg-regexp)
+ (interactive (list (mh-interactive-range "Allowlist")))
+ (mh-iterate-on-range () range (mh-junk-allowlist-a-msg nil))
+ (if (looking-at mh-scan-allowlisted-msg-regexp)
(mh-next-msg)))
-(defun mh-junk-whitelist-a-msg (message)
- "Whitelist MESSAGE.
-If MESSAGE is nil then the message at point is whitelisted. The
-hook `mh-whitelist-msg-hook' is called after you mark a message
-for whitelisting."
+(defun mh-junk-allowlist-a-msg (message)
+ "Allowlist MESSAGE.
+If MESSAGE is nil then the message at point is allowlisted. The
+hook `mh-allowlist-msg-hook' is called after you mark a message
+for allowlisting."
(save-excursion
(if (numberp message)
(mh-goto-msg message nil t)
(beginning-of-line)
(setq message (mh-get-msg-num t)))
(cond ((looking-at mh-scan-refiled-msg-regexp)
- (error "Message %d is refiled; undo refile before whitelisting"
+ (error "Message %d is refiled; undo refile before allowlisting"
message))
((looking-at mh-scan-deleted-msg-regexp)
- (error "Message %d is deleted; undo delete before whitelisting"
+ (error "Message %d is deleted; undo delete before allowlisting"
message))
- ((looking-at mh-scan-blacklisted-msg-regexp)
- (error "Message %d is blacklisted; undo before whitelisting"
+ ((looking-at mh-scan-blocklisted-msg-regexp)
+ (error "Message %d is blocklisted; undo before allowlisting"
message))
- ((looking-at mh-scan-whitelisted-msg-regexp) nil)
+ ((looking-at mh-scan-allowlisted-msg-regexp) nil)
(t
(mh-set-folder-modified-p t)
- (setq mh-whitelist (cons message mh-whitelist))
- (mh-notate nil mh-note-whitelisted mh-cmd-note)
- (run-hooks 'mh-whitelist-msg-hook)))))
+ (setq mh-allowlist (cons message mh-allowlist))
+ (mh-notate nil mh-note-allowlisted mh-cmd-note)
+ (run-hooks 'mh-allowlist-msg-hook)))))
;;;###mh-autoload
-(defun mh-junk-process-whitelist (range)
- "Whitelist RANGE as ham.
+(defun mh-junk-process-allowlist (range)
+ "Allowlist RANGE as ham.
This command reclassifies the RANGE as ham if it were incorrectly
classified as spam (see the option `mh-junk-program')."
- (let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist))))
- (unless whitelist-func
+ (let ((allowlist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist))))
+ (unless allowlist-func
(error "Customize `mh-junk-program' appropriately"))
(mh-iterate-on-range msg range
- (message "Whitelisting message %d..." msg)
- (funcall (symbol-function whitelist-func) msg)
- (message "Whitelisting message %d...done" msg))))
+ (funcall (symbol-function allowlist-func) msg))))
@@ -170,8 +173,8 @@ classified as spam (see the option `mh-junk-program')."
(defvar mh-sa-learn-executable (executable-find "sa-learn"))
;;;###mh-autoload
-(defun mh-spamassassin-blacklist (msg)
- "Blacklist MSG with SpamAssassin.
+(defun mh-spamassassin-blocklist (msg)
+ "Blocklist MSG with SpamAssassin.
SpamAssassin is one of the more popular spam filtering programs.
Get it from your local distribution or from the SpamAssassin web
@@ -219,22 +222,22 @@ rules-based filters is a plethora of false positives so
it is
worthwhile to check.
If SpamAssassin classifies a message incorrectly, or is unsure,
-you can use the MH-E commands \\[mh-junk-blacklist] and
-\\[mh-junk-whitelist].
+you can use the MH-E commands \\[mh-junk-blocklist] and
+\\[mh-junk-allowlist].
-The command \\[mh-junk-blacklist] adds a \"blacklist_from\" entry
+The command \\[mh-junk-blocklist] adds a \"blacklist_from\" entry
to \"~/spamassassin/user_prefs\", deletes the message, and sends
the message to the Razor, so that others might not see this spam.
If the \"sa-learn\" command is available, the message is also
recategorized as spam.
-The command \\[mh-junk-whitelist] adds a \"whitelist_from\" rule
+The command \\[mh-junk-allowlist] adds a \"whitelist_from\" rule
to the \"~/.spamassassin/user_prefs\" file. If the \"sa-learn\"
command is available, the message is also recategorized as ham.
Over time, you'll observe that the same host or domain occurs
repeatedly in the \"blacklist_from\" entries, so you might think
-that you could avoid future spam by blacklisting all mail from a
+that you could avoid future spam by blocklisting all mail from a
particular domain. The utility function
`mh-spamassassin-identify-spammers' helps you do precisely that.
This function displays a frequency count of the hosts and domains
@@ -249,20 +252,20 @@ information can be used so that you can replace multiple
(let ((current-folder mh-current-folder)
(msg-file (mh-msg-filename msg mh-current-folder))
(sender))
- (message "Reporting message %d..." msg)
+ (message "Reporting message %d as spam with spamassassin..." msg)
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-spamassassin-executable msg-file mh-junk-background nil
- ;; -R removes from allow-list
+ ;; -R removes from allowlist
"--report" "-R")
(when mh-sa-learn-executable
- (message "Recategorizing message %d as spam..." msg)
+ (message "Recategorizing message %d as spam with sa-learn..." msg)
(mh-truncate-log-buffer)
(call-process mh-sa-learn-executable msg-file mh-junk-background nil
"--spam" "--local" "--no-sync")))
- (message "Blacklisting sender of message %d..." msg)
+ (message "Blocklisting sender of message %d..." msg)
(with-current-buffer (get-buffer-create mh-temp-buffer)
(erase-buffer)
(call-process (expand-file-name mh-scan-prog mh-progs)
@@ -274,18 +277,18 @@ information can be used so that you can replace multiple
(progn
(setq sender (match-string 0))
(mh-spamassassin-add-rule "blacklist_from" sender)
- (message "Blacklisting sender of message %d...done" msg))
- (message "Blacklisting sender of message %d...not done (from my
address)" msg)))))
+ (message "Blocklisting sender of message %d...done" msg))
+ (message "Blocklisting sender of message %d...not done (from my
address)" msg)))))
;;;###mh-autoload
-(defun mh-spamassassin-whitelist (msg)
- "Whitelist MSG with SpamAssassin.
+(defun mh-spamassassin-allowlist (msg)
+ "Allowlist MSG with SpamAssassin.
-The \\[mh-junk-whitelist] command adds a \"whitelist_from\" rule to
+The \\[mh-junk-allowlist] command adds a \"whitelist_from\" rule to
the \"~/.spamassassin/user_prefs\" file. If the \"sa-learn\" command
is available, the message is also recategorized as ham.
-See `mh-spamassassin-blacklist' for more information."
+See `mh-spamassassin-blocklist' for more information."
(unless mh-spamassassin-executable
(error "Unable to find the spamassassin executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder))
@@ -300,21 +303,23 @@ See `mh-spamassassin-blacklist' for more information."
(kill-buffer show-buffer))
(write-file msg-file)
(when mh-sa-learn-executable
- (message "Recategorizing message %d as ham..." msg)
+ (message "Recategorizing message %d as ham with sa-learn..." msg)
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-sa-learn-executable msg-file mh-junk-background nil
"--ham" "--local" "--no-sync")))
- (message "Whitelisting sender of message %d..." msg)
+ (message "Allowlisting sender of message %d..." msg)
(setq from
(car (mh-funcall-if-exists
ietf-drums-parse-address (mh-get-header-field "From:"))))
(kill-buffer nil)
- (unless (or (null from) (equal from ""))
- (mh-spamassassin-add-rule "whitelist_from" from))
- (message "Whitelisting sender of message %d...done" msg))))
+ (if (or (null from) (equal from ""))
+ (message "Allowlisting sender of message %d...%s"
+ msg "not done (cannot identify sender)")
+ (mh-spamassassin-add-rule "whitelist_from" from)
+ (message "Allowlisting sender of message %d...done" msg)))))
(defun mh-spamassassin-add-rule (rule body)
"Add a new rule to \"~/.spamassassin/user_prefs\".
@@ -384,8 +389,8 @@ information can be used so that you can replace multiple
(defvar mh-bogofilter-executable (executable-find "bogofilter"))
;;;###mh-autoload
-(defun mh-bogofilter-blacklist (msg)
- "Blacklist MSG with bogofilter.
+(defun mh-bogofilter-blocklist (msg)
+ "Blocklist MSG with bogofilter.
Bogofilter is a Bayesian spam filtering program. Get it from your
local distribution or from the bogofilter web site at URL
@@ -422,7 +427,7 @@ To use bogofilter, add the following recipes to
\".procmailrc\":
spam/unsure/.
If bogofilter classifies a message incorrectly, or is unsure, you can
-use the MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist]
+use the MH-E commands \\[mh-junk-blocklist] and \\[mh-junk-allowlist]
to update bogofilter's training.
The \"Bogofilter FAQ\" suggests that you run the following
@@ -435,28 +440,32 @@ occasionally to shrink the database:
The \"Bogofilter tuning HOWTO\" describes how you can fine-tune Bogofilter."
(unless mh-bogofilter-executable
(error "Unable to find the bogofilter executable"))
+ (message "Blocklisting message %d with bogofilter..." msg)
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-bogofilter-executable msg-file mh-junk-background
- nil "-s"))))
+ nil "-s")
+ (message "Blocklisting message %d with bogofilter...done" msg))))
;;;###mh-autoload
-(defun mh-bogofilter-whitelist (msg)
- "Whitelist MSG with bogofilter.
+(defun mh-bogofilter-allowlist (msg)
+ "Allowlist MSG with bogofilter.
-See `mh-bogofilter-blacklist' for more information."
+See `mh-bogofilter-blocklist' for more information."
(unless mh-bogofilter-executable
(error "Unable to find the bogofilter executable"))
+ (message "Allowlisting message %d with bogofilter..." msg)
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-bogofilter-executable msg-file mh-junk-background
- nil "-n"))))
+ nil "-n")
+ (message "Allowlisting message %d with bogofilter...done" msg))))
@@ -465,8 +474,8 @@ See `mh-bogofilter-blacklist' for more information."
(defvar mh-spamprobe-executable (executable-find "spamprobe"))
;;;###mh-autoload
-(defun mh-spamprobe-blacklist (msg)
- "Blacklist MSG with SpamProbe.
+(defun mh-spamprobe-blocklist (msg)
+ "Blocklist MSG with SpamProbe.
SpamProbe is a Bayesian spam filtering program. Get it from your
local distribution or from the SpamProbe web site at URL
@@ -489,32 +498,36 @@ To use SpamProbe, add the following recipes to
\".procmailrc\":
spam/.
If SpamProbe classifies a message incorrectly, you can use the
-MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist] to
+MH-E commands \\[mh-junk-blocklist] and \\[mh-junk-allowlist] to
update SpamProbe's training."
(unless mh-spamprobe-executable
(error "Unable to find the spamprobe executable"))
+ (message "Blocklisting message %d with spamprobe..." msg)
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-spamprobe-executable msg-file mh-junk-background
- nil "spam"))))
+ nil "spam")
+ (message "Blocklisting message %d with spamprobe...done" msg))))
;;;###mh-autoload
-(defun mh-spamprobe-whitelist (msg)
- "Whitelist MSG with SpamProbe.
+(defun mh-spamprobe-allowlist (msg)
+ "Allowlist MSG with SpamProbe.
-See `mh-spamprobe-blacklist' for more information."
+See `mh-spamprobe-blocklist' for more information."
(unless mh-spamprobe-executable
(error "Unable to find the spamprobe executable"))
+ (message "Allowlisting message %d with spamprobe..." msg)
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-spamprobe-executable msg-file mh-junk-background
- nil "good"))))
+ nil "good")
+ (message "Allowlisting message %d with spamprobe...done" msg))))
(provide 'mh-junk)
diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el
index 1504979..1023520 100644
--- a/lisp/mh-e/mh-scan.el
+++ b/lisp/mh-e/mh-scan.el
@@ -113,8 +113,8 @@ expression which matches the body text as in the default of
not correct, the body fragment will not be highlighted with the
face `mh-folder-body'.")
-(defvar mh-scan-blacklisted-msg-regexp "^\\( *[0-9]+\\)B"
- "This regular expression matches blacklisted (spam) messages.
+(defvar mh-scan-blocklisted-msg-regexp "^\\( *[0-9]+\\)B"
+ "This regular expression matches blocklisted (spam) messages.
It must match from the beginning of the line. Note that the
default setting of `mh-folder-font-lock-keywords' expects this
@@ -125,9 +125,9 @@ matches the message number as in the default of
This expression includes the leading space within parenthesis
since it looks better to highlight it as well. The highlighting
-is done with the face `mh-folder-blacklisted'. This regular
+is done with the face `mh-folder-blocklisted'. This regular
expression should be correct as it is needed by non-fontification
-functions. See also `mh-note-blacklisted'.")
+functions. See also `mh-note-blocklisted'.")
(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
"This regular expression matches the current message.
@@ -295,21 +295,21 @@ non-fontification functions.")
This is used to eliminate error messages that are occasionally
produced by \"inc\".")
-(defvar mh-scan-whitelisted-msg-regexp "^\\( *[0-9]+\\)W"
- "This regular expression matches whitelisted (non-spam) messages.
+(defvar mh-scan-allowlisted-msg-regexp "^\\( *[0-9]+\\)A"
+ "This regular expression matches allowlisted (non-spam) messages.
It must match from the beginning of the line. Note that the
default setting of `mh-folder-font-lock-keywords' expects this
expression to contain at least one parenthesized expression which
matches the message number as in the default of
- \"^\\\\( *[0-9]+\\\\)W\".
+ \"^\\\\( *[0-9]+\\\\)A\".
This expression includes the leading space within parenthesis
since it looks better to highlight it as well. The highlighting
-is done with the face `mh-folder-whitelisted'. This regular
+is done with the face `mh-folder-allowlisted'. This regular
expression should be correct as it is needed by non-fontification
-functions. See also `mh-note-whitelisted'.")
+functions. See also `mh-note-allowlisted'.")
@@ -333,8 +333,8 @@ This column will have one of the values: \" \", \"^\",
\"D\", \"B\", \"W\", \"+\
\" \" is the default value,
\"^\" is the `mh-note-refiled' character,
\"D\" is the `mh-note-deleted' character,
- \"B\" is the `mh-note-blacklisted' character,
- \"W\" is the `mh-note-whitelisted' character, and
+ \"B\" is the `mh-note-blocklisted' character,
+ \"A\" is the `mh-note-allowlisted' character, and
\"+\" is the `mh-note-cur' character.")
(defvar mh-scan-destination-width 1
@@ -399,9 +399,9 @@ This column will only ever have spaces in it.")
;; Alphabetical.
-(defvar mh-note-blacklisted ?B
- "Messages that have been blacklisted are marked by this character.
-See also `mh-scan-blacklisted-msg-regexp'.")
+(defvar mh-note-blocklisted ?B
+ "Messages that have been blocklisted are marked by this character.
+See also `mh-scan-blocklisted-msg-regexp'.")
(defvar mh-note-cur ?+
"The current message (in MH, not in MH-E) is marked by this character.
@@ -436,9 +436,9 @@ See also `mh-scan-refiled-msg-regexp'.")
Messages in the \"search\" sequence are marked by this character as
well.")
-(defvar mh-note-whitelisted ?W
- "Messages that have been whitelisted are marked by this character.
-See also `mh-scan-whitelisted-msg-regexp'.")
+(defvar mh-note-allowlisted ?A
+ "Messages that have been allowlisted are marked by this character.
+See also `mh-scan-allowlisted-msg-regexp'.")
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index b3a250b..e03c9dc 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -1448,7 +1448,7 @@ being the list of messages originally from that folder."
(defun mh-index-execute-commands ()
"Perform the outstanding operations on the actual messages.
The copies in the searched folder are then deleted, refiled,
-blacklisted and whitelisted to get the desired result. Before
+blocklisted and allowlisted to get the desired result. Before
processing the messages we make sure that the message is
identical to the one that the user has marked in the index
buffer."
@@ -1465,12 +1465,12 @@ buffer."
(with-current-buffer folder
(let ((old-refile-list mh-refile-list)
(old-delete-list mh-delete-list)
- (old-blacklist mh-blacklist)
- (old-whitelist mh-whitelist))
+ (old-blocklist mh-blocklist)
+ (old-allowlist mh-allowlist))
(setq mh-refile-list nil
mh-delete-list msgs
- mh-blacklist nil
- mh-whitelist nil)
+ mh-blocklist nil
+ mh-allowlist nil)
(unwind-protect (mh-execute-commands)
(setq mh-refile-list
(mapcar (lambda (x)
@@ -1482,11 +1482,11 @@ buffer."
mh-delete-list
(cl-loop for x in old-delete-list
unless (memq x msgs) collect x)
- mh-blacklist
- (cl-loop for x in old-blacklist
+ mh-blocklist
+ (cl-loop for x in old-blocklist
unless (memq x msgs) collect x)
- mh-whitelist
- (cl-loop for x in old-whitelist
+ mh-allowlist
+ (cl-loop for x in old-allowlist
unless (memq x msgs) collect x))
(mh-set-folder-modified-p (mh-outstanding-commands-p))
(when (mh-outstanding-commands-p)
@@ -1494,8 +1494,8 @@ buffer."
(mh-index-matching-source-msgs (append (cl-loop for x in mh-refile-list
append (cdr x))
mh-delete-list
- mh-blacklist
- mh-whitelist)
+ mh-blocklist
+ mh-allowlist)
t))
folders)))
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index aa97f5c..803f07e 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -463,8 +463,10 @@ still visible.\n")
(mh-defun-show-buffer mh-show-index-visit-folder mh-index-visit-folder t)
(mh-defun-show-buffer mh-show-toggle-tick mh-toggle-tick)
(mh-defun-show-buffer mh-show-narrow-to-tick mh-narrow-to-tick)
-(mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist)
-(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist)
+(mh-defun-show-buffer mh-show-junk-allowlist mh-junk-allowlist)
+(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-allowlist)
+(make-obsolete 'mh-show-junk-whitelist 'mh-show-junk-allowlist "28.1")
+(mh-defun-show-buffer mh-show-junk-blocklist mh-junk-blocklist)
(mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages)
(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages)
(mh-defun-show-buffer mh-show-index-sequenced-messages
@@ -633,7 +635,8 @@ still visible.\n")
(gnus-define-keys (mh-show-junk-map "J" mh-show-mode-map)
"?" mh-prefix-help
- "b" mh-show-junk-blacklist
+ "a" mh-show-junk-allowlist
+ "b" mh-show-junk-blocklist
"w" mh-show-junk-whitelist)
(gnus-define-keys (mh-show-ps-print-map "P" mh-show-mode-map)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 813ce14..2c6340e 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2328,6 +2328,25 @@ variables.")
(setq deactivate-mark nil)
(throw 'exit nil))
+(defun minibuffer-restore-windows ()
+ "Restore some windows on exit from minibuffer.
+When `read-minibuffer-restore-windows' is nil, then this function
+added to `minibuffer-exit-hook' will remove at least the window
+that displays the \"*Completions*\" buffer."
+ (unless read-minibuffer-restore-windows
+ (minibuffer-hide-completions)))
+
+(add-hook 'minibuffer-exit-hook 'minibuffer-restore-windows)
+
+(defun minibuffer-quit-recursive-edit ()
+ "Quit the command that requested this recursive edit without error.
+Like `abort-recursive-edit' without aborting keyboard macro
+execution."
+ ;; See Info node `(elisp)Recursive Editing' for an explanation of
+ ;; throwing a function to `exit'.
+ (throw 'exit (lambda ()
+ (signal 'minibuffer-quit nil))))
+
(defun self-insert-and-exit ()
"Terminate minibuffer input."
(interactive)
@@ -3078,7 +3097,7 @@ See `read-file-name' for the meaning of the arguments."
(minibuffer-maybe-quote-filename dir)))
(initial (cons (minibuffer-maybe-quote-filename initial)
0)))))
- (let ((completion-ignore-case read-file-name-completion-ignore-case)
+ (let ((ignore-case read-file-name-completion-ignore-case)
(minibuffer-completing-file-name t)
(pred (or predicate 'file-exists-p))
(add-to-history nil))
@@ -3106,6 +3125,7 @@ See `read-file-name' for the meaning of the arguments."
minibuffer-default))
(setq minibuffer-default
(cdr-safe minibuffer-default)))
+ (setq-local completion-ignore-case ignore-case)
;; On the first request on `M-n' fill
;; `minibuffer-default' with a list of defaults
;; relevant for file-name reading.
diff --git a/lisp/mouse.el b/lisp/mouse.el
index ab260d4..89e5d7c 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1208,7 +1208,7 @@ overlay property, the value of that property determines
what to do.
for the `follow-link' event, the binding of that event determines
what to do.
-The resulting value determine whether POS is inside a link:
+The resulting value determines whether POS is inside a link:
- If the value is `mouse-face', POS is inside a link if there
is a non-nil `mouse-face' property at POS. Return t in this case.
@@ -2881,8 +2881,8 @@ is copied instead of being cut."
(set-marker (nth 2 state) nil))
(with-current-buffer (window-buffer window)
(setq cursor-type (nth 3 state)))))))
-
+
;;; Bindings for mouse commands.
(global-set-key [down-mouse-1] 'mouse-drag-region)
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index b31805a..def7758 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -40,6 +40,8 @@
(require 'timer)
(defvar mouse-wheel-mode)
+(defvar mouse-wheel--installed-bindings-alist nil
+ "Alist of all installed mouse wheel key bindings.")
;; Setter function for mouse-button user-options. Switch Mouse Wheel
;; mode off and on again so that the old button is unbound and
@@ -47,8 +49,10 @@
(defun mouse-wheel-change-button (var button)
(set-default var button)
- ;; Sync the bindings.
- (when (bound-and-true-p mouse-wheel-mode) (mouse-wheel-mode 1)))
+ ;; Sync the bindings if they're already setup.
+ (when (and mouse-wheel--installed-bindings-alist
+ (bound-and-true-p mouse-wheel-mode))
+ (mouse-wheel-mode 1)))
(defcustom mouse-wheel-down-event
(if (or (featurep 'w32-win) (featurep 'ns-win))
@@ -380,9 +384,6 @@ value of ARG, and the command uses it in subsequent
scrolls."
(text-scale-decrease 1)))
(select-window selected-window))))
-(defvar mouse-wheel--installed-bindings-alist nil
- "Alist of all installed mouse wheel key bindings.")
-
(defun mouse-wheel--add-binding (key fun)
"Bind mouse wheel button KEY to function FUN.
Save it for later removal by `mouse-wheel--remove-bindings'."
@@ -418,30 +419,31 @@ an event used for scrolling, such as
`mouse-wheel-down-event'."
(define-minor-mode mouse-wheel-mode
"Toggle mouse wheel support (Mouse Wheel mode)."
:init-value t
- ;; We'd like to use custom-initialize-set here so the setup is done
- ;; before dumping, but at the point where the defcustom is evaluated,
- ;; the corresponding function isn't defined yet, so
- ;; custom-initialize-set signals an error.
- :initialize 'custom-initialize-delay
:global t
:group 'mouse
;; Remove previous bindings, if any.
(mouse-wheel--remove-bindings)
;; Setup bindings as needed.
(when mouse-wheel-mode
- (dolist (binding mouse-wheel-scroll-amount)
- (cond
- ;; Bindings for changing font size.
- ((and (consp binding) (eq (cdr binding) 'text-scale))
- (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event))
- (mouse-wheel--add-binding `[,(list (caar binding) event)]
- 'mouse-wheel-text-scale)))
- ;; Bindings for scrolling.
- (t
- (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
- mouse-wheel-left-event mouse-wheel-right-event))
- (dolist (key (mouse-wheel--create-scroll-keys binding event))
- (mouse-wheel--add-binding key 'mwheel-scroll))))))))
+ (mouse-wheel--setup-bindings)))
+
+(defun mouse-wheel--setup-bindings ()
+ (dolist (binding mouse-wheel-scroll-amount)
+ (cond
+ ;; Bindings for changing font size.
+ ((and (consp binding) (eq (cdr binding) 'text-scale))
+ (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event))
+ (mouse-wheel--add-binding `[,(list (caar binding) event)]
+ 'mouse-wheel-text-scale)))
+ ;; Bindings for scrolling.
+ (t
+ (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
+ mouse-wheel-left-event mouse-wheel-right-event))
+ (dolist (key (mouse-wheel--create-scroll-keys binding event))
+ (mouse-wheel--add-binding key 'mwheel-scroll)))))))
+
+(when mouse-wheel-mode
+ (mouse-wheel--setup-bindings))
;;; Obsolete.
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 54f7f41..aeeb9bd 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -1177,7 +1177,24 @@ See \"~/.mailcap\", `mailcap-mime-data' and related
files and variables."
(shell-quote-argument (convert-standard-filename file))
command
nil t))
- (start-process-shell-command command nil command)))
+ ;; Handlers such as "gio open" and kde-open5 start viewer in background
+ ;; and exit immediately. Avoid `start-process' since it assumes
+ ;; :connection-type `pty' and kills children processes with SIGHUP
+ ;; when temporary terminal session is finished (Bug#44824).
+ ;; An alternative is `process-connection-type' let-bound to nil for
+ ;; `start-process-shell-command' call (with no chance to report failure).
+ (make-process
+ :name "mailcap-view-file"
+ :connection-type 'pipe
+ :buffer nil ; "*Messages*" may be suitable for debugging
+ :sentinel (lambda (proc event)
+ (when (and (memq (process-status proc) '(exit signal))
+ (/= (process-exit-status proc) 0))
+ (message
+ "Command %s: %s."
+ (mapconcat #'identity (process-command proc) " ")
+ (substring event 0 -1))))
+ :command (list shell-file-name shell-command-switch command))))
(provide 'mailcap)
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index edbbc1e..f11f36e 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -25,7 +25,7 @@
;;; Commentary:
;; Internet Relay Chat (IRC) is a form of instant communication over
-;; the Internet. It is mainly designed for group (many-to-many)
+;; the Internet. It is mainly designed for group (many-to-many)
;; communication in discussion forums called channels, but also allows
;; one-to-one communication.
@@ -44,7 +44,10 @@
(require 'cl-lib)
(require 'ring)
(require 'time-date)
+(require 'auth-source)
+(require 'parse-time)
(eval-when-compile (require 'subr-x))
+(eval-when-compile (require 'rx))
(defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version))
@@ -56,10 +59,10 @@
:group 'applications)
(defcustom rcirc-server-alist
- '(("chat.freenode.net" :channels ("#rcirc")
- ;; Don't use the TLS port by default, in case gnutls is not available.
- ;; :port 7000 :encryption tls
- ))
+ (if (gnutls-available-p)
+ '(("irc.libera.chat" :channels ("#rcirc")
+ :port 6697 :encryption tls))
+ '(("irc.libera.chat" :channels ("#rcirc"))))
"An alist of IRC connections to establish when running `rcirc'.
Each element looks like (SERVER-NAME PARAMETERS).
@@ -108,8 +111,9 @@ for connections using SSL/TLS.
`:server-alias'
-VALUE must be a string that will be used instead of the server name for
-display purposes. If absent, the real server name will be displayed instead."
+VALUE must be a string that will be used instead of the server
+name for display purposes. If absent, the real server name will
+be displayed instead."
:type '(alist :key-type string
:value-type (plist :options
((:nick string)
@@ -120,7 +124,8 @@ display purposes. If absent, the real server name will be
displayed instead."
(:channels (repeat string))
(:encryption (choice (const tls)
(const plain)))
- (:server-alias string)))))
+ (:server-alias string))))
+ :version "28.1")
(defcustom rcirc-default-port 6667
"The default port to connect to."
@@ -179,17 +184,29 @@ If nil, no maximum is applied."
(integer :tag "Number of characters")))
(defvar-local rcirc-ignore-buffer-activity-flag nil
- "If non-nil, ignore activity in this buffer.")
+ "Non-nil means ignore activity in this buffer.")
(defvar-local rcirc-low-priority-flag nil
- "If non-nil, activity in this buffer is considered low priority.")
+ "Non-nil means activity in this buffer is considered low priority.")
(defcustom rcirc-omit-responses
'("JOIN" "PART" "QUIT" "NICK")
"Responses which will be hidden when `rcirc-omit-mode' is enabled."
:type '(repeat string))
-(defvar rcirc-prompt-start-marker nil)
+(defcustom rcirc-omit-after-reconnect
+ '("JOIN" "TOPIC" "NAMES")
+ "Types of messages to hide right after reconnecting."
+ :type '(repeat string)
+ :version "28.1")
+
+(defvar-local rcirc-reconncting nil
+ "Non-nil means we have just reconnected.
+This is used to hide the message types enumerated in
+`rcirc-supress-after-reconnect'.")
+
+(defvar-local rcirc-prompt-start-marker nil
+ "Marker indicating the beginning of the message prompt.")
(define-minor-mode rcirc-omit-mode
"Toggle the hiding of \"uninteresting\" lines.
@@ -228,8 +245,7 @@ number. If zero or nil, no truncating is done."
(integer :tag "Number of lines")))
(defcustom rcirc-scroll-show-maximum-output t
- "If non-nil, scroll buffer to keep the point at the bottom of
-the window."
+ "Non-nil means scroll to keep the point at the bottom of the window."
:type 'boolean)
(defcustom rcirc-authinfo nil
@@ -248,8 +264,8 @@ The ARGUMENTS for each METHOD symbol are:
`sasl': NICK PASSWORD
Examples:
- ((\"freenode\" nickserv \"bob\" \"p455w0rd\")
- (\"freenode\" chanserv \"bob\" \"#bobland\" \"passwd99\")
+ ((\"Libera.Chat\" nickserv \"bob\" \"p455w0rd\")
+ (\"Libera.Chat\" chanserv \"bob\" \"#bobland\" \"passwd99\")
(\"bitlbee\" bitlbee \"robert\" \"sekrit\")
(\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\")
(\"quakenet.org\" quakenet \"bobby\" \"sekrit\")
@@ -296,8 +312,9 @@ The following replacements are made:
%s is the server.
%t is the buffer target, a channel or a user.
-Setting this alone will not affect the prompt;
-use either M-x customize or also call `rcirc-update-prompt'."
+Setting this alone will not affect the prompt; use either
+\\[execute-extended-command] customize or also call
+`rcirc-update-prompt'."
:type 'string
:set #'rcirc-set-changed
:initialize 'custom-initialize-default)
@@ -391,13 +408,21 @@ will be killed."
:version "24.3"
:type 'boolean)
-(defvar rcirc-nick nil)
+(defcustom rcirc-nick-filter #'identity
+ "Function applied to nicknames before displaying."
+ :version "28.1"
+ :type 'function)
+
+(defvar-local rcirc-nick nil
+ "The nickname used for the current connection.")
-(defvar rcirc-prompt-end-marker nil)
+(defvar-local rcirc-prompt-end-marker nil
+ "Marker indicating the end of the message prompt.")
-(defvar rcirc-nick-table nil)
+(defvar-local rcirc-nick-table nil
+ "Hash table mapping nicks to channels.")
-(defvar rcirc-recent-quit-alist nil
+(defvar-local rcirc-recent-quit-alist nil
"Alist of nicks that have recently quit or parted the channel.")
(defvar rcirc-nick-syntax-table
@@ -408,8 +433,8 @@ will be killed."
table)
"Syntax table which includes all nick characters as word constituents.")
-;; each process has an alist of (target . buffer) pairs
-(defvar rcirc-buffer-alist nil)
+(defvar-local rcirc-buffer-alist nil
+ "Alist of (TARGET . BUFFER) pairs.")
(defvar rcirc-activity nil
"List of buffers with unviewed activity.")
@@ -418,16 +443,16 @@ will be killed."
"String displayed in mode line representing `rcirc-activity'.")
(put 'rcirc-activity-string 'risky-local-variable t)
-(defvar rcirc-server-buffer nil
+(defvar-local rcirc-server-buffer nil
"The server buffer associated with this channel buffer.")
-(defvar rcirc-server-parameters nil
+(defvar-local rcirc-server-parameters nil
"List of parameters received from the server.")
-(defvar rcirc-target nil
+(defvar-local rcirc-target nil
"The channel or user associated with this buffer.")
-(defvar rcirc-urls nil
+(defvar-local rcirc-urls nil
"List of URLs seen in the current buffer and their start positions.")
(put 'rcirc-urls 'permanent-local t)
@@ -435,7 +460,8 @@ will be killed."
"Kill connection after this many seconds if there is no activity.")
-(defvar rcirc-startup-channels nil)
+(defvar-local rcirc-startup-channels nil
+ "List of channel names to join after authenticating.")
(defvar rcirc-server-name-history nil
"History variable for \\[rcirc] call.")
@@ -505,6 +531,12 @@ If ARG is non-nil, instead prompt for connection
parameters."
(encryption (plist-get (cdr c) :encryption))
(server-alias (plist-get (cdr c) :server-alias))
contact)
+ (when-let (((not password))
+ (auth (auth-source-search :host server
+ :user user-name
+ :port port))
+ (fn (plist-get (car auth) :secret)))
+ (setq password (funcall fn)))
(when server
(let (connected)
(dolist (p (rcirc-process-list))
@@ -536,20 +568,53 @@ If ARG is non-nil, instead prompt for connection
parameters."
(defalias 'irc 'rcirc)
-(defvar rcirc-process-output nil)
-(defvar rcirc-topic nil)
-(defvar rcirc-keepalive-timer nil)
-(defvar rcirc-last-server-message-time nil)
-(defvar rcirc-server nil) ; server provided by server
-(defvar rcirc-server-name nil) ; server name given by 001 response
-(defvar rcirc-timeout-timer nil)
-(defvar rcirc-user-authenticated nil)
-(defvar rcirc-user-disconnect nil)
-(defvar rcirc-connecting nil)
-(defvar rcirc-connection-info nil)
-(defvar rcirc-process nil)
+(defvar-local rcirc-process-output nil
+ "Partial message response.")
+(defvar-local rcirc-topic nil
+ "Topic of the current channel.")
+(defvar rcirc-keepalive-timer nil
+ "Timer for sending KEEPALIVE message.")
+(defvar-local rcirc-last-server-message-time nil
+ "Timestamp for the last server response.")
+(defvar-local rcirc-server nil
+ "Server provided by server.")
+(defvar-local rcirc-server-name nil
+ "Server name given by 001 response.")
+(defvar-local rcirc-timeout-timer nil
+ "Timer for determining a network timeout.")
+(defvar-local rcirc-user-authenticated nil
+ "Flag indicating if the user is authenticated.")
+(defvar-local rcirc-user-disconnect nil
+ "Flag indicating if the connection was broken.")
+(defvar-local rcirc-connecting nil
+ "Flag indicating if the connection is being established.")
+(defvar-local rcirc-connection-info nil
+ "Information about the current connection.
+If defined, it is a list of this form (SERVER PORT NICK USER-NAME
+FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION SERVER-ALIAS).
+See `rcirc-connect' for more details on these variables.")
+(defvar-local rcirc-process nil
+ "Network process for the current connection.")
+
+;;; IRCv3 capability negotiation
(https://ircv3.net/specs/extensions/capability-negotiation)
+(defvar rcirc-implemented-capabilities
+ '("message-tags"
;https://ircv3.net/specs/extensions/message-tags
+ "server-time"
;https://ircv3.net/specs/extensions/server-time
+ "batch"
;https://ircv3.net/specs/extensions/batch
+ "message-ids"
;https://ircv3.net/specs/extensions/message-ids
+ "invite-notify"
;https://ircv3.net/specs/extensions/invite-notify
+ "sasl"
;https://ircv3.net/specs/extensions/sasl-3.1
+ )
+ "A list of capabilities that rcirc supports.")
+(defvar-local rcirc-requested-capabilities nil
+ "A list of capabilities that client has requested.")
+(defvar-local rcirc-acked-capabilities nil
+ "A list of capabilities that the server supports.")
+(defvar-local rcirc-finished-sasl t
+ "Check whether SASL authentication has completed")
(defun rcirc-get-server-method (server)
+ "Return authentication method for SERVER."
(catch 'method
(dolist (i rcirc-authinfo)
(let ((server-i (car i))
@@ -558,6 +623,7 @@ If ARG is non-nil, instead prompt for connection
parameters."
(throw 'method method))))))
(defun rcirc-get-server-password (server)
+ "Return password for SERVER."
(catch 'pass
(dolist (i rcirc-authinfo)
(let ((server-i (car i))
@@ -569,6 +635,11 @@ If ARG is non-nil, instead prompt for connection
parameters."
(defun rcirc-connect (server &optional port nick user-name
full-name startup-channels password encryption
server-alias)
+ "Connect to SERVER.
+The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD,
+ENCRYPTION, SERVER-ALIAS are interpreted as in
+`rcirc-server-alist'. STARTUP-CHANNELS is a list of channels
+that are joined after authentication."
(save-excursion
(message "Connecting to %s..." (or server-alias server))
(let* ((inhibit-eol-conversion)
@@ -589,44 +660,42 @@ If ARG is non-nil, instead prompt for connection
parameters."
(set-process-coding-system process 'raw-text 'raw-text)
(switch-to-buffer (rcirc-generate-new-buffer-name process nil))
(set-process-buffer process (current-buffer))
- (rcirc-mode process nil)
+ (unless (eq major-mode 'rcirc-mode)
+ (rcirc-mode process nil))
(set-process-sentinel process 'rcirc-sentinel)
(set-process-filter process 'rcirc-filter)
- (setq-local rcirc-connection-info
- (list server port nick user-name full-name startup-channels
- password encryption server-alias))
- (setq-local rcirc-process process)
- (setq-local rcirc-server server)
- (setq-local rcirc-server-name
- (or server-alias server)) ; Update when we get 001 response.
- (setq-local rcirc-buffer-alist nil)
- (setq-local rcirc-nick-table (make-hash-table :test 'equal))
- (setq-local rcirc-nick nick)
- (setq-local rcirc-process-output nil)
- (setq-local rcirc-startup-channels startup-channels)
- (setq-local rcirc-last-server-message-time (current-time))
-
- (setq-local rcirc-timeout-timer nil)
- (setq-local rcirc-user-disconnect nil)
- (setq-local rcirc-user-authenticated nil)
- (setq-local rcirc-connecting t)
- (setq-local rcirc-server-parameters nil)
+ (setq rcirc-connection-info
+ (list server port nick user-name full-name startup-channels
+ password encryption server-alias))
+ (setq rcirc-process process)
+ (setq rcirc-server server)
+ (setq rcirc-server-name (or server-alias server)) ; Update when we get
001 response.
+ (setq rcirc-nick-table (make-hash-table :test 'equal))
+ (setq rcirc-nick nick)
+ (setq rcirc-startup-channels startup-channels)
+ (setq rcirc-last-server-message-time (current-time))
+
+ (setq rcirc-connecting t)
(add-hook 'auto-save-hook 'rcirc-log-write)
(when use-sasl
(rcirc-send-string process "CAP REQ sasl"))
+ (when use-sasl
+ (setq-local rcirc-finished-sasl nil))
;; identify
+ (dolist (cap rcirc-implemented-capabilities)
+ (rcirc-send-string process "CAP" "REQ" : cap)
+ (push cap rcirc-requested-capabilities))
(unless (zerop (length password))
- (rcirc-send-string process (concat "PASS " password)))
- (rcirc-send-string process (concat "NICK " nick))
- (rcirc-send-string process (concat "USER " user-name
- " 0 * :" full-name))
+ (rcirc-send-string process "PASS" password))
+ (rcirc-send-string process "NICK" nick)
+ (rcirc-send-string process "USER" user-name "0" "*" : full-name)
;; Setup sasl, and initiate authentication.
(when (and rcirc-auto-authenticate-flag
use-sasl)
- (rcirc-send-string process "AUTHENTICATE PLAIN"))
+ (rcirc-send-string process "AUTHENTICATE" "PLAIN"))
;; setup ping timer if necessary
(unless rcirc-keepalive-timer
@@ -634,31 +703,33 @@ If ARG is non-nil, instead prompt for connection
parameters."
(run-at-time 0 (/ rcirc-timeout-seconds 2) 'rcirc-keepalive)))
(message "Connecting to %s...done" (or server-alias server))
+ (setq mode-line-process nil)
;; return process object
process)))
(defmacro with-rcirc-process-buffer (process &rest body)
+ "Evaluate BODY in the buffer of PROCESS."
(declare (indent 1) (debug t))
`(with-current-buffer (process-buffer ,process)
,@body))
(defmacro with-rcirc-server-buffer (&rest body)
+ "Evaluate BODY in the server buffer of the current channel."
(declare (indent 0) (debug t))
- `(with-current-buffer rcirc-server-buffer
- ,@body))
+ `(if (buffer-live-p rcirc-server-buffer)
+ (with-current-buffer rcirc-server-buffer
+ ,@body)
+ (user-error "Server buffer was killed")))
(define-obsolete-function-alias 'rcirc-float-time 'float-time "26.1")
(defun rcirc-prompt-for-encryption (server-plist)
"Prompt the user for the encryption method to use.
SERVER-PLIST is the property list for the server."
- (let ((choices '("plain" "tls"))
- (default (or (plist-get server-plist :encryption)
- "plain")))
- (intern
- (completing-read (format-prompt "Encryption" default)
- choices nil t nil nil default))))
+ (if (or (eq (plist-get server-plist :encryption) 'plain)
+ (yes-or-no-p "Encrypt connection?"))
+ 'tls 'plain))
(defun rcirc-keepalive ()
"Send keep alive pings to active rcirc processes.
@@ -679,14 +750,18 @@ last ping."
(setq rcirc-keepalive-timer nil)))
(defun rcirc-handler-ctcp-KEEPALIVE (process _target _sender message)
+ "Uptime header in PROCESS buffer.
+MESSAGE should contain a timestamp, indicating when the KEEPALIVE
+message was generated."
(with-rcirc-process-buffer process
(setq header-line-format
(format "%f" (float-time
(time-since (string-to-number message)))))))
-(defvar rcirc-debug-buffer "*rcirc debug*")
+(defvar rcirc-debug-buffer "*rcirc debug*"
+ "Buffer name for debugging messages.")
(defvar rcirc-debug-flag nil
- "If non-nil, write information to `rcirc-debug-buffer'.")
+ "Non-nil means write information to `rcirc-debug-buffer'.")
(defun rcirc-debug (process text)
"Add an entry to the debug log including PROCESS and TEXT.
Debug text is appended to `rcirc-debug-buffer' if `rcirc-debug-flag'
@@ -720,7 +795,7 @@ When 0, do not auto-reconnect."
:version "25.1"
:type 'integer)
-(defvar rcirc-last-connect-time nil
+(defvar-local rcirc-last-connect-time nil
"The last time the buffer was connected.")
(defun rcirc-sentinel (process sentinel)
@@ -748,6 +823,8 @@ When 0, do not auto-reconnect."
(run-hook-with-args 'rcirc-sentinel-functions process sentinel))))
(defun rcirc-disconnect-buffer (&optional buffer)
+ "Disconnect BUFFER.
+If BUFFER is nil, default to the current buffer."
(with-current-buffer (or buffer (current-buffer))
;; set rcirc-target to nil for each channel so cleanup
;; doesn't happen when we reconnect
@@ -785,19 +862,19 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS
and LINE.")
(rcirc-process-server-response process line))))))
(defun rcirc-reschedule-timeout (process)
+ "Update timeout indicator for PROCESS."
(with-rcirc-process-buffer process
(when (not rcirc-connecting)
(with-rcirc-process-buffer process
(when rcirc-timeout-timer (cancel-timer rcirc-timeout-timer))
(setq rcirc-timeout-timer (run-at-time rcirc-timeout-seconds nil
- 'rcirc-delete-process
+ 'delete-process
process))))))
-(defun rcirc-delete-process (process)
- (delete-process process))
-
-(defvar rcirc-trap-errors-flag t)
+(defvar rcirc-trap-errors-flag t
+ "Non-nil means Lisp errors are degraded to error messages.")
(defun rcirc-process-server-response (process text)
+ "Parse TEXT as received from PROCESS."
(if rcirc-trap-errors-flag
(condition-case err
(rcirc-process-server-response-1 process text)
@@ -806,17 +883,91 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS
and LINE.")
(format "\"%s\" %s" text err) t)))
(rcirc-process-server-response-1 process text)))
+(defconst rcirc-process-regexp
+ (rx-let ((message-tag ; message tags as specified in
+ ; https://ircv3.net/specs/extensions/message-tags
+ (: (? "+")
+ (? (+ (or alnum "-")) (+ "." (+ (or alnum "-"))) "/")
+ (+ (any alnum "-"))
+ (? "="
+ (* (not (any 0 ?\n ?\r ?\; ?\s)))))))
+ (rx line-start
+ (optional "@" (group message-tag (* ";" message-tag)) (+ space))
+ ;; See https://tools.ietf.org/html/rfc2812#section-2.3.1.
+ ;; We're a bit more accepting than the RFC: We allow any non-space
+ ;; characters in the command name, multiple spaces between
+ ;; arguments, and allow the last argument to omit the leading ":",
+ ;; even if there are less than 15 arguments.
+ (optional
+ (group ":" (group (one-or-more (not (any " ")))) " "))
+ (group (one-or-more (not (any " "))))))
+ "Regular expression used for parsing server response.")
+
+(defconst rcirc-tag-regexp
+ (rx bos
+ (group
+ (? "+")
+ (? (+ (or alnum "-")) (+ "." (+ (or alnum "-"))) "/")
+ (+ (any alnum "-")))
+ (? "=" (group (* (not (any 0 ?\n ?\r ?\; ?\s)))))
+ eos)
+ "Regular expression used for destructing a tag.")
+
+(defvar rcirc-message-tags nil
+ "Alist of parsed message tags.")
+
+(defvar rcirc-supported-batch-types
+ '()
+ "List of recognized batch types.
+Each element has the form (TYPE HANDLE), where TYPE is a string
+and HANDLE is either the symbol `immediate' or `deferred'.
+Messages in an immediate batch are handled just like regular
+messages, while deferred messages are stored in
+`rcirc-batch-messages'.")
+
+(defvar-local rcirc-batch-attributes nil
+ "Alist mapping batch IDs to parameters.")
+
+(defvar-local rcirc-batched-messages nil
+ "Alist mapping batch IDs to deferred messages.
+Note that the messages are stored in reverse order.")
+
+(defsubst rcirc-get-tag (key &optional default)
+ "Return tag value for KEY or DEFAULT."
+ (alist-get key rcirc-message-tags default nil #'string=))
+
(defun rcirc-process-server-response-1 (process text)
- ;; See https://tools.ietf.org/html/rfc2812#section-2.3.1. We're a
- ;; bit more accepting than the RFC: We allow any non-space
- ;; characters in the command name, multiple spaces between
- ;; arguments, and allow the last argument to omit the leading ":",
- ;; even if there are less than 15 arguments.
- (if (string-match "^\\(:\\([^ ]+\\) \\)?\\([^ ]+\\)" text)
- (let* ((user (match-string 2 text))
+ "Parse TEXT as received from PROCESS."
+ (if (string-match rcirc-process-regexp text)
+ (let* ((rcirc-message-tags
+ (append
+ (and-let* ((tag-data (match-string 1 text)))
+ (save-match-data
+ (mapcar
+ (lambda (tag)
+ (unless (string-match rcirc-tag-regexp tag)
+ ;; This should not happen, unless there is
+ ;; a mismatch between this regular
+ ;; expression and `rcirc-process-regexp'.
+ (error "Malformed tag %S" tag))
+ (cons (match-string 1 tag)
+ (replace-regexp-in-string
+ (rx (* ?\\ ?\\) ?\\ (any ?: ?s ?\\ ?r ?n))
+ (lambda (rep)
+ (concat (substring rep 0 -2)
+ (cl-case (aref rep (1- (length rep)))
+ (?: ";")
+ (?s " ")
+ (?\\ "\\\\")
+ (?r "\r")
+ (?n "\n"))))
+ (match-string 2 tag))))
+ (split-string tag-data ";"))))
+ rcirc-message-tags))
+ (user (match-string 3 text))
(sender (rcirc-user-nick user))
- (cmd (match-string 3 text))
- (cmd-end (match-end 3))
+ (cmd (match-string 4 text))
+ (cmd-end (match-end 4))
(args nil)
(handler (intern-soft (concat "rcirc-handler-" cmd))))
(cl-loop with i = cmd-end
@@ -829,9 +980,18 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and
LINE.")
(push (substring text (match-end 0)) args)
(cl-assert (= i (length text))))
(cl-callf nreverse args)))
- (if (not (fboundp handler))
- (rcirc-handler-generic process cmd sender args text)
- (funcall handler process sender args text))
+ (cond ((and-let* ((batch-id (rcirc-get-tag "batch"))
+ (type (cadr (assoc batch-id rcirc-batch-attributes)))
+ (attr (assoc type rcirc-supported-batch-types))
+ ((eq (cadr attr) 'deferred)))
+ ;; handle deferred batch messages later
+ (push (list cmd process sender args text rcirc-message-tags)
+ (alist-get batch-id rcirc-batched-messages
+ nil nil #'string=))
+ t))
+ ((not (fboundp handler))
+ (rcirc-handler-generic process cmd sender args text))
+ ((funcall handler process sender args text)))
(run-hook-with-args 'rcirc-receive-message-functions
process cmd sender args text))
(message "UNHANDLED: %s" text)))
@@ -840,17 +1000,34 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS
and LINE.")
"Responses that don't trigger activity in the mode-line indicator.")
(defun rcirc-handler-generic (process response sender args _text)
- "Generic server response handler."
+ "Generic server response handler.
+This handler is called, when no more specific handler could be
+found. PROCESS, SENDER and RESPONSE are passed on to
+`rcirc-print'. ARGS are concatenated into a single string and
+used as the message body."
(rcirc-print process sender response nil
(mapconcat 'identity (cdr args) " ")
(not (member response rcirc-responses-no-activity))))
(defun rcirc--connection-open-p (process)
+ "Check if PROCESS is open or running."
(memq (process-status process) '(run open)))
-(defun rcirc-send-string (process string)
- "Send PROCESS a STRING plus a newline."
- (let ((string (concat (encode-coding-string string
rcirc-encode-coding-system)
+(defun rcirc-send-string (process &rest parts)
+ "Send PROCESS a PARTS plus a newline.
+PARTS may contain a `:' symbol, to designate that the next string
+is the message, that should be prefixed by a colon. If the last
+element in PARTS is a list, append it to PARTS."
+ (let ((last (car (last parts))))
+ (when (listp last)
+ (setf parts (append (butlast parts) last))))
+ (when-let (message (memq : parts))
+ (cl-check-type (cadr message) string)
+ (setf (cadr message) (concat ":" (cadr message))
+ parts (remq : parts)))
+ (let ((string (concat (encode-coding-string
+ (mapconcat #'identity parts " ")
+ rcirc-encode-coding-system)
"\n")))
(unless (rcirc--connection-open-p process)
(error "Network connection to %s is not open"
@@ -859,13 +1036,17 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS
and LINE.")
(process-send-string process string)))
(defun rcirc-send-privmsg (process target string)
+ "Send TARGET the message in STRING via PROCESS."
(cl-check-type target string)
- (rcirc-send-string process (format "PRIVMSG %s :%s" target string)))
+ (rcirc-send-string process "PRIVMSG" target : string))
+
+(defun rcirc-ctcp-wrap (&rest args)
+ "Join ARGS into a string wrapped by ASCII 1 charterers."
+ (concat "\C-a" (string-join (delq nil args) " ") "\C-a"))
(defun rcirc-send-ctcp (process target request &optional args)
- (let ((args (if args (concat " " args) "")))
- (rcirc-send-privmsg process target
- (format "\C-a%s%s\C-a" request args))))
+ "Send TARGET a REQUEST via PROCESS."
+ (rcirc-send-privmsg process target (rcirc-ctcp-wrap request args)))
(defun rcirc-buffer-process (&optional buffer)
"Return the process associated with channel BUFFER.
@@ -891,7 +1072,7 @@ With no argument or nil as argument, use the current
buffer."
"Return the nick associated with BUFFER.
With no argument or nil as argument, use the current buffer."
(with-current-buffer (or buffer (current-buffer))
- (with-current-buffer rcirc-server-buffer
+ (with-rcirc-server-buffer
(or rcirc-nick rcirc-default-nick))))
(defvar rcirc-max-message-length 420
@@ -924,17 +1105,22 @@ If SILENT is non-nil, do not print the message in any
irc buffer."
(let ((response (if noticep "NOTICE" "PRIVMSG")))
(rcirc-get-buffer-create process target)
(dolist (msg (rcirc-split-message message))
- (rcirc-send-string process (concat response " " target " :" msg))
+ (rcirc-send-string process response target : msg)
(unless silent
(rcirc-print process (rcirc-nick process) response target msg)))))
-(defvar rcirc-input-ring nil)
-(defvar rcirc-input-ring-index 0)
+(defvar-local rcirc-input-ring nil
+ "Ring object for input.")
+
+(defvar-local rcirc-input-ring-index 0
+ "Current position in the input ring.")
(defun rcirc-prev-input-string (arg)
+ "Move ARG elements ahead in the input ring."
(ring-ref rcirc-input-ring (+ rcirc-input-ring-index arg)))
(defun rcirc-insert-prev-input ()
+ "Insert previous element in input ring."
(interactive)
(when (<= rcirc-prompt-end-marker (point))
(delete-region rcirc-prompt-end-marker (point-max))
@@ -942,6 +1128,7 @@ If SILENT is non-nil, do not print the message in any irc
buffer."
(setq rcirc-input-ring-index (1+ rcirc-input-ring-index))))
(defun rcirc-insert-next-input ()
+ "Insert next element in input ring."
(interactive)
(when (<= rcirc-prompt-end-marker (point))
(delete-region rcirc-prompt-end-marker (point-max))
@@ -975,63 +1162,62 @@ The list is updated automatically by
`defun-rcirc-command'.")
(if (re-search-backward "[[:space:]@]"
rcirc-prompt-end-marker t)
(1+ (point))
rcirc-prompt-end-marker)))
- (table (if (and (= beg rcirc-prompt-end-marker)
- (eq (char-after beg) ?/))
- (delete-dups
- (nconc (sort (copy-sequence rcirc-client-commands)
- 'string-lessp)
- (sort (copy-sequence rcirc-server-commands)
- 'string-lessp)))
- (rcirc-channel-nicks (rcirc-buffer-process)
- rcirc-target))))
- (list beg (point) table))))
-
-(defvar rcirc-completions nil)
-(defvar rcirc-completion-start nil)
-
-(defun rcirc-complete ()
- "Cycle through completions from list of nicks in channel or IRC commands.
-IRC command completion is performed only if `/' is the first input char."
- (interactive)
- (unless (rcirc-looking-at-input)
- (error "Point not located after rcirc prompt"))
- (if (eq last-command this-command)
- (setq rcirc-completions
- (append (cdr rcirc-completions) (list (car rcirc-completions))))
- (let ((completion-ignore-case t)
- (table (rcirc-completion-at-point)))
- (setq rcirc-completion-start (car table))
- (setq rcirc-completions
- (and rcirc-completion-start
- (all-completions (buffer-substring rcirc-completion-start
- (cadr table))
- (nth 2 table))))))
- (let ((completion (car rcirc-completions)))
- (when completion
- (delete-region rcirc-completion-start (point))
- (insert
- (cond
- ((= (aref completion 0) ?/) (concat completion " "))
- ((= rcirc-completion-start rcirc-prompt-end-marker)
- (format rcirc-nick-completion-format completion))
- (t completion))))))
-
-(defun set-rcirc-decode-coding-system (coding-system)
- "Set the decode coding system used in this channel."
+ (table (cond
+ ;; No completion before the prompt
+ ((< beg rcirc-prompt-end-marker) nil)
+ ;; Only complete nicks mid-message
+ ((> beg rcirc-prompt-end-marker)
+ (mapcar rcirc-nick-filter
+ (rcirc-channel-nicks
+ (rcirc-buffer-process)
+ rcirc-target)))
+ ;; Complete commands at the beginning of the
+ ;; message, when the first character is a dash
+ ((eq (char-after beg) ?/)
+ (mapcar
+ (lambda (cmd) (concat cmd " "))
+ (nconc (sort (copy-sequence rcirc-client-commands)
+ 'string-lessp)
+ (sort (copy-sequence rcirc-server-commands)
+ 'string-lessp))))
+ ;; Complete usernames right after the prompt by
+ ;; appending a colon after the name
+ ((mapcar
+ (lambda (str) (concat (funcall rcirc-nick-filter str)
": "))
+ (rcirc-channel-nicks (rcirc-buffer-process)
+ rcirc-target))))))
+ (list beg (point)
+ (lambda (str pred action)
+ (if (eq action 'metadata)
+ '(metadata (cycle-sort-function . identity))
+ (complete-with-action action table str pred)))))))
+
+(defun rcirc-set-decode-coding-system (coding-system)
+ "Set the decode CODING-SYSTEM used in this channel."
(interactive "zCoding system for incoming messages: ")
(setq-local rcirc-decode-coding-system coding-system))
-(defun set-rcirc-encode-coding-system (coding-system)
- "Set the encode coding system used in this channel."
+(define-obsolete-function-alias
+ 'rcirc-set-decode-coding-system
+ 'set-rcirc-decode-coding-system
+ "28.1")
+
+(defun rcirc-set-encode-coding-system (coding-system)
+ "Set the encode CODING-SYSTEM used in this channel."
(interactive "zCoding system for outgoing messages: ")
(setq-local rcirc-encode-coding-system coding-system))
+(define-obsolete-function-alias
+ 'rcirc-set-encode-coding-system
+ 'set-rcirc-encode-coding-system
+ "28.1")
+
(defvar rcirc-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'rcirc-send-input)
(define-key map (kbd "M-p") 'rcirc-insert-prev-input)
(define-key map (kbd "M-n") 'rcirc-insert-next-input)
- (define-key map (kbd "TAB") 'rcirc-complete)
+ (define-key map (kbd "TAB") 'completion-at-point)
(define-key map (kbd "C-c C-b") 'rcirc-browse-url)
(define-key map (kbd "C-c C-c") 'rcirc-edit-multiline)
(define-key map (kbd "C-c C-j") 'rcirc-cmd-join)
@@ -1054,34 +1240,35 @@ IRC command completion is performed only if `/' is the
first input char."
map)
"Keymap for rcirc mode.")
-(defvar rcirc-short-buffer-name nil
+(defvar-local rcirc-short-buffer-name nil
"Generated abbreviation to use to indicate buffer activity.")
(defvar rcirc-mode-hook nil
"Hook run when setting up rcirc buffer.")
-(defvar rcirc-last-post-time nil)
+(defvar-local rcirc-last-post-time nil
+ "Timestamp indicating last user action.")
(defvar rcirc-log-alist nil
"Alist of lines to log to disk when `rcirc-log-flag' is non-nil.
Each element looks like (FILENAME . TEXT).")
-(defvar rcirc-current-line 0
+(defvar-local rcirc-current-line 0
"The current number of responses printed in this channel.
This number is independent of the number of lines in the buffer.")
(defun rcirc-mode (process target)
- ;; FIXME: Use define-derived-mode.
"Major mode for IRC channel buffers.
\\{rcirc-mode-map}"
+ ;; FIXME: Use define-derived-mode.
(kill-all-local-variables)
(use-local-map rcirc-mode-map)
(setq mode-name "rcirc")
(setq major-mode 'rcirc-mode)
(setq mode-line-process nil)
- (setq-local rcirc-input-ring
+ (setq rcirc-input-ring
;; If rcirc-input-ring is already a ring with desired
;; size do not re-initialize.
(if (and (ring-p rcirc-input-ring)
@@ -1089,18 +1276,14 @@ This number is independent of the number of lines in
the buffer.")
rcirc-input-ring-size))
rcirc-input-ring
(make-ring rcirc-input-ring-size)))
- (setq-local rcirc-server-buffer (process-buffer process))
- (setq-local rcirc-target target)
- (setq-local rcirc-topic nil)
- (setq-local rcirc-last-post-time (current-time))
+ (setq rcirc-server-buffer (process-buffer process))
+ (setq rcirc-target target)
+ (setq rcirc-last-post-time (current-time))
(setq-local fill-paragraph-function 'rcirc-fill-paragraph)
- (setq-local rcirc-recent-quit-alist nil)
- (setq-local rcirc-current-line 0)
- (setq-local rcirc-last-connect-time (current-time))
+ (setq rcirc-current-line 0)
+ (setq rcirc-last-connect-time (current-time))
(use-hard-newlines t)
- (setq-local rcirc-short-buffer-name nil)
- (setq-local rcirc-urls nil)
;; setup for omitting responses
(setq buffer-invisibility-spec '())
@@ -1121,8 +1304,8 @@ This number is independent of the number of lines in the
buffer.")
(if (consp (cdr i)) (cddr i) (cdr i))))))
;; setup the prompt and markers
- (setq-local rcirc-prompt-start-marker (point-max-marker))
- (setq-local rcirc-prompt-end-marker (point-max-marker))
+ (setq rcirc-prompt-start-marker (point-max-marker))
+ (setq rcirc-prompt-end-marker (point-max-marker))
(rcirc-update-prompt)
(goto-char rcirc-prompt-end-marker)
@@ -1143,6 +1326,7 @@ This number is independent of the number of lines in the
buffer.")
(add-hook 'completion-at-point-functions
'rcirc-completion-at-point nil 'local)
+ (setq-local completion-cycle-threshold t)
(run-mode-hooks 'rcirc-mode-hook))
@@ -1181,7 +1365,7 @@ If ALL is non-nil, update prompts in all IRC buffers."
'front-sticky t 'rear-nonsticky t))))))))
(defun rcirc-set-changed (option value)
- "Set OPTION to VALUE and do updates after a customization change."
+ "Set OPTION to VALUE and update after a customization change."
(set-default option value)
(cond ((eq option 'rcirc-prompt)
(rcirc-update-prompt 'all))
@@ -1224,10 +1408,11 @@ with it."
(kill-buffer (cdr channel))))))
(defun rcirc-change-major-mode-hook ()
- "Part the channel when changing the major-mode."
+ "Part the channel when changing the major mode."
(rcirc-clean-up-buffer "Changed major mode"))
(defun rcirc-clean-up-buffer (reason)
+ "Clean up current buffer and part with REASON."
(let ((buffer (current-buffer)))
(rcirc-clear-activity buffer)
(when (and (rcirc-buffer-process)
@@ -1238,7 +1423,7 @@ with it."
(rcirc-update-short-buffer-names)
(if (rcirc-channel-p rcirc-target)
(rcirc-send-string (rcirc-buffer-process)
- (concat "PART " rcirc-target " :" reason))
+ "PART" rcirc-target : reason)
(when rcirc-target
(rcirc-remove-nick-channel (rcirc-buffer-process)
(rcirc-buffer-nick)
@@ -1278,9 +1463,11 @@ Create the buffer if it doesn't exist."
(let ((new-buffer (get-buffer-create
(rcirc-generate-new-buffer-name process target))))
(with-current-buffer new-buffer
- (rcirc-mode process target)
+ (unless (eq major-mode 'rcirc-mode)
+ (rcirc-mode process target)))
+ (setq mode-line-process nil)
(rcirc-put-nick-channel process (rcirc-nick process) target
- rcirc-current-line))
+ rcirc-current-line)
new-buffer)))))
(defun rcirc-send-input ()
@@ -1316,6 +1503,8 @@ Create the buffer if it doesn't exist."
(setq rcirc-input-ring-index 0))))))
(defun rcirc-fill-paragraph (&optional justify)
+ "Implementation for `fill-paragraph-function'.
+The argument JUSTIFY is passed on to `fill-region'."
(interactive "P")
(when (> (point) rcirc-prompt-end-marker)
(save-restriction
@@ -1324,13 +1513,15 @@ Create the buffer if it doesn't exist."
(fill-region (point-min) (point-max) justify)))))
(defun rcirc-process-input-line (line)
- (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line)
+ "Process LINE as a message or a command."
+ (if (string-match "^/\\([^/ ][^ ]*\\) ?\\(.*\\)$" line)
(rcirc-process-command (match-string 1 line)
(match-string 2 line)
line)
(rcirc-process-message line)))
(defun rcirc-process-message (line)
+ "Process LINE as a message to be sent."
(if (not rcirc-target)
(message "Not joined (no target)")
(delete-region rcirc-prompt-end-marker (point))
@@ -1338,28 +1529,31 @@ Create the buffer if it doesn't exist."
(setq rcirc-last-post-time (current-time))))
(defun rcirc-process-command (command args line)
- (if (eq (aref command 0) ?/)
- ;; "//text" will send "/text" as a message
- (rcirc-process-message (substring line 1))
- (let ((fun (intern-soft (concat "rcirc-cmd-" command)))
- (process (rcirc-buffer-process)))
- (newline)
- (with-current-buffer (current-buffer)
- (delete-region rcirc-prompt-end-marker (point))
- (if (string= command "me")
- (rcirc-print process (rcirc-buffer-nick)
- "ACTION" rcirc-target args)
+ "Process COMMAND with arguments ARGS.
+LINE is the raw input, from which COMMAND and ARGS was
+extracted."
+ (let ((fun (intern-soft (concat "rcirc-cmd-" command)))
+ (process (rcirc-buffer-process)))
+ (newline)
+ (with-current-buffer (current-buffer)
+ (delete-region rcirc-prompt-end-marker (point))
+ (if (string= command "me")
(rcirc-print process (rcirc-buffer-nick)
- "COMMAND" rcirc-target line))
- (set-marker rcirc-prompt-end-marker (point))
- (if (fboundp fun)
- (funcall fun args process rcirc-target)
- (rcirc-send-string process
- (concat command " :" args)))))))
-
-(defvar-local rcirc-parent-buffer nil)
+ "ACTION" rcirc-target args)
+ (rcirc-print process (rcirc-buffer-nick)
+ "COMMAND" rcirc-target line))
+ (set-marker rcirc-prompt-end-marker (point))
+ (if (fboundp fun)
+ (funcall fun args process rcirc-target)
+ (rcirc-send-string process command : args)))))
+
+(defvar-local rcirc-parent-buffer nil
+ "Message buffer that requested a multiline buffer.")
(put 'rcirc-parent-buffer 'permanent-local t)
-(defvar rcirc-window-configuration nil)
+
+(defvar rcirc-window-configuration nil
+ "Window configuration before creating multiline buffer.")
+
(defun rcirc-edit-multiline ()
"Move current edit to a dedicated buffer."
(interactive)
@@ -1455,9 +1649,10 @@ the of the following escape sequences replaced by the
described values:
:value-type string))
(defun rcirc-format-response-string (process sender response target text)
- "Return a nicely-formatted response string, incorporating TEXT
-\(and perhaps other arguments). The specific formatting used
-is found by looking up RESPONSE in `rcirc-response-formats'."
+ "Return a formatted response string from SENDER, incorporating TEXT.
+The specific formatting used is found by looking up RESPONSE in
+`rcirc-response-formats'. PROCESS is the process object used for
+communication."
(with-temp-buffer
(insert (or (cdr (assoc response rcirc-response-formats))
(cdr (assq t rcirc-response-formats))))
@@ -1466,7 +1661,7 @@ is found by looking up RESPONSE in
`rcirc-response-formats'."
(sender (if (or (not sender)
(string= (rcirc-server-name process) sender))
""
- sender))
+ (funcall rcirc-nick-filter sender)))
face)
(while (re-search-forward "%\\(\\(f\\(.\\)\\)\\|\\(.\\)\\)" nil t)
(rcirc-add-face start (match-beginning 0) face)
@@ -1511,7 +1706,8 @@ is found by looking up RESPONSE in
`rcirc-response-formats'."
(buffer-substring (point-min) (point-max))))
(defun rcirc-target-buffer (process sender response target _text)
- "Return a buffer to print the server response."
+ "Return a buffer to print the server response from SENDER.
+PROCESS is the process object for the current connection."
(cl-assert (not (bufferp target)))
(with-rcirc-process-buffer process
(cond ((not target)
@@ -1527,8 +1723,9 @@ is found by looking up RESPONSE in
`rcirc-response-formats'."
((or (rcirc-get-buffer process target)
(rcirc-any-buffer process))))))
-(defvar-local rcirc-activity-types nil)
(defvar-local rcirc-last-sender nil)
+(defvar-local rcirc-activity-types nil
+ "List of symbols designating kinds of activities in a buffer.")
(defcustom rcirc-omit-threshold 100
"Lines since last activity from a nick before `rcirc-omit-responses' are
omitted."
@@ -1541,14 +1738,16 @@ is found by looking up RESPONSE in
`rcirc-response-formats'."
(defun rcirc-last-quit-line (process nick target)
"Return the line number where NICK left TARGET.
-Returns nil if the information is not recorded."
+Returns nil if the information is not recorded.
+PROCESS is the process object for the current connection."
(let ((chanbuf (rcirc-get-buffer process target)))
(when chanbuf
(cdr (assoc-string nick (with-current-buffer chanbuf
rcirc-recent-quit-alist))))))
(defun rcirc-last-line (process nick target)
- "Return the line from the last activity from NICK in TARGET."
+ "Return the line from the last activity from NICK in TARGET.
+PROCESS is the process object for the current connection."
(let ((line (or (cdr (assoc-string target
(gethash nick (with-rcirc-server-buffer
rcirc-nick-table)) t))
@@ -1559,7 +1758,8 @@ Returns nil if the information is not recorded."
nil)))
(defun rcirc-elapsed-lines (process nick target)
- "Return the number of lines since activity from NICK in TARGET."
+ "Return the number of lines since activity from NICK in TARGET.
+PROCESS is the process object for the current connection."
(let ((last-activity-line (rcirc-last-line process nick target)))
(when (and last-activity-line
(> last-activity-line 0))
@@ -1567,11 +1767,12 @@ Returns nil if the information is not recorded."
(defvar rcirc-markup-text-functions
'(rcirc-markup-attributes
+ rcirc-color-attributes
+ rcirc-remove-markup-codes
rcirc-markup-my-nick
rcirc-markup-urls
rcirc-markup-keywords
rcirc-markup-bright-nicks)
-
"List of functions used to manipulate text before it is printed.
Each function takes two arguments, SENDER, and RESPONSE. The
@@ -1581,7 +1782,8 @@ at the beginning of the `rcirc-text' propertized text.")
(defun rcirc-print (process sender response target text &optional activity)
"Print TEXT in the buffer associated with TARGET.
Format based on SENDER and RESPONSE. If ACTIVITY is non-nil,
-record activity."
+record activity. PROCESS is the process object for the current
+connection."
(or text (setq text ""))
(unless (and (or (member sender rcirc-ignore-list)
(member (with-syntax-table rcirc-nick-syntax-table
@@ -1591,11 +1793,13 @@ record activity."
;; do not ignore if we sent the message
(not (string= sender (rcirc-nick process))))
(let* ((buffer (rcirc-target-buffer process sender response target text))
+ (time (if-let ((time (rcirc-get-tag "time")))
+ (parse-iso8601-time-string time)
+ (current-time)))
(inhibit-read-only t))
(with-current-buffer buffer
(let ((moving (= (point) rcirc-prompt-end-marker))
- (old-point (point-marker))
- (fill-start (marker-position rcirc-prompt-start-marker)))
+ (old-point (point-marker)))
(setq text (decode-coding-string text rcirc-decode-coding-system))
(unless (string= sender (rcirc-nick process))
@@ -1609,25 +1813,32 @@ record activity."
;; temporarily set the marker insertion-type because
;; insert-before-markers results in hidden text in new buffers
(goto-char rcirc-prompt-start-marker)
+ (catch 'exit
+ (while (not (bobp))
+ (goto-char (or (previous-single-property-change (point) 'hard)
+ (point-min)))
+ (when (let ((then (get-text-property (point) 'rcirc-time)))
+ (and then (not (time-less-p time then))))
+ (next-single-property-change (point) 'hard)
+ (forward-char 1)
+ (throw 'exit nil))))
(set-marker-insertion-type rcirc-prompt-start-marker t)
(set-marker-insertion-type rcirc-prompt-end-marker t)
- (let ((start (point)))
- (insert (rcirc-format-response-string process sender response nil
- text)
- (propertize "\n" 'hard t))
-
- ;; squeeze spaces out of text before rcirc-text
- (fill-region fill-start
- (1- (or (next-single-property-change fill-start
- 'rcirc-text)
- rcirc-prompt-end-marker)))
-
- ;; run markup functions
- (save-excursion
- (save-restriction
- (narrow-to-region start rcirc-prompt-start-marker)
- (goto-char (or (next-single-property-change start 'rcirc-text)
+ ;; run markup functions
+ (cl-assert (bolp))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert (propertize (rcirc-format-response-string process sender
response
+ nil text)
+ 'rcirc-msgid (rcirc-get-tag "msgid"))
+ (propertize "\n" 'hard t))
+
+ ;; squeeze spaces out of text before rcirc-text
+ (fill-region (point-min) (point-max))
+
+ (goto-char (or (next-single-property-change (point-min)
'rcirc-text)
(point)))
(when (rcirc-buffer-process)
(save-excursion (rcirc-markup-timestamp sender response))
@@ -1638,14 +1849,21 @@ record activity."
(when rcirc-read-only-flag
(add-text-properties (point-min) (point-max)
- '(read-only t front-sticky t))))
- ;; make text omittable
+ '(read-only t front-sticky t)))
+
+ (add-text-properties (point-min) (point-max)
+ (list 'rcirc-time time))
+
+ ;; make text omittable
(let ((last-activity-lines (rcirc-elapsed-lines process sender
target)))
(if (and (not (string= (rcirc-nick process) sender))
- (member response rcirc-omit-responses)
+ (or (member response rcirc-omit-responses)
+ (if (member response rcirc-omit-after-reconnect)
+ rcirc-reconncting
+ (setq rcirc-reconncting nil)))
(or (not last-activity-lines)
(< rcirc-omit-threshold last-activity-lines)))
- (put-text-property (1- start) (1- rcirc-prompt-start-marker)
+ (put-text-property (point-min) (point-max)
'invisible 'rcirc-omit)
;; otherwise increment the line count
(setq rcirc-current-line (1+ rcirc-current-line))))))
@@ -1667,11 +1885,11 @@ record activity."
(window-buffer w))
(>= (window-point w)
rcirc-prompt-end-marker))
- (set-window-point w (point-max))))
+ (set-window-point w (point-max))))
nil t)
;; restore the point
- (goto-char (if moving rcirc-prompt-end-marker old-point))
+ (goto-char (if moving rcirc-prompt-end-marker old-point)))
;; keep window on bottom line if it was already there
(when rcirc-scroll-show-maximum-output
@@ -1688,28 +1906,29 @@ record activity."
;; flush undo (can we do something smarter here?)
(buffer-disable-undo)
- (buffer-enable-undo))
-
- ;; record mode line activity
- (when (and activity
- (not rcirc-ignore-buffer-activity-flag)
- (not (and rcirc-dim-nicks sender
- (string-match (regexp-opt rcirc-dim-nicks) sender)
- (rcirc-channel-p target))))
- (rcirc-record-activity (current-buffer)
- (when (not (rcirc-channel-p rcirc-target))
- 'nick)))
-
- (when (and rcirc-log-flag
- (or target
- rcirc-log-process-buffers))
- (rcirc-log process sender response target text))
-
- (sit-for 0) ; displayed text before hook
- (run-hook-with-args 'rcirc-print-functions
- process sender response target text)))))
+ (buffer-enable-undo)
+
+ ;; record mode line activity
+ (when (and activity
+ (not rcirc-ignore-buffer-activity-flag)
+ (not (and rcirc-dim-nicks sender
+ (string-match (regexp-opt rcirc-dim-nicks) sender)
+ (rcirc-channel-p target))))
+ (rcirc-record-activity (current-buffer)
+ (when (not (rcirc-channel-p rcirc-target))
+ 'nick)))
+
+ (when (and rcirc-log-flag
+ (or target
+ rcirc-log-process-buffers))
+ (rcirc-log process sender response target text))
+
+ (sit-for 0) ; displayed text before hook
+ (run-hook-with-args 'rcirc-print-functions
+ process sender response target text)))))
(defun rcirc-generate-log-filename (process target)
+ "Return filename for log file based on PROCESS and TARGET."
(if target
(rcirc-generate-new-buffer-name process target)
(process-name process)))
@@ -1731,11 +1950,15 @@ guarantee valid filenames for the current OS."
:type 'function)
(defun rcirc-log (process sender response target text)
- "Record line in `rcirc-log', to be later written to disk."
- (let ((filename (funcall rcirc-log-filename-function process target)))
+ "Record TEXT from SENDER to TARGET to be logged.
+The message is logged in `rcirc-log', and is later written to
+disk. PROCESS is the process object for the current connection."
+ (let ((filename (funcall rcirc-log-filename-function process target))
+ (time (and-let* ((time (rcirc-get-tag "time")))
+ (parse-iso8601-time-string time))))
(unless (null filename)
(let ((cell (assoc-string filename rcirc-log-alist))
- (line (concat (format-time-string rcirc-time-format)
+ (line (concat (format-time-string rcirc-time-format time)
(substring-no-properties
(rcirc-format-response-string process sender
response target text))
@@ -1770,14 +1993,17 @@ log-files with absolute names (see
`rcirc-log-filename-function')."
rcirc-log-directory)))
(defun rcirc-join-channels (process channels)
- "Join CHANNELS."
+ "Join CHANNELS.
+PROCESS is the process object for the current connection."
(save-window-excursion
(dolist (channel channels)
(with-rcirc-process-buffer process
(rcirc-cmd-join channel process)))))
;;; nick management
-(defvar rcirc-nick-prefix-chars "~&@%+")
+(defvar rcirc-nick-prefix-chars '(?~ ?& ?@ ?% ?+)
+ "List of junk characters to strip from nick prefixes.")
+
(defun rcirc-user-nick (user)
"Return the nick from USER. Remove any non-nick junk."
(save-match-data
@@ -1787,7 +2013,8 @@ log-files with absolute names (see
`rcirc-log-filename-function')."
user)))
(defun rcirc-nick-channels (process nick)
- "Return list of channels for NICK."
+ "Return list of channels for NICK.
+PROCESS is the process object for the current connection."
(with-rcirc-process-buffer process
(mapcar (lambda (x) (car x))
(gethash nick rcirc-nick-table))))
@@ -1797,7 +2024,7 @@ log-files with absolute names (see
`rcirc-log-filename-function')."
Update the associated linestamp if LINE is non-nil.
If the record doesn't exist, and LINE is nil, set the linestamp
-to zero."
+to zero. PROCESS is the process object for the current connection."
(let ((nick (rcirc-user-nick nick)))
(with-rcirc-process-buffer process
(let* ((chans (gethash nick rcirc-nick-table))
@@ -1809,12 +2036,14 @@ to zero."
rcirc-nick-table))))))
(defun rcirc-nick-remove (process nick)
- "Remove NICK from table."
+ "Remove NICK from table.
+PROCESS is the process object for the current connection."
(with-rcirc-process-buffer process
(remhash nick rcirc-nick-table)))
(defun rcirc-remove-nick-channel (process nick channel)
- "Remove the CHANNEL from list associated with NICK."
+ "Remove the CHANNEL from list associated with NICK.
+PROCESS is the process object for the current connection."
(with-rcirc-process-buffer process
(let* ((chans (gethash nick rcirc-nick-table))
(newchans
@@ -1828,7 +2057,8 @@ to zero."
(remhash nick rcirc-nick-table)))))
(defun rcirc-channel-nicks (process target)
- "Return the list of nicks associated with TARGET sorted by last activity."
+ "Return the list of nicks associated with TARGET sorted by last activity.
+PROCESS is the process object for the current connection."
(when target
(if (rcirc-channel-p target)
(with-rcirc-process-buffer process
@@ -1847,8 +2077,9 @@ to zero."
(list target))))
(defun rcirc-ignore-update-automatic (nick)
- "Remove NICK from `rcirc-ignore-list'
-if NICK is also on `rcirc-ignore-list-automatic'."
+ "Check if NICK is in `rcirc-ignore-list-automatic'.
+If so, remove from `rcirc-ignore-list'. PROCESS is the process
+object for the current connection."
(when (member nick rcirc-ignore-list-automatic)
(setq rcirc-ignore-list-automatic
(delete nick rcirc-ignore-list-automatic)
@@ -1856,7 +2087,7 @@ if NICK is also on `rcirc-ignore-list-automatic'."
(delete nick rcirc-ignore-list))))
(defun rcirc-nickname< (s1 s2)
- "Return t if IRC nickname S1 is less than S2, and nil otherwise.
+ "Return non-nil if IRC nickname S1 is less than S2, and nil otherwise.
Operator nicknames (@) are considered less than voiced
nicknames (+). Any other nicknames are greater than voiced
nicknames. The comparison is case-insensitive."
@@ -1878,7 +2109,7 @@ INPUT is a string containing nicknames separated by SEP.
This function does not alter the INPUT string."
(let* ((parts (split-string input sep t))
(sorted (sort parts 'rcirc-nickname<)))
- (mapconcat 'identity sorted sep)))
+ (mapconcat rcirc-nick-filter sorted sep)))
;;; activity tracking
(defvar rcirc-track-minor-mode-map
@@ -1906,12 +2137,8 @@ This function does not alter the INPUT string."
(remove-hook 'window-configuration-change-hook
'rcirc-window-configuration-change)))
-(or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist)
- (setq minor-mode-alist
- (cons '(rcirc-ignore-buffer-activity-flag " Ignore")
minor-mode-alist)))
-(or (assq 'rcirc-low-priority-flag minor-mode-alist)
- (setq minor-mode-alist
- (cons '(rcirc-low-priority-flag " LowPri") minor-mode-alist)))
+(add-to-list 'minor-mode-alist '(rcirc-ignore-buffer-activity-flag " Ignore"))
+(add-to-list 'minor-mode-alist '(rcirc-low-priority-flag " LowPri"))
(defun rcirc-toggle-ignore-buffer-activity ()
"Toggle the value of `rcirc-ignore-buffer-activity-flag'."
@@ -1936,9 +2163,7 @@ This function does not alter the INPUT string."
(defun rcirc-switch-to-server-buffer ()
"Switch to the server buffer associated with current channel buffer."
(interactive)
- (unless (buffer-live-p rcirc-server-buffer)
- (error "No such buffer"))
- (switch-to-buffer rcirc-server-buffer))
+ (switch-to-buffer (with-rcirc-server-buffer (current-buffer))))
(defun rcirc-jump-to-first-unread-line ()
"Move the point to the first unread line in this buffer."
@@ -1974,7 +2199,8 @@ With prefix ARG, go to the next low priority buffer with
activity."
(concat
" Type C-u " (key-description (this-command-keys))
" for low priority activity.")
- "")))))
+ ""))))
+ (rcirc-update-activity-string))
(define-obsolete-variable-alias 'rcirc-activity-hooks
'rcirc-activity-functions "24.3")
@@ -2030,7 +2256,6 @@ activity. Only run if the buffer is not visible and
(defvar rcirc-update-activity-string-hook nil
"Hook run whenever the activity string is updated.")
-;; TODO: add mouse properties
(defun rcirc-update-activity-string ()
"Update mode-line string."
(let* ((pair (rcirc-split-activity rcirc-activity))
@@ -2049,19 +2274,26 @@ activity. Only run if the buffer is not visible and
((not (null (rcirc-process-list)))
"[]")
(t "[]")))
- (run-hooks 'rcirc-update-activity-string-hook)))
+ (run-hooks 'rcirc-update-activity-string-hook)
+ (force-mode-line-update t)))
(defun rcirc-activity-string (buffers)
+ "Generate activity string for all BUFFERS."
(mapconcat (lambda (b)
(let ((s (substring-no-properties (rcirc-short-buffer-name b))))
(with-current-buffer b
(dolist (type rcirc-activity-types)
- (rcirc-add-face 0 (length s)
- (cl-case type
+ (rcirc-facify s (cl-case type
(nick 'rcirc-track-nick)
- (keyword 'rcirc-track-keyword))
- s)))
- s))
+ (keyword 'rcirc-track-keyword)))))
+ (let ((map (make-mode-line-mouse-map
+ 'mouse-1
+ (lambda ()
+ (interactive)
+ (pop-to-buffer b)))))
+ (propertize s
+ 'mouse-face 'mode-line-highlight
+ 'local-map map))))
buffers ","))
(defun rcirc-short-buffer-name (buffer)
@@ -2070,7 +2302,7 @@ activity. Only run if the buffer is not visible and
(or rcirc-short-buffer-name (buffer-name))))
(defun rcirc-visible-buffers ()
- "Return a list of the visible buffers that are in rcirc-mode."
+ "Return a list of the visible buffers that are in `rcirc-mode'."
(let (acc)
(walk-windows (lambda (w)
(with-current-buffer (window-buffer w)
@@ -2078,13 +2310,16 @@ activity. Only run if the buffer is not visible and
(push (current-buffer) acc)))))
acc))
-(defvar rcirc-visible-buffers nil)
+(defvar rcirc-visible-buffers nil
+ "List of visible IRC buffers.")
+
(defun rcirc-window-configuration-change ()
+ "Clear activity and overlay arrows, unless minibuffer is active."
(unless (minibuffer-window-active-p (minibuffer-window))
(rcirc-window-configuration-change-1)))
(defun rcirc-window-configuration-change-1 ()
- ;; clear activity and overlay arrows
+ "Clear activity and overlay arrows."
(let* ((old-activity rcirc-activity)
(hidden-buffers rcirc-visible-buffers))
@@ -2110,6 +2345,7 @@ activity. Only run if the buffer is not visible and
;;; buffer name abbreviation
(defun rcirc-update-short-buffer-names ()
+ "Update variable `rcirc-short-buffer-name' for IRC buffers."
(let ((bufalist
(apply 'append (mapcar (lambda (process)
(with-rcirc-process-buffer process
@@ -2121,10 +2357,15 @@ activity. Only run if the buffer is not visible and
(setq rcirc-short-buffer-name (car i)))))))
(defun rcirc-abbreviate (pairs)
+ "Generate alist of abbreviated buffer names to buffers.
+PAIRS is the concatenated value of all `rcirc-buffer-alist'
+values, from each process."
(apply 'append (mapcar 'rcirc-rebuild-tree (rcirc-make-trees pairs))))
-(defun rcirc-rebuild-tree (tree &optional acc)
- (let ((ch (char-to-string (car tree))))
+(defun rcirc-rebuild-tree (tree)
+ "Merge prefix TREE into alist of unique prefixes to buffers."
+ (let ((ch (char-to-string (car tree)))
+ acc)
(dolist (x (cdr tree))
(if (listp x)
(setq acc (append acc
@@ -2136,6 +2377,12 @@ activity. Only run if the buffer is not visible and
acc))
(defun rcirc-make-trees (pairs)
+ "Generate tree prefix tree of buffer names.
+PAIRS is a list of (TARGET . BUFFER) entries. The resulting tree
+is a list of (CHAR . CHILDREN) cons-cells, where CHAR is the
+leading character and CHILDREN is either BUFFER when a unique
+prefix could be found or another tree if it shares the same
+prefix with another element in PAIRS."
(let (alist)
(mapc (lambda (pair)
(if (consp pair)
@@ -2168,50 +2415,85 @@ activity. Only run if the buffer is not visible and
;; the current buffer/channel/user, and ARGS, which is a string
;; containing the text following the /cmd.
-(defmacro defun-rcirc-command (command argument docstring interactive-form
- &rest body)
- "Define a command."
- `(progn
- (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command)))
- (defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
- (,@argument &optional process target)
- ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values
given"
- "\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
- ,interactive-form
- (let ((process (or process (rcirc-buffer-process)))
- (target (or target rcirc-target)))
- (ignore target) ; mark `target' variable as ignorable
- ,@body))))
-
-(defun-rcirc-command msg (message)
- "Send private MESSAGE to TARGET."
- (interactive "i")
- (if (null message)
- (progn
- (setq target (completing-read "Message nick: "
+(defmacro rcirc-define-command (command arguments &rest body)
+ "Define a new client COMMAND in BODY that takes ARGUMENTS.
+ARGUMENTS may designate optional arguments using a single
+`&optional' symbol. Just like `defun', a string at the beginning
+of BODY is interpreted as the documentation string. Following
+that, an interactive form can specified."
+ (declare (debug (symbolp (&rest symbolp) def-body))
+ (indent defun))
+ (cl-check-type command symbol)
+ (cl-check-type arguments list)
+ (let* ((fn-name (intern (concat "rcirc-cmd-" (symbol-name command))))
+ (total (length (remq '&optional arguments)))
+ (required (- (length arguments) (length (memq '&optional arguments))))
+ (optional (- total required))
+ (regexp (with-temp-buffer
+ (insert "\\`")
+ (when arguments
+ (dotimes (_ (1- (length arguments)))
+ (insert "\\(?:\\(.+?\\)[[:space:]]+"))
+ (dotimes (i (1- (length arguments)))
+ (if (< i optional)
+ (insert "\\)?")
+ (insert "\\)"))))
+ (insert "\\(.*?\\)")
+ (insert "[[:space:]]*\\'")
+ (buffer-string)))
+ (argument (gensym))
+ documentation
+ interactive-spec)
+ (when (stringp (car body))
+ (setq documentation (pop body)))
+ (when (eq (car-safe (car-safe body)) 'interactive)
+ (setq interactive-spec (cdr (pop body))))
+ `(progn
+ (defun ,fn-name (,argument &optional process target)
+ ,(concat documentation
+ "\n\nNote: If PROCESS or TARGET are nil, the values given"
+ "\nby `rcirc-buffer-process' and `rcirc-target' will be
used.")
+ (interactive (list ,@interactive-spec))
+ (unless (if (listp ,argument)
+ (<= ,required (length ,argument) ,total)
+ (string-match ,regexp ,argument))
+ (user-error "Malformed input (%s): %S" ',command ',argument))
+ (let ((process (or process (rcirc-buffer-process)))
+ (target (or target rcirc-target)))
+ (ignore target process)
+ (let (,@(cl-loop
+ for i from 0 for arg in (delq '&optional arguments)
+ collect `(,arg (if (listp ,argument)
+ (nth ,i ,argument)
+ (match-string ,(1+ i) ,argument)))))
+ ,@body)))
+ (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name
command))))))
+
+(define-obsolete-function-alias
+ 'defun-rcirc-command
+ 'rcirc-define-command
+ "28.1")
+
+(rcirc-define-command msg (chan-or-nick message)
+ "Send MESSAGE to CHAN-OR-NICK."
+ (interactive (list (completing-read "Message nick: "
(with-rcirc-server-buffer
- rcirc-nick-table)))
- (when (> (length target) 0)
- (setq message (read-string (format "Message %s: " target)))
- (when (> (length message) 0)
- (rcirc-send-message process target message))))
- (if (not (string-match "\\([^ ]+\\) \\(.+\\)" message))
- (message "Not enough args, or something.")
- (setq target (match-string 1 message)
- message (match-string 2 message))
- (rcirc-send-message process target message))))
-
-(defun-rcirc-command query (nick)
+ rcirc-nick-table))
+ (read-string "Message: ")))
+ (rcirc-send-message process chan-or-nick message))
+
+(rcirc-define-command query (nick)
"Open a private chat buffer to NICK."
(interactive (list (completing-read "Query nick: "
- (with-rcirc-server-buffer
rcirc-nick-table))))
+ (with-rcirc-server-buffer
+ rcirc-nick-table))))
(let ((existing-buffer (rcirc-get-buffer process nick)))
(switch-to-buffer (or existing-buffer
(rcirc-get-buffer-create process nick)))
(when (not existing-buffer)
(rcirc-cmd-whois nick))))
-(defun-rcirc-command join (channels)
+(rcirc-define-command join (channels)
"Join CHANNELS.
CHANNELS is a comma- or space-separated string of channel names."
(interactive "sJoin channels: ")
@@ -2220,46 +2502,35 @@ CHANNELS is a comma- or space-separated string of
channel names."
(rcirc-get-buffer-create process ch))
split-channels))
(channels (mapconcat 'identity split-channels ",")))
- (rcirc-send-string process (concat "JOIN " channels))
+ (rcirc-send-string process "JOIN" channels)
(when (not (eq (selected-window) (minibuffer-window)))
(dolist (b buffers) ;; order the new channel buffers in the buffer list
(switch-to-buffer b)))))
-(defun-rcirc-command invite (nick-channel)
+(rcirc-define-command invite (nick channel)
"Invite NICK to CHANNEL."
(interactive (list
- (concat
- (completing-read "Invite nick: "
- (with-rcirc-server-buffer rcirc-nick-table))
- " "
- (read-string "Channel: "))))
- (rcirc-send-string process (concat "INVITE " nick-channel)))
-
-(defun-rcirc-command part (channel)
+ (completing-read "Invite nick: "
+ (with-rcirc-server-buffer rcirc-nick-table))
+ (read-string "Channel: ")))
+ (rcirc-send-string process "INVITE" nick channel))
+
+(rcirc-define-command part (&optional channel reason)
"Part CHANNEL.
CHANNEL should be a string of the form \"#CHANNEL-NAME REASON\".
If omitted, CHANNEL-NAME defaults to TARGET, and REASON defaults
to `rcirc-default-part-reason'."
- (interactive "sPart channel: ")
- (let ((channel (if (> (length channel) 0) channel target))
- (msg rcirc-default-part-reason))
- (when (string-match "\\`\\([&#+!]\\S-+\\)?\\s-*\\(.+\\)?\\'" channel)
- (when (match-beginning 2)
- (setq msg (match-string 2 channel)))
- (setq channel (if (match-beginning 1)
- (match-string 1 channel)
- target)))
- (rcirc-send-string process (concat "PART " channel " :" msg))))
-
-(defun-rcirc-command quit (reason)
+ (interactive "sPart channel: \nsReason: ")
+ (rcirc-send-string process "PART" (or channel target)
+ : (or reason rcirc-default-part-reason)))
+
+(rcirc-define-command quit (&optional reason)
"Send a quit message to server with REASON."
(interactive "sQuit reason: ")
- (rcirc-send-string process (concat "QUIT :"
- (if (not (zerop (length reason)))
- reason
- rcirc-default-quit-reason))))
+ (rcirc-send-string process "QUIT"
+ : (or reason rcirc-default-quit-reason)))
-(defun-rcirc-command reconnect (_)
+(rcirc-define-command reconnect ()
"Reconnect to current server."
(interactive "i")
(with-rcirc-server-buffer
@@ -2270,79 +2541,73 @@ to `rcirc-default-part-reason'."
(setf (nth 5 conn-info)
(cl-remove-if-not #'rcirc-channel-p
(mapcar #'car rcirc-buffer-alist)))
+ (dolist (buf (nth 5 conn-info))
+ (with-current-buffer (cdr (assoc buf rcirc-buffer-alist))
+ (setq rcirc-reconncting t)))
(apply #'rcirc-connect conn-info))))))
-(defun-rcirc-command nick (nick)
+(rcirc-define-command nick (nick)
"Change nick to NICK."
- (interactive "i")
- (when (null nick)
- (setq nick (read-string "New nick: " (rcirc-nick process))))
- (rcirc-send-string process (concat "NICK " nick)))
+ (interactive (list (read-string "New nick: ")))
+ (rcirc-send-string process "NICK" nick))
-(defun-rcirc-command names (channel)
+(rcirc-define-command names (&optional channel)
"Display list of names in CHANNEL or in current channel if CHANNEL is nil.
If called interactively, prompt for a channel when prefix arg is supplied."
- (interactive "P")
- (if (called-interactively-p 'interactive)
- (if channel
- (setq channel (read-string "List names in channel: " target))))
- (let ((channel (if (> (length channel) 0)
- channel
- target)))
- (rcirc-send-string process (concat "NAMES " channel))))
-
-(defun-rcirc-command topic (topic)
+ (interactive (list (and current-prefix-arg
+ (read-string "List names in channel: "))))
+ (rcirc-send-string process "NAMES" (or channel target)))
+
+(rcirc-define-command topic (topic)
"List TOPIC for the TARGET channel.
With a prefix arg, prompt for new topic."
- (interactive "P")
- (if (and (called-interactively-p 'interactive) topic)
- (setq topic (read-string "New Topic: " rcirc-topic)))
- (rcirc-send-string process (concat "TOPIC " target
- (when (> (length topic) 0)
- (concat " :" topic)))))
+ (interactive (list (and current-prefix-arg
+ (read-string "List names in channel: "))))
+ (if (> (length topic) 0)
+ (rcirc-send-string process "TOPIC" : topic)
+ (rcirc-send-string process "TOPIC")))
-(defun-rcirc-command whois (nick)
+(rcirc-define-command whois (nick)
"Request information from server about NICK."
- (interactive (list
- (completing-read "Whois: "
- (with-rcirc-server-buffer rcirc-nick-table))))
- (rcirc-send-string process (concat "WHOIS " nick)))
-
-(defun-rcirc-command mode (args)
- "Set mode with ARGS."
- (interactive (list (concat (read-string "Mode nick or channel: ")
- " " (read-string "Mode: "))))
- (rcirc-send-string process (concat "MODE " args)))
-
-(defun-rcirc-command list (channels)
+ (interactive (list (completing-read
+ "Whois: "
+ (with-rcirc-server-buffer rcirc-nick-table))))
+ (rcirc-send-string process "WHOIS" nick))
+
+(rcirc-define-command mode (nick-or-chan mode)
+ "Set NICK-OR-CHAN mode to MODE."
+ (interactive (list (read-string "Mode nick or channel: ")
+ (read-string "Mode: ")))
+ (rcirc-send-string process "MODE" nick-or-chan mode))
+
+(rcirc-define-command list (channels)
"Request information on CHANNELS from server."
(interactive "sList Channels: ")
- (rcirc-send-string process (concat "LIST " channels)))
+ (rcirc-send-string process "LIST" channels))
-(defun-rcirc-command oper (args)
+(rcirc-define-command oper (args)
"Send operator command to server."
(interactive "sOper args: ")
- (rcirc-send-string process (concat "OPER " args)))
+ (rcirc-send-string process "OPER" args))
-(defun-rcirc-command quote (message)
+(rcirc-define-command quote (message)
"Send MESSAGE literally to server."
(interactive "sServer message: ")
(rcirc-send-string process message))
-(defun-rcirc-command kick (arg)
+(rcirc-define-command kick (nick reason)
"Kick NICK from current channel."
(interactive (list
- (concat (completing-read "Kick nick: "
- (rcirc-channel-nicks
- (rcirc-buffer-process)
- rcirc-target))
- (read-from-minibuffer "Kick reason: "))))
- (let* ((arglist (split-string arg))
- (argstring (concat (car arglist) " :"
- (mapconcat 'identity (cdr arglist) " "))))
- (rcirc-send-string process (concat "KICK " target " " argstring))))
+ (completing-read "Kick nick: "
+ (rcirc-channel-nicks
+ (rcirc-buffer-process)
+ rcirc-target))
+ (read-from-minibuffer "Kick reason: ")))
+ (rcirc-send-string process "KICK" target nick : reason))
(defun rcirc-cmd-ctcp (args &optional process _target)
+ "Handle ARGS as a CTCP command.
+PROCESS is the process object for the current connection."
(if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args)
(let* ((target (match-string 1 args))
(request (upcase (match-string 2 args)))
@@ -2354,14 +2619,18 @@ With a prefix arg, prompt for new topic."
"usage: /ctcp NICK REQUEST")))
(defun rcirc-ctcp-sender-PING (process target _request)
- "Send a CTCP PING message to TARGET."
+ "Send a CTCP PING message to TARGET.
+PROCESS is the process object for the current connection."
(let ((timestamp (format-time-string "%s")))
(rcirc-send-ctcp process target "PING" timestamp)))
(defun rcirc-cmd-me (args process target)
+ "Send an action message ARGS to TARGET.
+PROCESS is the process object for the current connection."
(when target (rcirc-send-ctcp process target "ACTION" args)))
(defun rcirc-add-or-remove (set &rest elements)
+ "Toggle membership of ELEMENTS in SET."
(dolist (elt elements)
(if (and elt (not (string= "" elt)))
(setq set (if (member-ignore-case elt set)
@@ -2369,7 +2638,8 @@ With a prefix arg, prompt for new topic."
(cons elt set)))))
set)
-(defun-rcirc-command ignore (nick)
+
+(rcirc-define-command ignore (nick)
"Manage the ignore list.
Ignore NICK, unignore NICK if already ignored, or list ignored
nicks when no NICK is given. When listing ignored nicks, the
@@ -2386,7 +2656,7 @@ ones added to the list automatically are marked with an
asterisk."
"*" "")))
rcirc-ignore-list " ")))
-(defun-rcirc-command bright (nick)
+(rcirc-define-command bright (nick)
"Manage the bright nick list."
(interactive "sToggle emphasis of nick: ")
(setq rcirc-bright-nicks
@@ -2395,7 +2665,7 @@ ones added to the list automatically are marked with an
asterisk."
(rcirc-print process nil "BRIGHT" target
(mapconcat 'identity rcirc-bright-nicks " ")))
-(defun-rcirc-command dim (nick)
+(rcirc-define-command dim (nick)
"Manage the dim nick list."
(interactive "sToggle deemphasis of nick: ")
(setq rcirc-dim-nicks
@@ -2404,7 +2674,7 @@ ones added to the list automatically are marked with an
asterisk."
(rcirc-print process nil "DIM" target
(mapconcat 'identity rcirc-dim-nicks " ")))
-(defun-rcirc-command keyword (keyword)
+(rcirc-define-command keyword (keyword)
"Manage the keyword list.
Mark KEYWORD, unmark KEYWORD if already marked, or list marked
keywords when no KEYWORD is given."
@@ -2479,28 +2749,85 @@ If ARG is given, opens the URL in a new browser window."
arg)))
(defun rcirc-markup-timestamp (_sender _response)
+ "Insert a timestamp."
(goto-char (point-min))
- (insert (rcirc-facify (format-time-string rcirc-time-format)
- 'rcirc-timestamp)))
+ (let ((time (and-let* ((time (rcirc-get-tag "time")))
+ (parse-iso8601-time-string time))))
+ (insert (rcirc-facify (format-time-string rcirc-time-format time)
+ 'rcirc-timestamp))))
(defun rcirc-markup-attributes (_sender _response)
- (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t)
+ "Highlight IRC markup, indicated by ASCII control codes."
+ (while (re-search-forward
+ (rx (group (or #x02 #x1d #x1f #x1e #x11))
+ (*? nonl)
+ (group (or (backref 1) (+ #x0f) eol)))
+ nil t)
(rcirc-add-face (match-beginning 0) (match-end 0)
- (cl-case (char-after (match-beginning 1))
- (?\C-b 'bold)
- (?\C-v 'italic)
- (?\C-_ 'underline)))
- ;; keep the ^O since it could terminate other attributes
- (when (not (eq ?\C-o (char-before (match-end 2))))
- (delete-region (match-beginning 2) (match-end 2)))
- (delete-region (match-beginning 1) (match-end 1))
- (goto-char (match-beginning 1)))
- ;; remove the ^O characters now
- (goto-char (point-min))
- (while (re-search-forward "\C-o+" nil t)
+ (cl-case (char-after (match-beginning 0))
+ (#x02 'bold)
+ (#x1d 'italic)
+ (#x1f 'underline)
+ (#x1e '(:strike-through t))
+ (#x11 'rcirc-monospace-text)))
+ (goto-char (1+ (match-beginning 0)))))
+
+(defconst rcirc-color-codes
+ ;; Taken from https://modern.ircdocs.horse/formatting.html
+ ["white" "black" "blue" "green" "red" "brown" "magenta"
+ "orange" "yellow" "light green" "cyan" "light cyan"
+ "light blue" "pink" "grey" "light grey"
+ "#470000" "#472100" "#474700" "#324700" "#004700" "#00472c"
+ "#004747" "#002747" "#000047" "#2e0047" "#470047" "#47002a"
+ "#740000" "#743a00" "#747400" "#517400" "#007400" "#007449"
+ "#007474" "#004074" "#000074" "#4b0074" "#740074" "#740045"
+ "#b50000" "#b56300" "#b5b500" "#7db500" "#00b500" "#00b571"
+ "#00b5b5" "#0063b5" "#0000b5" "#7500b5" "#b500b5" "#b5006b"
+ "#ff0000" "#ff8c00" "#ffff00" "#b2ff00" "#00ff00" "#00ffa0"
+ "#00ffff" "#008cff" "#0000ff" "#a500ff" "#ff00ff" "#ff0098"
+ "#ff5959" "#ffb459" "#ffff71" "#cfff60" "#6fff6f" "#65ffc9"
+ "#6dffff" "#59b4ff" "#5959ff" "#c459ff" "#ff66ff" "#ff59bc"
+ "#ff9c9c" "#ffd39c" "#ffff9c" "#e2ff9c" "#9cff9c" "#9cffdb"
+ "#9cffff" "#9cd3ff" "#9c9cff" "#dc9cff" "#ff9cff" "#ff94d3"
+ "#000000" "#131313" "#282828" "#363636" "#4d4d4d" "#656565"
+ "#818181" "#9f9f9f" "#bcbcbc" "#e2e2e2" "#ffffff"]
+ "Vector of colors for each IRC color code.")
+
+(defun rcirc-color-attributes (_sender _response)
+ "Highlight IRC color-codes, indicated by ASCII control codes."
+ (while (re-search-forward
+ (rx #x03
+ (? (group (= 2 digit)) (? "," (group (= 2 digit))))
+ (*? nonl)
+ (or #x03 #x0f eol))
+ nil t)
+ (let (foreground background)
+ (when-let ((fg-raw (match-string 1))
+ (fg (string-to-number fg-raw))
+ ((<= 0 fg (1- (length rcirc-color-codes)))))
+ (setq foreground (aref rcirc-color-codes fg)))
+ (when-let ((bg-raw (match-string 2))
+ (bg (string-to-number bg-raw))
+ ((<= 0 bg (1- (length rcirc-color-codes)))))
+ (setq background (aref rcirc-color-codes bg)))
+ (rcirc-add-face (match-beginning 0) (match-end 0)
+ `(face (:foreground
+ ,foreground
+ :background
+ ,background))))))
+
+(defun rcirc-remove-markup-codes (_sender _response)
+ "Remove ASCII control codes used to designate markup."
+ (while (re-search-forward
+ (rx (or #x02 #x1d #x1f #x1e #x11 #x0f
+ (: #x03 (? (= 2 digit) (? "," (= 2 digit))))))
+ nil t)
(delete-region (match-beginning 0) (match-end 0))))
(defun rcirc-markup-my-nick (_sender response)
+ "Highlight the users nick.
+If RESPONSE indicates that the nick was mentioned in a message,
+highlight the entire line and record the activity."
(with-syntax-table rcirc-nick-syntax-table
(while (re-search-forward (concat "\\b"
(regexp-quote (rcirc-nick
@@ -2515,6 +2842,7 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-record-activity (current-buffer) 'nick)))))
(defun rcirc-markup-urls (_sender _response)
+ "Highlight and activate URLs."
(while (and rcirc-url-regexp ; nil means disable URL catching.
(re-search-forward rcirc-url-regexp nil t))
(let* ((start (match-beginning 0))
@@ -2538,6 +2866,10 @@ If ARG is given, opens the URL in a new browser window."
(push (cons url start) rcirc-urls)))))
(defun rcirc-markup-keywords (sender response)
+ "Highlight keywords as specified by `rcirc-keywords'.
+Keywords are only highlighted in messages (as indicated by
+RESPONSE) when they were not written by the user (as indicated by
+SENDER)."
(when (and (string= response "PRIVMSG")
(not (string= sender (rcirc-nick (rcirc-buffer-process)))))
(let* ((target (or rcirc-target ""))
@@ -2552,6 +2884,9 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-record-activity (current-buffer) 'keyword))))))
(defun rcirc-markup-bright-nicks (_sender response)
+ "Highlight nicks brightly as specified by `rcirc-bright-nicks'.
+This highlighting only takes place in name lists (as indicated by
+RESPONSE)."
(when (and rcirc-bright-nicks
(string= response "NAMES"))
(with-syntax-table rcirc-nick-syntax-table
@@ -2560,6 +2895,8 @@ If ARG is given, opens the URL in a new browser window."
'rcirc-bright-nick)))))
(defun rcirc-markup-fill (_sender response)
+ "Fill messages as configured by `rcirc-fill-column'.
+MOTD messages are not filled (as indicated by RESPONSE)."
(when (not (string= response "372")) ; /motd
(let ((fill-prefix
(or rcirc-fill-prefix
@@ -2577,8 +2914,11 @@ If ARG is given, opens the URL in a new browser window."
;; server or a user, depending on the command, the ARGS, which is a
;; list of strings, and the TEXT, which is the original server text,
;; verbatim
-(defun rcirc-handler-001 (process sender args text)
- (rcirc-handler-generic process "001" sender args text)
+(defun rcirc-handler-001 (process sender args _text)
+ "Handle welcome message.
+SENDER and ARGS are used to initialize the current connection.
+PROCESS is the process object for the current connection."
+ (rcirc-handler-generic process "001" sender args nil)
(with-rcirc-process-buffer process
(setq rcirc-connecting nil)
(rcirc-reschedule-timeout process)
@@ -2602,11 +2942,16 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-join-channels process rcirc-startup-channels))))
(defun rcirc-join-channels-post-auth (process)
- "Join `rcirc-startup-channels' after authenticating."
+ "Join `rcirc-startup-channels' after authenticating.
+PROCESS is the process object for the current connection."
(with-rcirc-process-buffer process
(rcirc-join-channels process rcirc-startup-channels)))
(defun rcirc-handler-PRIVMSG (process sender args text)
+ "Handle a (private) message from SENDER.
+ARGS should have the form (TARGET MESSAGE). TEXT is the verbatim
+message as received from the server. PROCESS is the process
+object for the current connection."
(rcirc-check-auth-status process sender args text)
(let ((target (if (rcirc-channel-p (car args))
(car args)
@@ -2620,6 +2965,10 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-put-nick-channel process sender target rcirc-current-line))))
(defun rcirc-handler-NOTICE (process sender args text)
+ "Handle a notice message from SENDER.
+ARGS should have the form (TARGET MESSAGE).
+TEXT is the verbatim message as received from the server.
+PROCESS is the process object for the current connection."
(rcirc-check-auth-status process sender args text)
(let ((target (car args))
(message (cadr args)))
@@ -2629,7 +2978,7 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-print process sender "NOTICE"
(cond ((rcirc-channel-p target)
target)
- ;;; -ChanServ- [#gnu] Welcome...
+ ;; -ChanServ- [#gnu] Welcome...
((string-match "\\[\\(#[^] ]+\\)\\]" message)
(match-string 1 message))
(sender
@@ -2641,7 +2990,9 @@ If ARG is given, opens the URL in a new browser window."
(defun rcirc-check-auth-status (process sender args _text)
"Check if the user just authenticated.
If authenticated, runs `rcirc-authenticated-hook' with PROCESS as
-the only argument."
+the only argument. ARGS should have the form (TARGET MESSAGE).
+SENDER is used the determine the authentication method. PROCESS
+is the process object for the current connection."
(with-rcirc-process-buffer process
(when (and (not rcirc-user-authenticated)
rcirc-authenticate-before-join
@@ -2671,9 +3022,17 @@ the only argument."
(remove-hook 'rcirc-authenticated-hook
'rcirc-join-channels-post-auth t))))))
(defun rcirc-handler-WALLOPS (process sender args _text)
+ "Handle WALLOPS message from SENDER.
+ARGS should have the form (MESSAGE).
+PROCESS is the process object for the current
+connection."
(rcirc-print process sender "WALLOPS" sender (car args) t))
(defun rcirc-handler-JOIN (process sender args _text)
+ "Handle JOIN message from SENDER.
+ARGS should have the form (CHANNEL).
+PROCESS is the process object for the current
+connection."
(let ((channel (car args)))
(with-current-buffer (rcirc-get-buffer-create process channel)
;; when recently rejoining, restore the linestamp
@@ -2695,6 +3054,8 @@ the only argument."
;; PART and KICK are handled the same way
(defun rcirc-handler-PART-or-KICK (process _response channel _sender nick
_args)
+ "Remove NICK from CHANNEL.
+PROCESS is the process object for the current connection."
(rcirc-ignore-update-automatic nick)
(if (not (string= nick (rcirc-nick process)))
;; this is someone else leaving
@@ -2712,6 +3073,9 @@ the only argument."
(rcirc-disconnect-buffer buffer)))))
(defun rcirc-handler-PART (process sender args _text)
+ "Handle PART message from SENDER.
+ARGS should have the form (CHANNEL REASON).
+PROCESS is the process object for the current connection."
(let* ((channel (car args))
(reason (cadr args))
(message (concat channel " " reason)))
@@ -2723,6 +3087,9 @@ the only argument."
(rcirc-handler-PART-or-KICK process "PART" channel sender sender reason)))
(defun rcirc-handler-KICK (process sender args _text)
+ "Handle PART message from SENDER.
+ARGS should have the form (CHANNEL NICK REASON).
+PROCESS is the process object for the current connection."
(let* ((channel (car args))
(nick (cadr args))
(reason (nth 2 args))
@@ -2735,7 +3102,8 @@ the only argument."
(rcirc-handler-PART-or-KICK process "KICK" channel sender nick reason)))
(defun rcirc-maybe-remember-nick-quit (process nick channel)
- "Remember NICK as leaving CHANNEL if they recently spoke."
+ "Remember NICK as leaving CHANNEL if they recently spoke.
+PROCESS is the process object for the current connection."
(let ((elapsed-lines (rcirc-elapsed-lines process nick channel)))
(when (and elapsed-lines
(< elapsed-lines rcirc-omit-threshold))
@@ -2751,6 +3119,8 @@ the only argument."
rcirc-recent-quit-alist))))))))))
(defun rcirc-handler-QUIT (process sender args _text)
+ "Handle QUIT message from SENDER.
+PROCESS is the process object for the current connection."
(rcirc-ignore-update-automatic sender)
(mapc (lambda (channel)
;; broadcast quit message each channel
@@ -2761,6 +3131,9 @@ the only argument."
(rcirc-nick-remove process sender))
(defun rcirc-handler-NICK (process sender args _text)
+ "Handle NICK message from SENDER.
+ARGS should have the form (NEW-NICK).
+PROCESS is the process object for the current connection."
(let* ((old-nick sender)
(new-nick (car args))
(channels (rcirc-nick-channels process old-nick)))
@@ -2792,21 +3165,30 @@ the only argument."
(when rcirc-auto-authenticate-flag (rcirc-authenticate))))))
(defun rcirc-handler-PING (process _sender args _text)
- (rcirc-send-string process (concat "PONG :" (car args))))
+ "Respond to a PING with a PONG.
+ARGS should have the form (MESSAGE). MESSAGE is relayed back to
+the server. PROCESS is the process object for the current
+connection."
+ (rcirc-send-string process "PONG" : (car args)))
(defun rcirc-handler-PONG (_process _sender _args _text)
- ;; do nothing
- )
+ "Ignore all incoming PONG messages.")
(defun rcirc-handler-TOPIC (process sender args _text)
+ "Note the topic change from SENDER.
+PROCESS is the process object for the current connection."
(let ((topic (cadr args)))
(rcirc-print process sender "TOPIC" (car args) topic)
(with-current-buffer (rcirc-get-buffer process (car args))
(setq rcirc-topic topic))))
-(defvar rcirc-nick-away-alist nil)
+(defvar rcirc-nick-away-alist nil
+ "Alist from nicks to away messages.")
+
(defun rcirc-handler-301 (process _sender args text)
- "RPL_AWAY"
+ "Handle away messages (RPL_AWAY).
+ARGS should have the form (NICK AWAY-MESSAGE).
+PROCESS is the process object for the current connection."
(let* ((nick (cadr args))
(rec (assoc-string nick rcirc-nick-away-alist))
(away-message (nth 2 args)))
@@ -2820,7 +3202,9 @@ the only argument."
rcirc-nick-away-alist))))))
(defun rcirc-handler-317 (process sender args _text)
- "RPL_WHOISIDLE"
+ "Handle idle messages from SENDER (RPL_WHOISIDLE).
+ARGS should have the form (NICK IDLE-SECS SIGNON-TIME).
+PROCESS is the process object for the current connection."
(let* ((nick (nth 1 args))
(idle-secs (string-to-number (nth 2 args)))
(idle-string (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs))
@@ -2831,15 +3215,20 @@ the only argument."
(rcirc-print process sender "317" nil message t)))
(defun rcirc-handler-332 (process _sender args _text)
- "RPL_TOPIC"
+ "Update topic when notified by server (RPL_TOPIC).
+ARGS should have the form (CHANNEL TOPIC).
+PROCESS is the process object for the current connection."
(let ((buffer (or (rcirc-get-buffer process (cadr args))
(rcirc-get-temp-buffer-create process (cadr args)))))
(with-current-buffer buffer
(setq rcirc-topic (nth 2 args)))))
(defun rcirc-handler-333 (process sender args _text)
- "333 says who set the topic and when.
-Not in rfc1459.txt"
+ "Update when and who set the current topic.
+ARGS has the form (CHANNEL SETTER TIME). SENDER is passed on to
+`rcirc-print'. PROCESS is the process object for the current
+connection. This is a non-standard extension, not specified in
+RFC1459."
(let ((buffer (or (rcirc-get-buffer process (cadr args))
(rcirc-get-temp-buffer-create process (cadr args)))))
(with-current-buffer buffer
@@ -2850,10 +3239,17 @@ Not in rfc1459.txt"
(format "%s (%s on %s)" rcirc-topic setter time))))))
(defun rcirc-handler-477 (process sender args _text)
- "ERR_NOCHANMODES"
+ "Notify user that CHANNEL does not support modes (ERR_NOCHANMODES).
+ARGS has the form (CHANNEL MESSAGE). SENDER is passed on to
+`rcirc-print'. PROCESS is the process object for the current
+connection."
(rcirc-print process sender "477" (cadr args) (nth 2 args)))
(defun rcirc-handler-MODE (process sender args _text)
+ "Handle MODE messages.
+ARGS should have the form (TARGET . MESSAGE-LIST).
+SENDER is passed on to `rcirc-print'.
+PROCESS is the process object for the current connection."
(let ((target (car args))
(msg (mapconcat 'identity (cdr args) " ")))
(rcirc-print process sender "MODE"
@@ -2874,7 +3270,9 @@ Not in rfc1459.txt"
(get-buffer-create tmpnam)))
(defun rcirc-handler-353 (process _sender args _text)
- "RPL_NAMREPLY"
+ "Start handling list of users (RPL_NAMREPLY).
+ARGS should have the form (TYPE CHANNEL . NICK-LIST).
+PROCESS is the process object for the current connection."
(let ((channel (nth 2 args))
(names (or (nth 3 args) "")))
(mapc (lambda (nick)
@@ -2887,7 +3285,9 @@ Not in rfc1459.txt"
(insert (car (last args)) " "))))
(defun rcirc-handler-366 (process sender args _text)
- "RPL_ENDOFNAMES"
+ "Handle end of user list (RPL_ENDOFNAMES).
+SENDER is passed on to `rcirc-print'.
+PROCESS is the process object for the current connection."
(let* ((channel (cadr args))
(buffer (rcirc-get-temp-buffer-create process channel)))
(with-current-buffer buffer
@@ -2897,7 +3297,10 @@ Not in rfc1459.txt"
(kill-buffer buffer)))
(defun rcirc-handler-433 (process sender args text)
- "ERR_NICKNAMEINUSE"
+ "Warn user that nick is used (ERR_NICKNAMEINUSE).
+ARGS should have the form (NICK CHANNEL WARNING).
+SENDER is passed on to `rcirc-handler-generic'.
+PROCESS is the process object for the current connection."
(rcirc-handler-generic process "433" sender args text)
(with-rcirc-process-buffer process
(let* ((length (string-to-number
@@ -2906,8 +3309,10 @@ Not in rfc1459.txt"
(rcirc-cmd-nick (rcirc--make-new-nick (cadr args) length) nil process))))
(defun rcirc--make-new-nick (nick length)
- ;; If we already have some ` chars at the end, then shorten the
- ;; non-` bit of the name.
+ "Attempt to create a unused nickname out of NICK.
+A new nick may at most be LENGTH characters long. If we already
+have some ` chars at the end, then shorten the non-` bit of the
+name."
(when (= (length nick) length)
(setq nick (replace-regexp-in-string "[^`]\\(`+\\)\\'" "\\1" nick)))
(concat
@@ -2917,7 +3322,14 @@ Not in rfc1459.txt"
"`"))
(defun rcirc-handler-005 (process sender args text)
- "ERR_NICKNAMEINUSE"
+ "Register supported server features (RPL_ISUPPORT).
+ARGS should be a list of string feature parameters, either of the
+form \"PARAMETER\" to enable a feature, \"PARAMETER=VALUE\" to
+configure a specific option or \"-PARAMETER\" to disable a
+previously specified feature. SENDER is passed on to
+`rcirc-handler-generic'. PROCESS is the process object for the
+current connection. Note that this is not the behaviour as
+specified in RFC2812, where 005 stood for RPL_BOUNCE."
(rcirc-handler-generic process "005" sender args text)
(with-rcirc-process-buffer process
(setq rcirc-server-parameters (append rcirc-server-parameters args))))
@@ -2963,12 +3375,37 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(format "AUTH %s %s" nick (car args))))))))))
(defun rcirc-handler-INVITE (process sender args _text)
- (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t))
+ "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))
+ (target (car args))
+ (chan (cadr args)))
+ (if (string= target self)
+ (rcirc-print process sender "INVITE" nil
+ (format "%s invited you to %s"
+ sender chan)
+ t)
+ (rcirc-print process sender "INVITE" chan
+ (format "%s invited %s"
+ sender target)
+ t))))
(defun rcirc-handler-ERROR (process sender args _text)
+ "Print a error message.
+SENDER and ARGS (in concatenated form) are passed on to
+`rcirc-print'. PROCESS is the process object for the current
+connection."
(rcirc-print process sender "ERROR" nil (mapconcat 'identity args " ")))
(defun rcirc-handler-CTCP (process target sender text)
+ "Handle Client-To-Client-Protocol message TEXT.
+The message is addressed from SENDER to TARGET. Attempt to find
+an appropriate handler, by invoicing the function
+`rcirc-handler-ctcp-REQUEST', where REQUEST is the message type
+as extracted from TEXT. If no handler was found, an error
+message will be printed. PROCESS is the process object for the
+current connection."
(if (string-match "^\\([^ ]+\\) *\\(.*\\)$" text)
(let* ((request (upcase (match-string 1 text)))
(args (match-string 2 text))
@@ -2983,31 +3420,117 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(rcirc-print process sender "CTCP" target
(format "%s" text) t))))))
-(defun rcirc-handler-ctcp-VERSION (process _target sender _args)
- (rcirc-send-string process
- (concat "NOTICE " sender
- " :\C-aVERSION " rcirc-id-string
- "\C-a")))
+(defun rcirc-handler-ctcp-VERSION (process _target sender _message)
+ "Handle a CTCP VERSION message from SENDER.
+PROCESS is the process object for the current connection."
+ (rcirc-send-string process "NOTICE" sender :
+ (rcirc-ctcp-wrap "VERSION" rcirc-id-string)))
-(defun rcirc-handler-ctcp-ACTION (process target sender args)
- (rcirc-print process sender "ACTION" target args t))
+(defun rcirc-handler-ctcp-ACTION (process target sender message)
+ "Handle a CTCP ACTION MESSAGE from SENDER to TARGET.
+PROCESS is the process object for the current connection."
+ (rcirc-print process sender "ACTION" target message t))
-(defun rcirc-handler-ctcp-TIME (process _target sender _args)
- (rcirc-send-string process
- (concat "NOTICE " sender
- " :\C-aTIME " (current-time-string) "\C-a")))
+(defun rcirc-handler-ctcp-TIME (process _target sender _message)
+ "Respond to CTCP TIME message from SENDER.
+PROCESS is the process object for the current connection."
+ (rcirc-send-string process "NOTICE" sender :
+ (rcirc-ctcp-wrap "TIME" (current-time-string))))
(defun rcirc-handler-CTCP-response (process _target sender message)
+ "Handle CTCP response MESSAGE from SENDER.
+PROCESS is the process object for the current connection."
(rcirc-print process sender "CTCP" nil message t))
+
+(defun rcirc-handler-CAP (process _sender args _text)
+ "Handle capability negotiation messages.
+ARGS should have the form (USER SUBCOMMAND . ARGUMENTS). PROCESS
+is the process object for the current connection."
+ (with-rcirc-process-buffer process
+ (let ((subcmd (cadr args)))
+ (dolist (cap (cddr args))
+ (cond ((string= subcmd "ACK")
+ (push cap rcirc-acked-capabilities)
+ (setq rcirc-requested-capabilities
+ (delete cap rcirc-requested-capabilities)))
+ ((string= subcmd "NAK")
+ (setq rcirc-requested-capabilities
+ (delete cap rcirc-requested-capabilities))))))
+ (when (and (null rcirc-requested-capabilities) rcirc-finished-sasl)
+ ;; All requested capabilities have been responded to
+ (rcirc-send-string process "CAP" "END"))))
+
+(defun rcirc-handler-TAGMSG (process sender _args _text)
+ "Handle a empty tag message from SENDER.
+PROCESS is the process object for the current connection."
+ (dolist (tag rcirc-message-tags)
+ (when-let ((handler (intern-soft (concat "rcirc-tag-handler-" (car tag))))
+ ((fboundp handler)))
+ (funcall handler process sender (cdr tag)))))
+
+(defun rcirc-handler-BATCH (process _sender args _text)
+ "Open or close a batch.
+ARGS should have the form (tag type . parameters) when starting a
+batch, or (tag) when closing a batch. PROCESS is the process
+object for the current connection."
+ (with-rcirc-process-buffer process
+ (let ((type (cadr args))
+ (id (substring (car args) 1)))
+ (cond
+ ((= (aref (car args) 0) ?+) ;start a new batch
+ (when (assoc id rcirc-batch-attributes)
+ (error "Starting batch with already used ID"))
+ (setf (alist-get id rcirc-batch-attributes nil nil #'string=)
+ (cons type (cddr args))))
+ ((= (aref (car args) 0) ?-) ;close a batch
+ (unless (assoc id rcirc-batch-attributes)
+ (error "Closing a unknown batch"))
+ (let ((type (car (alist-get id rcirc-batch-attributes
+ nil nil #'string=))))
+ (when (eq (car (alist-get type rcirc-supported-batch-types
+ nil nil #'string=))
+ 'deferred)
+ (let ((messages (alist-get id rcirc-batched-messages
+ nil nil #'string=))
+ (bhandler (intern-soft (concat "rcirc-batch-handler-"
type))))
+ (if (fboundp bhandler)
+ (funcall bhandler process id (nreverse messages))
+ (dolist (message (nreverse messages))
+ (let ((cmd (nth 0 message))
+ (process (nth 1 message))
+ (sender (nth 2 message))
+ (args (nth 3 message))
+ (text (nth 4 message))
+ (rcirc-message-tags (nth 5 message)))
+ (if-let (handler (intern-soft (concat "rcirc-handler-"
cmd)))
+ (funcall handler process sender args text)
+ (rcirc-handler-generic process cmd sender args
text))))))))
+ (setq rcirc-batch-attributes
+ (delq (assoc id rcirc-batch-attributes)
+ rcirc-batch-attributes)
+ rcirc-batched-messages
+ (delq (assoc id rcirc-batched-messages)
+ rcirc-batched-messages)))))))
+
(defun rcirc-handler-AUTHENTICATE (process _cmd _args _text)
+ "Respond to authentication request.
+PROCESS is the process object for the current connection."
(rcirc-send-string
process
- (format "AUTHENTICATE %s"
- (base64-encode-string
- ;; use connection user-name
- (concat "\0" (nth 3 rcirc-connection-info)
- "\0" (rcirc-get-server-password rcirc-server))))))
+ "AUTHENTICATE"
+ (base64-encode-string
+ ;; use connection user-name
+ (concat "\0" (nth 3 rcirc-connection-info)
+ "\0" (rcirc-get-server-password rcirc-server)))))
+
+(defun rcirc-handler-900 (process sender args _text)
+ "Respond to a successful authentication response."
+ (rcirc-handler-generic process "900" sender args nil)
+ (when (not rcirc-finished-sasl)
+ (setq-local rcirc-finished-sasl t)
+ (rcirc-send-string process "CAP" "END"))
+ (rcirc-join-channels-post-auth process))
(defgroup rcirc-faces nil
@@ -3015,6 +3538,10 @@ Passwords are stored in `rcirc-authinfo' (which see)."
:group 'rcirc
:group 'faces)
+(defface rcirc-monospace-text
+ '((t :family "Monospace"))
+ "Face used for monospace text in messages.")
+
(defface rcirc-my-nick ; font-lock-function-name-face
'((((class color) (min-colors 88) (background light)) :foreground "Blue1")
(((class color) (min-colors 88) (background dark)) :foreground
"LightSkyBlue")
@@ -3124,11 +3651,12 @@ Passwords are stored in `rcirc-authinfo' (which see)."
;; When using M-x flyspell-mode, only check words after the prompt
(put 'rcirc-mode 'flyspell-mode-predicate 'rcirc-looking-at-input)
(defun rcirc-looking-at-input ()
- "Return true if point is past the input marker."
+ "Return non-nil if point is past the input marker."
(>= (point) rcirc-prompt-end-marker))
(defun rcirc-server-parameter-value (parameter)
+ "Traverse `rcirc-server-parameters' for PARAMETER."
(cl-loop for elem in rcirc-server-parameters
for setting = (split-string elem "=")
when (and (= (length setting) 2)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 873f045..85d81b6 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -183,6 +183,33 @@ temporarily blinks with this face."
"Face for <abbr> elements."
:version "27.1")
+(defface shr-h1
+ '((t :height 1.3 :weight bold))
+ "Face for <h1> elements."
+ :version "28.1")
+
+(defface shr-h2
+ '((t :weight bold))
+ "Face for <h2> elements."
+ :version "28.1")
+
+(defface shr-h3
+ '((t :slant italic))
+ "Face for <h3> elements."
+ :version "28.1")
+
+(defface shr-h4 nil
+ "Face for <h4> elements."
+ :version "28.1")
+
+(defface shr-h5 nil
+ "Face for <h5> elements."
+ :version "28.1")
+
+(defface shr-h6 nil
+ "Face for <h6> elements."
+ :version "28.1")
+
(defcustom shr-inhibit-images nil
"If non-nil, inhibit loading images."
:version "28.1"
@@ -1939,24 +1966,22 @@ BASE is the URL of the HTML being rendered."
(shr-generic dom))
(defun shr-tag-h1 (dom)
- (shr-heading dom (if shr-use-fonts
- '(variable-pitch (:height 1.3 :weight bold))
- 'bold)))
+ (shr-heading dom 'shr-h1))
(defun shr-tag-h2 (dom)
- (shr-heading dom 'bold))
+ (shr-heading dom 'shr-h2))
(defun shr-tag-h3 (dom)
- (shr-heading dom 'italic))
+ (shr-heading dom 'shr-h3))
(defun shr-tag-h4 (dom)
- (shr-heading dom))
+ (shr-heading dom 'shr-h4))
(defun shr-tag-h5 (dom)
- (shr-heading dom))
+ (shr-heading dom 'shr-h5))
(defun shr-tag-h6 (dom)
- (shr-heading dom))
+ (shr-heading dom 'shr-h6))
(defun shr-tag-hr (_dom)
(shr-ensure-newline)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 7fb0ff5..5e0accc 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -133,6 +133,7 @@ It is used for TCP/IP devices."
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-adb-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-adb-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -159,9 +160,11 @@ It is used for TCP/IP devices."
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-adb-handle-make-directory)
(make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-adb-handle-make-process)
(make-symbolic-link . tramp-handle-make-symbolic-link)
@@ -180,6 +183,7 @@ It is used for TCP/IP devices."
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-adb-handle-write-region))
@@ -323,9 +327,9 @@ arguments to pass to the OPERATION."
v (format "%s -d -a -l %s %s"
(tramp-adb-get-ls-command v)
(tramp-shell-quote-argument
- (concat (file-name-as-directory localname) "."))
+ (tramp-compat-file-name-concat localname "."))
(tramp-shell-quote-argument
- (concat (file-name-as-directory localname) ".."))))
+ (tramp-compat-file-name-concat localname ".."))))
(widen)))
(tramp-adb-sh-fix-ls-output)
(let ((result (tramp-do-parse-file-attributes-with-ls
@@ -535,7 +539,8 @@ But handle the case, if the \"test\" command is not
available."
(defun tramp-adb-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
+ (setq filename (expand-file-name filename)
+ lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl)
@@ -544,15 +549,26 @@ But handle the case, if the \"test\" command is not
available."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
- (let* ((curbuf (current-buffer))
- (tmpfile (tramp-compat-make-temp-file filename)))
+ (let ((file-locked (eq (file-locked-p lockname) t))
+ (curbuf (current-buffer))
+ (tmpfile (tramp-compat-make-temp-file filename)))
+
+ ;; Lock file.
+ (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
+ (file-remote-p lockname)
+ (not file-locked))
+ (setq file-locked t)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'lock-file lockname))
+
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok)
(set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
- (write-region start end tmpfile append 'no-message lockname)
+ (let (create-lockfiles)
+ (write-region start end tmpfile append 'no-message))
(with-tramp-progress-reporter
- v 3 (format-message
- "Moving tmp file `%s' to `%s'" tmpfile filename)
+ v 3 (format-message
+ "Moving tmp file `%s' to `%s'" tmpfile filename)
(unwind-protect
(unless (tramp-adb-execute-adb-command
v "push" tmpfile (tramp-compat-file-name-unquote
localname))
@@ -575,6 +591,11 @@ But handle the case, if the \"test\" command is not
available."
(file-attributes filename))
(current-time))))
+ ;; Unlock file.
+ (when file-locked
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'unlock-file lockname))
+
;; The end.
(when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
@@ -782,7 +803,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(when (and (numberp destination) (zerop destination))
(error "Implementation does not handle immediate return"))
- (with-parsed-tramp-file-name default-directory nil
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let (command input tmpinput stderr tmpstderr outbuf ret)
;; Compute command.
(setq command (mapconcat #'tramp-shell-quote-argument
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index d723fd5..67798e8 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -236,6 +236,7 @@ It must be supported by libarchive(3).")
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-archive-handle-file-local-copy)
+ (file-locked-p . ignore)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions .
tramp-archive-handle-file-name-all-completions)
;; `file-name-as-directory' performed by default handler.
@@ -262,9 +263,11 @@ It must be supported by libarchive(3).")
(insert-directory . tramp-archive-handle-insert-directory)
(insert-file-contents . tramp-archive-handle-insert-file-contents)
(load . tramp-archive-handle-load)
+ (lock-file . ignore)
(make-auto-save-file-name . ignore)
(make-directory . tramp-archive-handle-not-implemented)
(make-directory-internal . tramp-archive-handle-not-implemented)
+ (make-lock-file-name . ignore)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-archive-handle-not-implemented)
@@ -283,6 +286,7 @@ It must be supported by libarchive(3).")
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
+ (unlock-file . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-archive-handle-not-implemented))
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index a41620a..fcfad01 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -49,6 +49,8 @@
;; an open connection. Examples: "scripts" keeps shell script
;; definitions already sent to the remote shell, "last-cmd-time" is
;; the time stamp a command has been sent to the remote process.
+;; "lock-pid" is the timestamp a (network) process is created, it is
+;; used instead of the pid in file locks.
;;
;; - The key is nil. These are temporary properties related to the
;; local machine. Examples: "parse-passwd" and "parse-group" keep
@@ -70,8 +72,8 @@
;; process key retrieved by `tramp-get-process' (the main connection
;; process). Other processes could reuse these properties, avoiding
;; recomputation when a new asynchronous process is created by
-;; `make-process'. Examples are "remote-path",
-;; "unsafe-temporary-file" or "device" (tramp-adb.el).
+;; `make-process'. Examples are "unsafe-temporary-file",
+;; "remote-path", "device" (tramp-adb.el) or "share" (tramp-gvfs.el).
;;; Code:
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 54cfb6f..6e46407 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -353,6 +353,30 @@ A nil value for either argument stands for the current
time."
(lambda (fromstring tostring instring)
(replace-regexp-in-string (regexp-quote fromstring) tostring instring))))
+;; Function `make-lock-file-name' is new in Emacs 28.1.
+(defalias 'tramp-compat-make-lock-file-name
+ (if (fboundp 'make-lock-file-name)
+ #'make-lock-file-name
+ (lambda (filename)
+ (expand-file-name
+ (concat
+ ".#" (file-name-nondirectory filename))
+ (file-name-directory filename)))))
+
+;; Function `file-name-concat' is new in Emacs 28.1.
+(defalias 'tramp-compat-file-name-concat
+ (if (fboundp 'file-name-concat)
+ #'file-name-concat
+ (lambda (directory &rest components)
+ (unless (null directory)
+ (let ((components (delq nil components))
+ file-name-handler-alist)
+ (if (null components)
+ directory
+ (tramp-compat-file-name-concat
+ (concat (file-name-as-directory directory) (car components))
+ (cdr components))))))))
+
(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
(put (intern elt) 'tramp-suppress-trace t))
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 1d8c0ad..fdb2907 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -182,6 +182,7 @@ If NAME doesn't belong to a crypted remote directory, retun
nil."
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy)
+ (file-locked-p . tramp-crypt-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-crypt-handle-file-name-all-completions)
;; `file-name-as-directory' performed by default handler.
@@ -208,9 +209,11 @@ If NAME doesn't belong to a crypted remote directory,
retun nil."
(insert-directory . tramp-crypt-handle-insert-directory)
;; `insert-file-contents' performed by default handler.
(load . tramp-handle-load)
+ (lock-file . tramp-crypt-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-crypt-handle-make-directory)
(make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link)
@@ -229,6 +232,7 @@ If NAME doesn't belong to a crypted remote directory, retun
nil."
;; `tramp-get-remote-uid' performed by default handler.
(tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-crypt-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-handle-write-region))
@@ -734,6 +738,11 @@ absolute file names."
(let (tramp-crypt-enabled)
(file-executable-p (tramp-crypt-encrypt-file-name filename))))
+(defun tramp-crypt-handle-file-locked-p (filename)
+ "Like `file-locked-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-locked-p (tramp-crypt-encrypt-file-name filename))))
+
(defun tramp-crypt-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
(all-completions
@@ -797,6 +806,13 @@ WILDCARD is not supported."
(delete-region (prop-match-beginning match) (prop-match-end match))
(insert (propertize string 'dired-filename t)))))))
+(defun tramp-crypt-handle-lock-file (filename)
+ "Like `lock-file' for Tramp files."
+ (let (tramp-crypt-enabled)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall
+ 'lock-file (tramp-crypt-encrypt-file-name filename))))
+
(defun tramp-crypt-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name dir) nil
@@ -848,6 +864,13 @@ WILDCARD is not supported."
(tramp-set-file-uid-gid
(tramp-crypt-encrypt-file-name filename) uid gid))))
+(defun tramp-crypt-handle-unlock-file (filename)
+ "Like `unlock-file' for Tramp files."
+ (let (tramp-crypt-enabled)
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall
+ 'unlock-file (tramp-crypt-encrypt-file-name filename))))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-crypt 'force)))
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
index ec1db86..93b184a 100644
--- a/lisp/net/tramp-fuse.el
+++ b/lisp/net/tramp-fuse.el
@@ -164,10 +164,9 @@
(or (tramp-get-connection-property
(tramp-get-connection-process vec) "mounted" nil)
(let* ((default-directory (tramp-compat-temporary-file-directory))
- (fuse (concat "fuse." (tramp-file-name-method vec)))
- (mount (shell-command-to-string (format "mount -t %s" fuse))))
- (tramp-message vec 6 "%s %s" "mount -t" fuse)
- (tramp-message vec 6 "\n%s" mount)
+ (command (format "mount -t fuse.%s" (tramp-file-name-method
vec)))
+ (mount (shell-command-to-string command)))
+ (tramp-message vec 6 "%s\n%s" command mount)
(tramp-set-connection-property
(tramp-get-connection-process vec) "mounted"
(when (string-match
@@ -176,6 +175,16 @@
mount)
(match-string 1 mount)))))))
+(defun tramp-fuse-unmount (vec)
+ "Unmount fuse volume determined by VEC."
+ (let ((default-directory (tramp-compat-temporary-file-directory))
+ (command (format "fusermount3 -u %s" (tramp-fuse-mount-point vec))))
+ (tramp-message vec 6 "%s\n%s" command (shell-command-to-string command))
+ (tramp-flush-connection-property
+ (tramp-get-connection-process vec) "mounted")
+ ;; Give the caches a chance to expire.
+ (sleep-for 1)))
+
(defun tramp-fuse-local-file-name (filename)
"Return local mount name of FILENAME."
(setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index f1d24dc..eff14a2 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -774,6 +774,7 @@ It has been changed in GVFS 1.14.")
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-gvfs-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -800,9 +801,11 @@ It has been changed in GVFS 1.14.")
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link)
@@ -821,6 +824,7 @@ It has been changed in GVFS 1.14.")
(tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-handle-write-region))
@@ -1138,7 +1142,7 @@ file names."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@@ -1629,8 +1633,10 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
ID-FORMAT valid values are `string' and `integer'."
(if (equal id-format 'string)
(tramp-file-name-user vec)
- (when-let
- ((localname (tramp-get-connection-property vec "default-location" nil)))
+ (when-let ((localname
+ (tramp-get-connection-property
+ (tramp-get-process vec) "share"
+ (tramp-get-connection-property vec "default-location" nil))))
(tramp-compat-file-attribute-user-id
(file-attributes
(tramp-make-tramp-file-name vec localname) id-format)))))
@@ -1638,8 +1644,10 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-gvfs-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- (when-let
- ((localname (tramp-get-connection-property vec "default-location" nil)))
+ (when-let ((localname
+ (tramp-get-connection-property
+ (tramp-get-process vec) "share"
+ (tramp-get-connection-property vec "default-location" nil))))
(tramp-compat-file-attribute-group-id
(file-attributes
(tramp-make-tramp-file-name vec localname) id-format))))
@@ -1993,6 +2001,9 @@ a downcased host name only."
(tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint)
(tramp-set-connection-property
vec "default-location" default-location)
+ (when share
+ (tramp-set-connection-property
+ (tramp-get-process vec) "share" (concat "/" share)))
(throw 'mounted t)))))))
(defun tramp-gvfs-unmount (vec)
@@ -2144,6 +2155,9 @@ connection if a previous connection has died for some
reason."
(process-put p 'vector vec)
(set-process-query-on-exit-flag p nil)
+ ;; Mark process for filelock.
+ (tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
+
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)))
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 3b6de3e..49e366c 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -96,6 +96,7 @@
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-fuse-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -122,9 +123,11 @@
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-fuse-handle-make-directory)
(make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link)
@@ -143,6 +146,7 @@
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-handle-write-region))
@@ -358,6 +362,10 @@ connection if a previous connection has died for some
reason."
(process-put p 'vector vec)
(set-process-query-on-exit-flag p nil)
+ ;; Mark process for filelock.
+ (tramp-set-connection-property
+ p "lock-pid" (truncate (time-to-seconds)))
+
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 88caa2f..7cf90b9 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -519,6 +519,7 @@ shell from reading its init file."
(tramp-yn-prompt-regexp tramp-action-yn)
(tramp-terminal-prompt-regexp tramp-action-terminal)
(tramp-antispoof-regexp tramp-action-confirm-message)
+ (tramp-yubikey-regexp tramp-action-show-and-confirm-message)
(tramp-process-alive-regexp tramp-action-process-alive))
"List of pattern/action pairs.
Whenever a pattern matches, the corresponding action is performed.
@@ -536,6 +537,7 @@ corresponding PATTERN matches, the ACTION function is
called.")
'((tramp-password-prompt-regexp tramp-action-password)
(tramp-wrong-passwd-regexp tramp-action-permission-denied)
(tramp-copy-failed-regexp tramp-action-permission-denied)
+ (tramp-yubikey-regexp tramp-action-show-and-confirm-message)
(tramp-process-alive-regexp tramp-action-out-of-band))
"List of pattern/action pairs.
This list is used for copying/renaming with out-of-band methods.
@@ -962,6 +964,7 @@ Format specifiers \"%s\" are replaced before the script is
used.")
(file-exists-p . tramp-sh-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-sh-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-sh-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -988,9 +991,11 @@ Format specifiers \"%s\" are replaced before the script is
used.")
(insert-directory . tramp-sh-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sh-handle-make-directory)
;; `make-directory-internal' performed by default handler.
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-sh-handle-make-process)
(make-symbolic-link . tramp-sh-handle-make-symbolic-link)
@@ -1009,6 +1014,7 @@ Format specifiers \"%s\" are replaced before the script
is used.")
(tramp-get-remote-uid . tramp-sh-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
(vc-registered . tramp-sh-handle-vc-registered)
(verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime)
(write-region . tramp-sh-handle-write-region))
@@ -1940,7 +1946,7 @@ file names."
(length (tramp-compat-file-attribute-size
(file-attributes (file-truename filename))))
(attributes (and preserve-extended-attributes
- (apply #'file-extended-attributes (list filename))))
+ (file-extended-attributes filename)))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
@@ -2016,7 +2022,7 @@ file names."
;; errors, because ACL strings could be incompatible.
(when attributes
(ignore-errors
- (apply #'set-file-extended-attributes (list newname attributes))))
+ (set-file-extended-attributes newname attributes)))
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
@@ -2675,7 +2681,7 @@ the result will be a local, non-Tramp, file name."
(tramp-run-real-handler #'expand-file-name (list name dir))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
;; If connection is not established yet, run the real handler.
(if (not (tramp-connectable-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@@ -3025,7 +3031,7 @@ implementation will be used."
(when (and (numberp destination) (zerop destination))
(error "Implementation does not handle immediate return"))
- (with-parsed-tramp-file-name default-directory nil
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let (command env uenv input tmpinput stderr tmpstderr outbuf ret)
;; Compute command.
(setq command (mapconcat #'tramp-shell-quote-argument
@@ -3235,7 +3241,8 @@ implementation will be used."
(defun tramp-sh-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
+ (setq filename (expand-file-name filename)
+ lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl)
@@ -3244,23 +3251,31 @@ implementation will be used."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
- (let ((uid (or (tramp-compat-file-attribute-user-id
+ (let ((file-locked (eq (file-locked-p lockname) t))
+ (uid (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
(tramp-get-remote-uid v 'integer)))
(gid (or (tramp-compat-file-attribute-group-id
(file-attributes filename 'integer))
(tramp-get-remote-gid v 'integer))))
+ ;; Lock file.
+ (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
+ (file-remote-p lockname)
+ (not file-locked))
+ (setq file-locked t)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'lock-file lockname))
+
(if (and (tramp-local-host-p v)
;; `file-writable-p' calls `file-expand-file-name'. We
;; cannot use `tramp-run-real-handler' therefore.
- (let (file-name-handler-alist)
- (and
- (file-writable-p (file-name-directory localname))
- (or (file-directory-p localname)
- (file-writable-p localname)))))
+ (file-writable-p (file-name-directory localname))
+ (or (file-directory-p localname)
+ (file-writable-p localname)))
;; Short track: if we are on the local host, we can run directly.
- (write-region start end localname append 'no-message lockname)
+ (let ((create-lockfiles (not file-locked)))
+ (write-region start end localname append 'no-message lockname))
(let* ((modes (tramp-default-file-modes
filename (and (eq mustbenew 'excl) 'nofollow)))
@@ -3294,9 +3309,10 @@ implementation will be used."
;; on. We must ensure that `file-coding-system-alist'
;; matches `tmpfile'.
(let ((file-coding-system-alist
- (tramp-find-file-name-coding-system-alist filename tmpfile)))
+ (tramp-find-file-name-coding-system-alist filename tmpfile))
+ create-lockfiles)
(condition-case err
- (write-region start end tmpfile append 'no-message lockname)
+ (write-region start end tmpfile append 'no-message)
((error quit)
(setq tramp-temp-buffer-file-name nil)
(delete-file tmpfile)
@@ -3465,6 +3481,12 @@ implementation will be used."
;; Set the ownership.
(when need-chown
(tramp-set-file-uid-gid filename uid gid))
+
+ ;; Unlock file.
+ (when file-locked
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'unlock-file lockname))
+
(when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(tramp-message v 0 "Wrote %s" filename))
@@ -4762,7 +4784,9 @@ Goes through the list `tramp-inline-compress-commands'."
(with-temp-buffer
(tramp-call-process vec "scp" nil t nil "-T")
(goto-char (point-min))
- (unless (search-forward-regexp "unknown option -- T" nil t)
+ (unless
+ (search-forward-regexp
+ "\\(illegal\\|unknown\\) option -- T" nil t)
(setq tramp-scp-strict-file-name-checking "-T")))))))
tramp-scp-strict-file-name-checking)))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 6fbf088..3d5be61 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -247,6 +247,7 @@ See `tramp-actions-before-shell' for more info.")
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-smb-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-smb-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -273,9 +274,11 @@ See `tramp-actions-before-shell' for more info.")
(insert-directory . tramp-smb-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-smb-handle-make-directory)
(make-directory-internal . tramp-smb-handle-make-directory-internal)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
@@ -294,6 +297,7 @@ See `tramp-actions-before-shell' for more info.")
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-smb-handle-write-region))
@@ -532,7 +536,7 @@ arguments to pass to the OPERATION."
(tramp-process-actions p v nil tramp-smb-actions-with-tar)
(while (process-live-p p)
- (sit-for 0.1))
+ (sleep-for 0.1))
(tramp-message v 6 "\n%s" (buffer-string))))
;; Reset the transfer process properties.
@@ -718,7 +722,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@@ -1255,7 +1259,7 @@ component is used as the target of the symlink."
(when (and (numberp destination) (zerop destination))
(error "Implementation does not handle immediate return"))
- (with-parsed-tramp-file-name default-directory nil
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let* ((name (file-name-nondirectory program))
(name1 name)
(i 0)
@@ -1575,7 +1579,8 @@ errors for shares like \"C$/\", which are common in
Microsoft Windows."
(defun tramp-smb-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
+ (setq filename (expand-file-name filename)
+ lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl)
@@ -1584,15 +1589,25 @@ errors for shares like \"C$/\", which are common in
Microsoft Windows."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
- (let ((curbuf (current-buffer))
+ (let ((file-locked (eq (file-locked-p lockname) t))
+ (curbuf (current-buffer))
(tmpfile (tramp-compat-make-temp-file filename)))
+
+ ;; Lock file.
+ (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
+ (file-remote-p lockname)
+ (not file-locked))
+ (setq file-locked t)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'lock-file lockname))
+
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; We say `no-message' here because we don't want the visited file
;; modtime data to be clobbered from the temp file. We call
;; `set-visited-file-modtime' ourselves later on.
- (tramp-run-real-handler
- #'write-region (list start end tmpfile append 'no-message lockname))
+ (let (create-lockfiles)
+ (write-region start end tmpfile append 'no-message))
(with-tramp-progress-reporter
v 3 (format "Moving tmp file %s to %s" tmpfile filename)
@@ -1619,6 +1634,11 @@ errors for shares like \"C$/\", which are common in
Microsoft Windows."
(file-attributes filename))
(current-time))))
+ ;; Unlock file.
+ (when file-locked
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'unlock-file lockname))
+
;; The end.
(when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index c4a36fe..c5b84a6 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -96,6 +96,7 @@
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-fuse-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -122,9 +123,11 @@
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-sshfs-handle-insert-file-contents)
(load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-fuse-handle-make-directory)
(make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-handle-make-process)
(make-symbolic-link . tramp-handle-make-symbolic-link)
@@ -143,6 +146,7 @@
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-sshfs-handle-write-region))
@@ -231,7 +235,7 @@ arguments to pass to the OPERATION."
(when (and (numberp destination) (zerop destination))
(error "Implementation does not handle immediate return"))
- (with-parsed-tramp-file-name default-directory nil
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let ((command
(format
"cd %s && exec %s"
@@ -281,7 +285,8 @@ arguments to pass to the OPERATION."
(defun tramp-sshfs-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
+ (setq filename (expand-file-name filename)
+ lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl)
@@ -290,15 +295,31 @@ arguments to pass to the OPERATION."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
- (write-region
- start end (tramp-fuse-local-file-name filename) append 'nomessage
lockname)
- (tramp-flush-file-properties v localname)
+ (let ((file-locked (eq (file-locked-p lockname) t)))
+
+ ;; Lock file.
+ (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
+ (file-remote-p lockname)
+ (not file-locked))
+ (setq file-locked t)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'lock-file lockname))
+
+ (let (create-lockfiles)
+ (write-region
+ start end (tramp-fuse-local-file-name filename) append 'nomessage)
+ (tramp-flush-file-properties v localname))
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (null visit) (stringp visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook)))
+ ;; Unlock file.
+ (when file-locked
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'unlock-file lockname))
+
+ ;; The end.
+ (when (and (null noninteractive)
+ (or (eq visit t) (null visit) (stringp visit)))
+ (tramp-message v 0 "Wrote %s" filename))
+ (run-hooks 'tramp-handle-write-region-hook))))
;; File name conversions.
@@ -321,6 +342,9 @@ connection if a previous connection has died for some
reason."
(process-put p 'vector vec)
(set-process-query-on-exit-flag p nil)
+ ;; Mark process for filelock.
+ (tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
+
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index d641709..5895f1d 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -88,6 +88,7 @@ See `tramp-actions-before-shell' for more info.")
(file-exists-p . tramp-sudoedit-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions
. tramp-sudoedit-handle-file-name-all-completions)
@@ -115,9 +116,11 @@ See `tramp-actions-before-shell' for more info.")
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sudoedit-handle-make-directory)
(make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link)
@@ -136,6 +139,7 @@ See `tramp-actions-before-shell' for more info.")
(tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-sudoedit-handle-write-region))
@@ -233,7 +237,7 @@ absolute file names."
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(attributes (and preserve-extended-attributes
- (apply #'file-extended-attributes (list filename))))
+ (file-extended-attributes filename)))
(sudoedit-operation
(cond
((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p"))
@@ -289,7 +293,7 @@ absolute file names."
;; errors, because ACL strings could be incompatible.
(when attributes
(ignore-errors
- (apply #'set-file-extended-attributes (list newname attributes))))
+ (set-file-extended-attributes newname attributes)))
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
@@ -349,7 +353,7 @@ the result will be a local, non-Tramp, file name."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
(with-parsed-tramp-file-name name nil
;; Tilde expansion if necessary. We cannot accept "~/", because
;; under sudo "~/" is expanded to the local user home directory
@@ -713,6 +717,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sudoedit-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
+ (setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
(let* ((uid (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
@@ -721,13 +726,14 @@ ID-FORMAT valid values are `string' and `integer'."
(file-attributes filename 'integer))
(tramp-get-remote-gid v 'integer)))
(flag (and (eq mustbenew 'excl) 'nofollow))
- (modes (tramp-default-file-modes filename flag)))
+ (modes (tramp-default-file-modes filename flag))
+ (attributes (file-extended-attributes filename)))
(prog1
(tramp-handle-write-region
start end filename append visit lockname mustbenew)
- ;; Set the ownership and modes. This is not performed in
- ;; `tramp-handle-write-region'.
+ ;; Set the ownership, modes and extended attributes. This is
+ ;; not performed in `tramp-handle-write-region'.
(unless (and (= (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
uid)
@@ -735,7 +741,12 @@ ID-FORMAT valid values are `string' and `integer'."
(file-attributes filename 'integer))
gid))
(tramp-set-file-uid-gid filename uid gid))
- (tramp-compat-set-file-modes filename modes flag)))))
+ (tramp-compat-set-file-modes filename modes flag)
+ ;; We ignore possible errors, because ACL strings could be
+ ;; incompatible.
+ (when attributes
+ (ignore-errors
+ (set-file-extended-attributes filename attributes)))))))
;; Internal functions.
@@ -776,6 +787,9 @@ connection if a previous connection has died for some
reason."
(process-put p 'vector vec)
(set-process-query-on-exit-flag p nil)
+ ;; Mark process for filelock.
+ (tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
+
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)
@@ -803,6 +817,9 @@ in case of error, t otherwise."
(tramp-compat-flatten-tree args))))
;; We suppress the messages `Waiting for prompts from remote shell'.
(tramp-verbose (if (= tramp-verbose 3) 2 tramp-verbose))
+ ;; The password shall be cached also in case of "emacs -Q".
+ ;; See `tramp-process-actions'.
+ (tramp-cache-read-persistent-data t)
;; We do not want to save the password.
auth-source-save-behavior)
(tramp-message vec 6 "%s" (string-join (process-command p) " "))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 75e4455..959a0e7 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -586,8 +586,7 @@ Sometimes the prompt is reported to look like \"login
as:\"."
(defcustom tramp-shell-prompt-pattern
;; Allow a prompt to start right after a ^M since it indeed would be
- ;; displayed at the beginning of the line (and Zsh uses it). This
- ;; regexp works only for GNU Emacs.
+ ;; displayed at the beginning of the line (and Zsh uses it).
;; Allow also [] style prompts. They can appear only during
;; connection initialization; Tramp redefines the prompt afterwards.
(concat "\\(?:^\\|\r\\)"
@@ -698,6 +697,15 @@ The regexp should match at end of buffer."
:version "27.1"
:type 'regexp)
+;; Yubikey requires the user physically to touch the device with their
+;; finger. We must tell it to the user.
+(defcustom tramp-yubikey-regexp
+ "^\r*Confirm user presence for key .*[\r\n]*"
+ "Regular expression matching yubikey confirmation message.
+The regexp should match at end of buffer."
+ :version "28.1"
+ :type 'regexp)
+
(defcustom tramp-operation-not-permitted-regexp
(concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
(regexp-opt '("Operation not permitted") t))
@@ -1905,7 +1913,7 @@ The outline level is equal to the verbosity of the Tramp
message."
(put #'tramp-trace-buffer-name 'tramp-suppress-trace t)
(defvar tramp-trace-functions nil
- "A list of non-Tramp functions to be trace with tramp-verbose > 10.")
+ "A list of non-Tramp functions to be traced with tramp-verbose > 10.")
(defun tramp-debug-message (vec fmt-string &rest arguments)
"Append message to debug buffer of VEC.
@@ -2455,6 +2463,8 @@ Must be handled by the callers."
file-name-case-insensitive-p
;; Emacs 27+ only.
file-system-info
+ ;; Emacs 28+ only.
+ file-locked-p lock-file make-lock-file-name unlock-file
;; Tramp internal magic file name function.
tramp-set-file-uid-gid))
(if (file-name-absolute-p (nth 0 args))
@@ -3335,7 +3345,7 @@ User is always nil."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@@ -3628,7 +3638,7 @@ User is always nil."
(file-writable-p (file-name-directory filename)))))))
(defcustom tramp-allow-unsafe-temporary-files nil
- "Whether root-owned auto-save or backup files can be written to \"/tmp\"."
+ "Whether root-owned auto-save, backup or lock files can be written to
\"/tmp\"."
:version "28.1"
:type 'boolean)
@@ -3655,6 +3665,7 @@ User is always nil."
#'find-backup-file-name (list filename)))
;; Protect against security hole.
(when (and (not tramp-allow-unsafe-temporary-files)
+ (not backup-inhibited)
(file-in-directory-p (car result) temporary-file-directory)
(zerop (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
@@ -3816,6 +3827,101 @@ User is always nil."
;; Result.
(cons (expand-file-name filename) (cdr result)))))
+(defun tramp-get-lock-file (file)
+ "Read lockfile info of FILE.
+Return nil when there is no lockfile."
+ (when-let ((lockname (tramp-compat-make-lock-file-name file)))
+ (or (file-symlink-p lockname)
+ (and (file-readable-p lockname)
+ (with-temp-buffer
+ (insert-file-contents-literally lockname)
+ (buffer-string))))))
+
+(defun tramp-get-lock-pid (file)
+ "Determine pid for lockfile of FILE."
+ ;; Some Tramp methods do not offer a connection process, but just a
+ ;; network process as a place holder. Those processes use the
+ ;; "lock-pid" connection property as fake pid, in fact it is the
+ ;; time stamp the process is created.
+ (let ((p (tramp-get-process (tramp-dissect-file-name file))))
+ (number-to-string
+ (or (process-id p)
+ (tramp-get-connection-property p "lock-pid" (emacs-pid))))))
+
+(defconst tramp-lock-file-info-regexp
+ ;; USER@HOST.PID[:BOOT_TIME]
+ "\\`\\(.+\\)@\\(.+\\)\\.\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\'"
+ "The format of a lock file.")
+
+(defun tramp-handle-file-locked-p (file)
+ "Like `file-locked-p' for Tramp files."
+ (when-let ((info (tramp-get-lock-file file))
+ (match (string-match tramp-lock-file-info-regexp info)))
+ (or (and (string-equal (match-string 1 info) (user-login-name))
+ (string-equal (match-string 2 info) (system-name))
+ (string-equal (match-string 3 info) (tramp-get-lock-pid file)))
+ (match-string 1 info))))
+
+(defun tramp-handle-lock-file (file)
+ "Like `lock-file' for Tramp files."
+ ;; See if this file is visited and has changed on disk since it
+ ;; was visited.
+ (catch 'dont-lock
+ (unless (eq (file-locked-p file) t) ;; Locked by me.
+ (when-let ((info (tramp-get-lock-file file))
+ (match (string-match tramp-lock-file-info-regexp info)))
+ (unless (ask-user-about-lock
+ file (format
+ "%s@%s (pid %s)" (match-string 1 info)
+ (match-string 2 info) (match-string 3 info)))
+ (throw 'dont-lock nil)))
+
+ (when-let ((lockname (tramp-compat-make-lock-file-name file))
+ ;; USER@HOST.PID[:BOOT_TIME]
+ (info
+ (format
+ "%s@%s.%s" (user-login-name) (system-name)
+ (tramp-get-lock-pid file))))
+
+ ;; Protect against security hole.
+ (with-parsed-tramp-file-name file nil
+ (when (and (not tramp-allow-unsafe-temporary-files)
+ create-lockfiles
+ (file-in-directory-p lockname temporary-file-directory)
+ (zerop (or (tramp-compat-file-attribute-user-id
+ (file-attributes file 'integer))
+ tramp-unknown-id-integer))
+ (not (with-tramp-connection-property
+ (tramp-get-process v) "unsafe-temporary-file"
+ (yes-or-no-p
+ (concat
+ "Lock file on local temporary directory, "
+ "do you want to continue? ")))))
+ (tramp-error v 'file-error "Unsafe lock file name")))
+
+ ;; Do the lock.
+ (let (create-lockfiles signal-hook-function)
+ (condition-case nil
+ (make-symbolic-link info lockname 'ok-if-already-exists)
+ (error
+ (with-file-modes #o0644
+ (write-region info nil lockname)))))))))
+
+(defun tramp-handle-make-lock-file-name (file)
+ "Like `make-lock-file-name' for Tramp files."
+ (and create-lockfiles
+ ;; This variable has been introduced with Emacs 28.1.
+ (not (bound-and-true-p remote-file-name-inhibit-locks))
+ (tramp-run-real-handler 'make-lock-file-name (list file))))
+
+(defun tramp-handle-unlock-file (file)
+ "Like `unlock-file' for Tramp files."
+ (when-let ((lockname (tramp-compat-make-lock-file-name file)))
+ (condition-case err
+ (delete-file lockname)
+ ;; `userlock--handle-unlock-error' exists since Emacs 28.1.
+ (error (tramp-compat-funcall 'userlock--handle-unlock-error err)))))
+
(defun tramp-handle-load (file &optional noerror nomessage nosuffix
must-suffix)
"Like `load' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name file) nil
@@ -4357,7 +4463,8 @@ of."
(defun tramp-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
+ (setq filename (expand-file-name filename)
+ lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl)
@@ -4366,7 +4473,8 @@ of."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
- (let ((tmpfile (tramp-compat-make-temp-file filename))
+ (let ((file-locked (eq (file-locked-p lockname) t))
+ (tmpfile (tramp-compat-make-temp-file filename))
(modes (tramp-default-file-modes
filename (and (eq mustbenew 'excl) 'nofollow)))
(uid (or (tramp-compat-file-attribute-user-id
@@ -4375,6 +4483,15 @@ of."
(gid (or (tramp-compat-file-attribute-group-id
(file-attributes filename 'integer))
(tramp-get-remote-gid v 'integer))))
+
+ ;; Lock file.
+ (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
+ (file-remote-p lockname)
+ (not file-locked))
+ (setq file-locked t)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'lock-file lockname))
+
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; The permissions of the temporary file should be set. If
@@ -4386,7 +4503,8 @@ of."
;; We say `no-message' here because we don't want the visited file
;; modtime data to be clobbered from the temp file. We call
;; `set-visited-file-modtime' ourselves later on.
- (write-region start end tmpfile append 'no-message lockname)
+ (let (create-lockfiles)
+ (write-region start end tmpfile append 'no-message))
(condition-case nil
(rename-file tmpfile filename 'ok-if-already-exists)
(error
@@ -4404,13 +4522,18 @@ of."
(current-time))))
;; Set the ownership.
- (tramp-set-file-uid-gid filename uid gid))
+ (tramp-set-file-uid-gid filename uid gid)
+
+ ;; Unlock file.
+ (when file-locked
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'unlock-file lockname))
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (null visit) (stringp visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook)))
+ ;; The end.
+ (when (and (null noninteractive)
+ (or (eq visit t) (null visit) (stringp visit)))
+ (tramp-message v 0 "Wrote %s" filename))
+ (run-hooks 'tramp-handle-write-region-hook))))
;; This is used in tramp-sh.el and tramp-sudoedit.el.
(defconst tramp-stat-marker "/////"
@@ -4466,6 +4589,9 @@ of."
;; prompts from the remote host. See the variable
;; `tramp-actions-before-shell' for usage of these functions.
+(defvar tramp-process-action-regexp nil
+ "The regexp used to invoke an action in `tramp-process-one-action'.")
+
(defun tramp-action-login (_proc vec)
"Send the login name."
(let ((user (or (tramp-file-name-user vec)
@@ -4491,7 +4617,7 @@ of."
(unless (tramp-get-connection-property vec "first-password-request" nil)
(tramp-clear-passwd vec))
(goto-char (point-min))
- (tramp-check-for-regexp proc tramp-password-prompt-regexp)
+ (tramp-check-for-regexp proc tramp-process-action-regexp)
(tramp-message vec 3 "Sending %s" (match-string 1))
;; We don't call `tramp-send-string' in order to hide the
;; password from the debug buffer and the traces.
@@ -4556,6 +4682,23 @@ The terminal type can be configured with
`tramp-terminal-type'."
(tramp-send-string vec tramp-local-end-of-line)
t)
+(defun tramp-action-show-and-confirm-message (proc vec)
+ "Show the user a message for confirmation.
+Wait, until the connection buffer changes."
+ (with-current-buffer (process-buffer proc)
+ (let ((stimers (with-timeout-suspend)))
+ (tramp-message vec 6 "\n%s" (buffer-string))
+ (goto-char (point-min))
+ (tramp-check-for-regexp proc tramp-process-action-regexp)
+ (with-temp-message (replace-regexp-in-string "[\r\n]" "" (match-string
0))
+ ;; Hide message in buffer.
+ (narrow-to-region (point-max) (point-max))
+ ;; Wait for new output.
+ (tramp-wait-for-regexp proc 30 "."))
+ ;; Reenable the timers.
+ (with-timeout-unsuspend stimers)))
+ t)
+
(defun tramp-action-process-alive (proc _vec)
"Check, whether a process has finished."
(unless (process-live-p proc)
@@ -4593,6 +4736,7 @@ The terminal type can be configured with
`tramp-terminal-type'."
"Wait for output from the shell and perform one action.
See `tramp-process-actions' for the format of ACTIONS."
(let ((case-fold-search t)
+ tramp-process-action-regexp
found todo item pattern action)
(while (not found)
;; Reread output once all actions have been performed.
@@ -4601,7 +4745,8 @@ See `tramp-process-actions' for the format of ACTIONS."
(setq todo actions)
(while todo
(setq item (pop todo)
- pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item)))
+ tramp-process-action-regexp (symbol-value (nth 0 item))
+ pattern (format "\\(%s\\)\\'" tramp-process-action-regexp)
action (nth 1 item))
(tramp-message
vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
@@ -5282,6 +5427,7 @@ this file, if that variable is non-nil."
(setq result (tramp-run-real-handler #'make-auto-save-file-name nil))
;; Protect against security hole.
(when (and (not tramp-allow-unsafe-temporary-files)
+ auto-save-default
(file-in-directory-p result temporary-file-directory)
(zerop (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index e6cf4c6..8ad641e 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.5.1
+;; Version: 2.5.2-pre
;; Package-Requires: ((emacs "25.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@@ -40,7 +40,7 @@
;; ./configure" to change them.
;;;###tramp-autoload
-(defconst tramp-version "2.5.1"
+(defconst tramp-version "2.5.2-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -76,7 +76,7 @@
;; Check for Emacs version.
(let ((x (if (not (string-lessp emacs-version "25.1"))
"ok"
- (format "Tramp 2.5.1 is not fit for %s"
+ (format "Tramp 2.5.2-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index a5bfb06..57a52ef 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -840,9 +840,13 @@ Ensure that `comment-normalize-vars' has been called
before you use this."
(make-string (min comment-padding
(- (match-end 0) (match-end 1)))
?\s)
- (substring comment-padding ;additional right padding
- (min (- (match-end 0) (match-end 1))
- (length comment-padding))))))
+ (if (not (string-match-p "\\`\\s-" comment-padding))
+ ;; If the padding isn't spaces, then don't
+ ;; shorten the padding.
+ comment-padding
+ (substring comment-padding ;additional right padding
+ (min (- (match-end 0) (match-end 1))
+ (length comment-padding)))))))
;; We can only duplicate C if the comment-end has multiple chars
;; or if comments can be nested, else the comment-end `}' would
;; be turned into `}}}' where only the first ends the comment
@@ -876,9 +880,13 @@ Ensure that `comment-normalize-vars' has been called
before you use this."
;; Only separate the left pad because we assume there is no right pad.
(string-match "\\`\\s-*" str)
(let ((s (substring str (match-end 0)))
- (pad (concat (substring comment-padding
- (min (- (match-end 0) (match-beginning 0))
- (length comment-padding)))
+ (pad (concat (if (not (string-match-p "\\`\\s-" comment-padding))
+ ;; If the padding isn't spaces, then don't
+ ;; shorten the padding.
+ comment-padding
+ (substring comment-padding
+ (min (- (match-end 0) (match-beginning 0))
+ (length comment-padding))))
(match-string 0 str)))
(c (aref str (match-end 0))) ;the first non-space char of STR
;; We can only duplicate C if the comment-end has multiple chars
diff --git a/lisp/org/ol-irc.el b/lisp/org/ol-irc.el
index e3d7651..df62dd0 100644
--- a/lisp/org/ol-irc.el
+++ b/lisp/org/ol-irc.el
@@ -39,9 +39,9 @@
;;
;; Links within an org buffer might look like this:
;;
-;; [[irc:/irc.freenode.net/#emacs/bob][chat with bob in #emacs on freenode]]
-;; [[irc:/irc.freenode.net/#emacs][#emacs on freenode]]
-;; [[irc:/irc.freenode.net/]]
+;; [[irc:/irc.libera.chat/#emacs/bob][chat with bob in #emacs on Libera.Chat]]
+;; [[irc:/irc.libera.chat/#emacs][#emacs on Libera.Chat]]
+;; [[irc:/irc.libera.chat/]]
;;
;; If, when the resulting link is visited, there is no connection to a
;; requested server then one will be created.
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 8a4aa2b..3acc187 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -3205,7 +3205,7 @@ s Search for keywords M Like m, but
only TODO entries
(delete-window)
(org-agenda-get-restriction-and-command prefix-descriptions))
- ((equal c ?q) (error "Abort"))
+ ((equal c ?q) (user-error "Abort"))
(t (user-error "Invalid key %c" c))))))))
(defun org-agenda-fit-window-to-buffer ()
diff --git a/lisp/outline.el b/lisp/outline.el
index 68b8f4b..0bb74ff 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -182,7 +182,6 @@ in the file it applies to.")
;; Only takes effect if point is on a heading.
:filter ,(lambda (cmd)
(when (outline-on-heading-p) cmd)))))
- (define-key map [tab] tab-binding)
(define-key map (kbd "TAB") tab-binding)
(define-key map (kbd "<backtab>") #'outline-cycle-buffer))
map)
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index c1aaf82..e1d104f 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -82,7 +82,8 @@ being via `pcmpl-ssh-known-hosts-file'."
;;;###autoload
(defun pcomplete/xargs ()
"Completion for `xargs'."
- ;; FIXME: Add completion of xargs-specific arguments.
+ (while (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (funcall pcomplete-default-completion-function)))
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index f1ec522..9b9c58e 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -25,10 +25,13 @@
;; This file provides minor modes for putting clickable overlays on
;; references to bugs. A bug reference is text like "PR foo/29292";
-;; this is mapped to a URL using a user-supplied format.
+;; this is mapped to a URL using a user-supplied format; see
+;; `bug-reference-url-format' and `bug-reference-bug-regexp'. More
+;; extensive documentation is in (info "(emacs) Bug Reference").
;; Two minor modes are provided. One works on any text in the buffer;
-;; the other operates only on comments and strings.
+;; the other operates only on comments and strings. By default, the
+;; URL link is followed by invoking C-c RET or mouse-2.
;;; Code:
@@ -126,6 +129,9 @@ The second subexpression should match the bug reference
(usually a number)."
"Open URL corresponding to the bug reference at POS."
(interactive
(list (if (integerp last-command-event) (point) last-command-event)))
+ (when (null bug-reference-url-format)
+ (user-error
+ "You must customize some bug-reference variables; see Emacs info node Bug
Reference"))
(if (and (not (integerp pos)) (eventp pos))
;; POS is a mouse event; switch to the proper window/buffer
(let ((posn (event-start pos)))
@@ -178,6 +184,22 @@ The second subexpression should match the bug reference
(usually a number)."
"/issues/"
(match-string 2))))))
;;
+ ;; Codeberg projects.
+ ;;
+ ;; The systematics is exactly as for Github projects.
+ ("[/@]codeberg.org[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
+ "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
+ ,(lambda (groups)
+ (let ((ns-project (nth 1 groups)))
+ (lambda ()
+ (concat "https://codeberg.org/";
+ (or
+ ;; Explicit user/proj#18 link.
+ (match-string 1)
+ ns-project)
+ "/issues/"
+ (match-string 2))))))
+ ;;
;; GitLab projects.
;;
;; Here #18 is an issue and !17 is a merge request. Explicit
@@ -195,6 +217,30 @@ The second subexpression should match the bug reference
(usually a number)."
(if (string= (match-string 3) "#")
"issues/"
"merge_requests/")
+ (match-string 2))))))
+ ;;
+ ;; Sourcehut projects.
+ ;;
+ ;; #19 is an issue. Other project's issues can be referenced as
+ ;; #~user/project#19.
+ ;;
+ ;; Caveat: The code assumes that a project on git.sr.ht or
+ ;; hg.sr.ht has a tracker of the same name on todo.sh.ht. That's
+ ;; a very common setup but all sr.ht services are loosely coupled,
+ ;; so you can have a repo without tracker, or a repo with a
+ ;; tracker using a different name, etc. So we can only try to
+ ;; make a good guess.
+ ("[/@]\\(?:git\\|hg\\).sr.ht[/:]\\(~[.A-Za-z0-9_/-]+\\)"
+ "\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
+ ,(lambda (groups)
+ (let ((ns-project (nth 1 groups)))
+ (lambda ()
+ (concat "https://todo.sr.ht/";
+ (or
+ ;; Explicit user/proj#18 link.
+ (match-string 1)
+ ns-project)
+ "/"
(match-string 2)))))))
"An alist for setting up `bug-reference-mode' based on VC URL.
@@ -299,6 +345,7 @@ and set it if applicable."
(defvar gnus-article-buffer)
(defvar gnus-original-article-buffer)
(defvar gnus-summary-buffer)
+(defvar bug-reference-mode)
(defun bug-reference--try-setup-gnus-article ()
(when (and bug-reference-mode ;; Only if enabled in article buffers.
@@ -362,7 +409,7 @@ From, and Cc against HEADER-REGEXP in
(defvar bug-reference-setup-from-irc-alist
`((,(concat "#" (regexp-opt '("emacs" "gnus" "org-mode" "rcirc"
"erc") 'words))
- "freenode"
+ "Libera.Chat"
"\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
"https://debbugs.gnu.org/%s";))
"An alist for setting up `bug-reference-mode' in IRC modes.
@@ -377,8 +424,8 @@ Each element has the form
CHANNEL-REGEXP is a regexp matched against the current IRC
channel name (e.g. #emacs). NETWORK-REGEXP is matched against
-the IRC network name (e.g. freenode). Both entries are optional.
-If all given entries match, BUG-REGEXP is set as
+the IRC network name (e.g. Libera.Chat). Both entries are
+optional. If all given entries match, BUG-REGEXP is set as
`bug-reference-bug-regexp' and URL-FORMAT is set as
`bug-reference-url-format'.")
diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el
index edcd88c..0f7c8c6 100644
--- a/lisp/progmodes/cmacexp.el
+++ b/lisp/progmodes/cmacexp.el
@@ -141,7 +141,7 @@ Normally display output in temp buffer, but
prefix arg means replace the region with it.
`c-macro-preprocessor' specifies the preprocessor to use.
-Tf the user option `c-macro-prompt-flag' is non-nil
+If the user option `c-macro-prompt-flag' is non-nil
prompt for arguments to the preprocessor \(e.g. `-DDEBUG -I ./include'),
otherwise use `c-macro-cppflags'.
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 7a02c3a..1fb6124 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -173,6 +173,7 @@ and a string describing how the process finished.")
;; emacs -batch -l compile-tests.el -f ert-run-tests-batch-and-exit
(defvar compilation-error-regexp-alist-alist
+ (eval-when-compile
`((absoft
"^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[
\t]+\
of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
@@ -615,7 +616,7 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column =
\\([0-9]+\\)\\)?"
;; we do not know what lines will follow.
(guile-file "^In \\(.+\\..+\\):\n" 1 nil nil 0)
(guile-line "^ *\\([0-9]+\\): *\\([0-9]+\\)" nil 1 2)
- )
+ ))
"Alist of values for `compilation-error-regexp-alist'.")
(defcustom compilation-error-regexp-alist
@@ -1248,11 +1249,14 @@ POS and RES.")
(setq col (match-string-no-properties col))
(string-to-number col))))
(setq end-col
- (or (if (functionp end-col) (funcall end-col)
- (and end-col
- (setq end-col (match-string-no-properties end-col))
- (- (string-to-number end-col) -1)))
- (and end-line -1)))
+ (let ((ec (if (functionp end-col)
+ (funcall end-col)
+ (and end-col (match-beginning end-col)
+ (string-to-number
+ (match-string-no-properties end-col))))))
+ (if ec
+ (1+ ec) ; Add one to get an exclusive upper bound.
+ (and end-line -1))))
(if (consp type) ; not a static type, check what it is.
(setq type (or (and (car type) (match-end (car type)) 1)
(and (cdr type) (match-end (cdr type)) 0)
@@ -1540,7 +1544,7 @@ to `compilation-error-regexp-alist' if RULES is nil."
file line end-line col end-col
(or type 2) fmt rule))
- (when (integerp file)
+ (when file
(let ((this-type (if (consp type)
(compilation-type type)
(or type 2))))
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index a56c709..542f8ad 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -696,7 +696,7 @@ Each function should return a list of xrefs, or nil; the
first
non-nil result supersedes the xrefs produced by
`elisp--xref-find-definitions'.")
-(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier)
+(cl-defmethod xref-backend-definitions ((_backend (eql 'elisp)) identifier)
(require 'find-func)
;; FIXME: use information in source near point to filter results:
;; (dvc-log-edit ...) - exclude 'feature
@@ -875,7 +875,7 @@ non-nil result supersedes the xrefs produced by
(declare-function xref-apropos-regexp "xref" (pattern))
-(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) pattern)
+(cl-defmethod xref-backend-apropos ((_backend (eql 'elisp)) pattern)
(apply #'nconc
(let ((regexp (xref-apropos-regexp pattern))
lst)
@@ -893,7 +893,8 @@ non-nil result supersedes the xrefs produced by
(facep sym)))
'strict))
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql elisp)))
+(cl-defmethod xref-backend-identifier-completion-table ((_backend
+ (eql 'elisp)))
elisp--xref-identifier-completion-table)
(cl-defstruct (xref-elisp-location
@@ -1325,8 +1326,7 @@ Reinitialize the face according to the `defface'
specification."
((eq (car form) 'custom-declare-face)
;; Reset the face.
(let ((face-symbol (eval (nth 1 form) lexical-binding)))
- (setq face-new-frame-defaults
- (assq-delete-all face-symbol face-new-frame-defaults))
+ (remhash face-symbol face--new-frame-defaults)
(put face-symbol 'face-defface-spec nil)
(put face-symbol 'face-override-spec nil))
form)
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index f0180ce..a1f806a 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2059,22 +2059,43 @@ for \\[find-tag] (which see)."
If you want `xref-find-definitions' to find the tagged files by their
file name, add `tag-partial-file-name-match-p' to the list value.")
+(defcustom etags-xref-prefer-current-file nil
+ "Non-nil means show the matches in the current file first."
+ :type 'boolean
+ :version "28.1")
+
;;;###autoload
(defun etags--xref-backend () 'etags)
-(cl-defmethod xref-backend-identifier-at-point ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql 'etags)))
(find-tag--default))
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-completion-table ((_backend
+ (eql 'etags)))
(tags-lazy-completion-table))
-(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend (eql
etags)))
+(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend
+ (eql 'etags)))
(find-tag--completion-ignore-case))
-(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol)
- (etags--xref-find-definitions symbol))
-
-(cl-defmethod xref-backend-apropos ((_backend (eql etags)) pattern)
+(cl-defmethod xref-backend-definitions ((_backend (eql 'etags)) symbol)
+ (let ((file (and buffer-file-name (expand-file-name buffer-file-name)))
+ (definitions (etags--xref-find-definitions symbol))
+ same-file-definitions)
+ (when (and etags-xref-prefer-current-file file)
+ (cl-delete-if
+ (lambda (definition)
+ (when (equal file
+ (xref-location-group
+ (xref-item-location definition)))
+ (push definition same-file-definitions)
+ t))
+ definitions)
+ (setq definitions (nconc (nreverse same-file-definitions)
+ definitions)))
+ definitions))
+
+(cl-defmethod xref-backend-apropos ((_backend (eql 'etags)) pattern)
(etags--xref-find-definitions (xref-apropos-regexp pattern) t))
(defun etags--xref-find-definitions (pattern &optional regexp?)
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index e10602a..77a807f 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -1245,13 +1245,13 @@ correctly.")
"Flymake"
mouse-face mode-line-highlight
help-echo
- (lambda (&rest whatever)
- (concat
- (format "%s known backends\n" (hash-table-count flymake--backend-state))
- (format "%s running\n" (length (flymake-running-backends)))
- (format "%s disabled\n" (length (flymake-disabled-backends)))
- "mouse-1: Display minor mode menu\n"
- "mouse-2: Show help for minor mode"))
+ ,(lambda (&rest _)
+ (concat
+ (format "%s known backends\n" (hash-table-count
flymake--backend-state))
+ (format "%s running\n" (length (flymake-running-backends)))
+ (format "%s disabled\n" (length (flymake-disabled-backends)))
+ "mouse-1: Display minor mode menu\n"
+ "mouse-2: Show help for minor mode"))
keymap
,(let ((map (make-sparse-keymap)))
(define-key map [mode-line down-mouse-1]
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index aa33652..b9c8305 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -581,6 +581,23 @@ stopped thread is already selected."
:group 'gdb-buffers
:version "23.2")
+(defcustom gdb-registers-enable-filter nil
+ "If non-nil, enable register name filter in register buffer.
+Use `gdb-registers-filter-pattern-list' to control what register to
+filter."
+ :type 'boolean
+ :group 'gdb-buffers
+ :version "28.1")
+
+(defcustom gdb-registers-filter-pattern-list nil
+ "Patterns for names that are displayed in register buffer.
+Each pattern is a regular expression. GDB displays registers
+whose name matches any pattern in the list. Refresh the register
+buffer for the change to take effect."
+ :type '(repeat regexp)
+ :group 'gdb-buffers
+ :version "28.1")
+
(defvar gdb-debug-log nil
"List of commands sent to and replies received from GDB.
Most recent commands are listed first. This list stores only the last
@@ -979,6 +996,8 @@ detailed description of this mode.
(define-key gud-minor-mode-map [left-margin C-mouse-3]
'gdb-mouse-jump)
+ (gud-set-repeat-map-property 'gud-gdb-repeat-map)
+
(setq-local gud-gdb-completion-function 'gud-gdbmi-completions)
(add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
@@ -4393,6 +4412,26 @@ member."
'gdb-registers-mode
'gdb-invalidate-registers)
+(defun gdb-header-click-event-handler (function)
+ "Return a function that handles clicking event on gdb header buttons.
+
+This function switches to the window where the header locates and
+executes FUNCTION."
+ (lambda (event)
+ (interactive "e")
+ (save-selected-window
+ ;; Make sure we are in the right buffer.
+ (select-window (posn-window (event-start event)))
+ (funcall function))))
+
+(defun gdb-registers-toggle-filter ()
+ "Toggle register filter."
+ (interactive)
+ (setq gdb-registers-enable-filter
+ (not gdb-registers-enable-filter))
+ ;; Update the register buffer.
+ (gdb-invalidate-registers 'update))
+
(defun gdb-registers-handler-custom ()
(when gdb-register-names
(let ((register-values
@@ -4403,17 +4442,27 @@ member."
(value (gdb-mi--field register 'value))
(register-name (nth (string-to-number register-number)
gdb-register-names)))
- (gdb-table-add-row
- table
- (list
- (propertize register-name
- 'font-lock-face font-lock-variable-name-face)
- (if (member register-number gdb-changed-registers)
- (propertize value 'font-lock-face font-lock-warning-face)
- value))
- `(mouse-face highlight
- help-echo "mouse-2: edit value"
- gdb-register-name ,register-name))))
+ ;; Add register if `gdb-registers-filter-pattern-list' is nil;
+ ;; or any pattern that `gdb-registers-filter-pattern-list'
+ ;; matches.
+ (when (or (null gdb-registers-enable-filter)
+ ;; Return t if any register name matches a pattern.
+ (cl-loop for pattern
+ in gdb-registers-filter-pattern-list
+ if (string-match pattern register-name)
+ return t
+ finally return nil))
+ (gdb-table-add-row
+ table
+ (list
+ (propertize register-name
+ 'font-lock-face font-lock-variable-name-face)
+ (if (member register-number gdb-changed-registers)
+ (propertize value 'font-lock-face font-lock-warning-face)
+ value))
+ `(mouse-face highlight
+ help-echo "mouse-2: edit value"
+ gdb-register-name ,register-name)))))
(insert (gdb-table-string table " ")))
(setq mode-name
(gdb-current-context-mode-name "Registers"))))
@@ -4441,6 +4490,7 @@ member."
(gdb-get-buffer-create
'gdb-locals-buffer
gdb-thread-number) t)))
+ (define-key map "f" #'gdb-registers-toggle-filter)
map))
(defvar gdb-registers-header
@@ -4450,7 +4500,31 @@ member."
mode-line-inactive)
" "
(gdb-propertize-header "Registers" gdb-registers-buffer
- nil nil mode-line)))
+ nil nil mode-line)
+ " "
+ '(:eval
+ (format
+ "[filter %s %s]"
+ (propertize
+ (if gdb-registers-enable-filter "[on]" "[off]")
+ 'face (if gdb-registers-enable-filter
+ '(:weight bold :inherit success)
+ 'shadow)
+ 'help-echo "mouse-1: toggle filter"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (gdb-make-header-line-mouse-map
+ 'mouse-1 (gdb-header-click-event-handler
+ #'gdb-registers-toggle-filter)))
+ (propertize
+ "[set]"
+ 'face 'mode-line
+ 'help-echo "mouse-1: Customize filter patterns"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (gdb-make-header-line-mouse-map
+ 'mouse-1 (lambda ()
+ (interactive)
+ (customize-variable-other-window
+ 'gdb-registers-filter-pattern-list))))))))
(define-derived-mode gdb-registers-mode gdb-parent-mode "Registers"
"Major mode for gdb registers."
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 462ea51..8f0a5ac 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -389,7 +389,7 @@ Notice that using \\[next-error] or \\[compile-goto-error]
modifies
(and mbeg (next-single-property-change
mbeg 'font-lock-face nil end))))
(when mend
- (- mend beg))))))
+ (- mend beg 1))))))
nil nil
(3 '(face nil display ":")))
("^Binary file \\(.+\\) matches" 1 nil nil 0 1))
@@ -1345,6 +1345,13 @@ command before it's run."
(grep-highlight-matches 'always))
(rgrep regexp files dir confirm)))
+(defun grep-file-at-point (point)
+ "Return the name of the file at POINT a `grep-mode' buffer.
+The returned file name is relative."
+ (when-let ((msg (get-text-property point 'compilation-message))
+ (loc (compilation--message->loc msg)))
+ (caar (compilation--loc->file-struct loc))))
+
;;;###autoload
(defalias 'rzgrep 'zrgrep)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 740a6e2..05ad82a 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -320,10 +320,32 @@ Used to gray out relevant toolbar icons.")
(tool-bar-local-item-from-menu
(car x) (cdr x) map gud-minor-mode-map))))
-(defvar gud-repeat-map (make-sparse-keymap)
- "Keymap to repeat gud stepping instructions `C-x C-a C-n n n'.
+(defvar gud-gdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `gud-gdb' stepping instructions `C-x C-a C-n n n'.
Used in `repeat-mode'.")
+(defun gud-set-repeat-map-property (keymap-symbol)
+ "Set the `repeat-map' property of relevant gud commands to KEYMAP-SYMBOL.
+
+KEYMAP-SYMBOL is a symbol corresponding to some
+`<FOO>-repeat-map', a keymap containing gud commands that may be
+repeated when `repeat-mode' is on."
+ (map-keymap-internal (lambda (_ cmd)
+ (put cmd 'repeat-map keymap-symbol))
+ (symbol-value keymap-symbol)))
+
+
(defun gud-file-name (f)
"Transform a relative file name to an absolute file name.
Uses `gud-<MINOR-MODE>-directories' to find the source files."
@@ -814,16 +836,7 @@ the buffer in which this command was invoked."
(gud-def gud-until "until %l" "\C-u" "Continue to current line.")
(gud-def gud-run "run" nil "Run the program.")
- (dolist (cmd '(("n" . gud-next)
- ("s" . gud-step)
- ("i" . gud-stepi)
- ("c" . gud-cont)
- ("l" . gud-refresh)
- ("f" . gud-finish)
- ("<" . gud-up)
- (">" . gud-down)))
- (define-key gud-repeat-map (car cmd) (cdr cmd))
- (put (cdr cmd) 'repeat-map 'gud-repeat-map))
+ (gud-set-repeat-map-property 'gud-gdb-repeat-map)
(add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
nil 'local)
@@ -1024,6 +1037,18 @@ SKIP is the number of chars to skip on each line, it
defaults to 0."
(defvar gud-sdb-lastfile nil)
+(defvar gud-sdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `sdb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defun gud-sdb-marker-filter (string)
(setq gud-marker-acc
(if gud-marker-acc (concat gud-marker-acc string) string))
@@ -1094,6 +1119,8 @@ and source-file directory for your debugger."
(gud-def gud-cont "c" "\C-r" "Continue with display.")
(gud-def gud-print "%e/" "\C-p" "Evaluate C expression at point.")
+ (gud-set-repeat-map-property 'gud-sdb-repeat-map)
+
(setq comint-prompt-regexp "\\(^\\|\n\\)\\*")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'sdb-mode-hook)
@@ -1252,6 +1279,23 @@ whereby $stopformat=1 produces an output format
compatible with
;; whereby `set $stopformat=1' reportedly produces output compatible
;; with `gud-dbx-marker-filter', which we prefer.
+(defvar gud-dbx-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ (when (or gud-mips-p
+ gud-irix-p)
+ (define-key map "f" 'gud-finish))
+ map)
+ "Keymap to repeat `dbx' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
;; The process filter is also somewhat
;; unreliable, sometimes not spotting the markers; I don't know
;; whether there's anything that can be done about that.]
@@ -1399,6 +1443,8 @@ and source-file directory for your debugger."
(gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.")
(gud-def gud-run "run" nil "Run the program.")
+ (gud-set-repeat-map-property 'gud-dbx-repeat-map)
+
(setq comint-prompt-regexp "^[^)\n]*dbx) *")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'dbx-mode-hook)
@@ -1410,6 +1456,21 @@ and source-file directory for your debugger."
;; History of argument lists passed to xdb.
(defvar gud-xdb-history nil)
+(defvar gud-xdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `xdb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defcustom gud-xdb-directories nil
"A list of directories that xdb should search for source code.
If nil, only source files in the program directory
@@ -1475,6 +1536,8 @@ directories if your program contains sources from more
than one directory."
(gud-def gud-finish "bu\\t" "\C-f" "Finish executing current function.")
(gud-def gud-print "p %e" "\C-p" "Evaluate C expression at point.")
+ (gud-set-repeat-map-property 'gud-xdb-repeat-map)
+
(setq comint-prompt-regexp "^>")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'xdb-mode-hook))
@@ -1485,6 +1548,17 @@ directories if your program contains sources from more
than one directory."
;; History of argument lists passed to perldb.
(defvar gud-perldb-history nil)
+(defvar gud-perldb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `perldb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defun gud-perldb-massage-args (_file args)
"Convert a command line as would be typed normally to run perldb
into one that invokes an Emacs-enabled debugging session.
@@ -1627,6 +1701,7 @@ and source-file directory for your debugger."
(gud-def gud-print "p %e" "\C-p" "Evaluate perl expression at
point.")
(gud-def gud-until "c %l" "\C-u" "Continue to current line.")
+ (gud-set-repeat-map-property 'gud-perldb-repeat-map)
(setq comint-prompt-regexp "^ DB<+[0-9]+>+ ")
(setq paragraph-start comint-prompt-regexp)
@@ -1655,6 +1730,20 @@ and source-file directory for your debugger."
(defvar gud-pdb-marker-regexp-start "^> ")
+(defvar gud-pdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `pdb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
;; There's no guarantee that Emacs will hand the filter the entire
;; marker at once; it could be broken up across several strings. We
;; might even receive a big chunk with several markers in it. If we
@@ -1744,6 +1833,8 @@ directory and source-file directory for your debugger."
(gud-def gud-print "p %e" "\C-p" "Evaluate Python expression at
point.")
(gud-def gud-statement "!%e" "\C-e" "Execute Python statement at
point.")
+ (gud-set-repeat-map-property 'gud-pdb-repeat-map)
+
;; (setq comint-prompt-regexp "^(.*pdb[+]?) *")
(setq comint-prompt-regexp "^(Pdb) *")
(setq paragraph-start comint-prompt-regexp)
@@ -1757,6 +1848,19 @@ directory and source-file directory for your debugger."
(defvar gud-guiler-lastfile nil)
+(defvar gud-guiler-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("l" . gud-refresh)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `guiler' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defun gud-guiler-marker-filter (string)
(setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string)
string))
@@ -1822,6 +1926,8 @@ and source-file directory for your debugger."
(gud-def gud-down ",down" ">" "Down one stack frame.")
(gud-def gud-print "%e" "\C-p" "Evaluate Guile expression at
point.")
+ (gud-set-repeat-map-property 'gud-guiler-repeat-map)
+
(setq comint-prompt-regexp "^scheme@([^>]+> ")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'guiler-mode-hook))
@@ -2267,6 +2373,21 @@ extension EXTN. Normally EXTN is given as the regular
expression
;; Note: Reset to this value every time a prompt is seen
(defvar gud-jdb-lowest-stack-level 999)
+(defvar gud-jdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)
+ ("l" . gud-refresh)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `jdb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defun gud-jdb-find-source-using-classpath (p)
"Find source file corresponding to fully qualified class P.
Convert P from jdb's output, converted to a pathname
@@ -2475,6 +2596,8 @@ gud, see `gud-mode'."
(gud-def gud-print "print %e" "\C-p" "Print value of expression at point.")
(gud-def gud-pstar "dump %e" nil "Print all object information at point.")
+ (gud-set-repeat-map-property 'gud-jdb-repeat-map)
+
(setq comint-prompt-regexp "^> \\|^[^ ]+\\[[0-9]+\\] ")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'jdb-mode-hook)
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index 0a72ae9..e69a9ff 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -62,6 +62,7 @@
(require 'comint)
(require 'lisp-mode)
+(require 'shell)
(defgroup inferior-lisp nil
@@ -289,15 +290,20 @@ to continue it."
"Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'.
If there is a process already running in `*inferior-lisp*', just switch
to that buffer.
+
With argument, allows you to edit the command line (default is value
of `inferior-lisp-program'). Runs the hooks from
`inferior-lisp-mode-hook' (after the `comint-mode-hook' is run).
+
+If any parts of the command name contains spaces, they should be
+quoted using shell quote syntax.
+
\(Type \\[describe-mode] in the process buffer for a list of commands.)"
(interactive (list (if current-prefix-arg
(read-string "Run lisp: " inferior-lisp-program)
inferior-lisp-program)))
(if (not (comint-check-proc "*inferior-lisp*"))
- (let ((cmdlist (split-string cmd)))
+ (let ((cmdlist (split-string-shell-command cmd)))
(set-buffer (apply (function make-comint)
"inferior-lisp" (car cmdlist) nil (cdr cmdlist)))
(inferior-lisp-mode)))
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 3f466e1..4d27775 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -272,7 +272,7 @@ not be enclosed in { } or ( )."
"Regex used to find macro assignment lines in a makefile.")
(defconst makefile-var-use-regex
- "[^$]\\$[({]\\([-a-zA-Z0-9_.]+\\|[@%<?^+*][FD]?\\)"
+ "\\(^\\|[^$]\\)\\$[({]\\([-a-zA-Z0-9_.]+\\|[@%<?^+*][FD]?\\)"
"Regex used to find $(macro) uses in a makefile.")
(defconst makefile-ignored-files-in-pickup-regex
@@ -346,7 +346,7 @@ not be enclosed in { } or ( )."
(3 font-lock-builtin-face prepend t))
;; Variable references even in targets/strings/comments.
- (,var 1 font-lock-variable-name-face prepend)
+ (,var 2 font-lock-variable-name-face prepend)
;; Automatic variable references and single character variable references,
;; but not shell variables references.
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index f49ee4c..4e14c30 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -178,6 +178,14 @@
(defconst perl-font-lock-keywords-2
(append
+ '(;; Fontify function, variable and file name references. They have to be
+ ;; handled first because they might conflict with keywords.
+ ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
+ ;; Additionally fontify non-scalar variables. `perl-non-scalar-variable'
+ ;; will underline them by default.
+ ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
+ ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
+ (2 'perl-non-scalar-variable)))
perl-font-lock-keywords-1
`( ;; Fontify keywords, except those fontified otherwise.
,(concat "\\<"
@@ -188,15 +196,6 @@
;;
;; Fontify declarators and prefixes as types.
("\\<\\(has\\|local\\|my\\|our\\|state\\)\\>" . font-lock-keyword-face) ;
declarators
- ;;
- ;; Fontify function, variable and file name references.
- ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
- ;; Additionally fontify non-scalar variables. `perl-non-scalar-variable'
- ;; will underline them by default.
- ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face)
- ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
- ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
- (2 'perl-non-scalar-variable))
("<\\(\\sw+\\)>" 1 font-lock-constant-face)
;;
;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index fbdf010..714edeb 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -908,23 +908,16 @@ PREDICATE, HIST, and DEFAULT have the same meaning as in
(defun project--completing-read-strict (prompt
collection &optional predicate
hist default)
- ;; Tried both expanding the default before showing the prompt, and
- ;; removing it when it has no matches. Neither seems natural
- ;; enough. Removal is confusing; early expansion makes the prompt
- ;; too long.
- (let* ((new-prompt (if (and default (not (string-equal default "")))
- (format "%s (default %s): " prompt default)
- (format "%s: " prompt)))
- (res (completing-read new-prompt
- collection predicate t
- nil ;; initial-input
- hist default)))
- (when (and (equal res default)
- (not (test-completion res collection predicate)))
- (setq res
- (completing-read (format "%s: " prompt)
- collection predicate t res hist nil)))
- res))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq-local minibuffer-default-add-function
+ (lambda ()
+ (let ((minibuffer-default default))
+ (minibuffer-default-add-completions)))))
+ (completing-read (format "%s: " prompt)
+ collection predicate 'confirm
+ nil
+ hist)))
;;;###autoload
(defun project-dired ()
@@ -1415,8 +1408,8 @@ to directory DIR."
(define-key temp-map (vector keychar) cmd)))))
command)
(while (not command)
- (let ((overriding-local-map commands-map)
- (choice (read-key-sequence (project--keymap-prompt))))
+ (let* ((overriding-local-map commands-map)
+ (choice (read-key-sequence (project--keymap-prompt))))
(when (setq command (lookup-key commands-map choice))
(unless (or project-switch-use-entire-map
(assq command commands-menu))
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 29cce51..0b520e3 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -1315,6 +1315,7 @@ With prefix argument ARG, restart the Prolog process if
running before."
(progn
(process-send-string "prolog" "halt.\n")
(while (get-process "prolog") (sit-for 0.1))))
+ (prolog-ensure-process)
(let ((buff (buffer-name)))
(if (not (string= buff "*prolog*"))
(prolog-goto-prolog-process-buffer))
@@ -1324,7 +1325,6 @@ With prefix argument ARG, restart the Prolog process if
running before."
prolog-use-sicstus-sd)
(prolog-enable-sicstus-sd))
(prolog-mode-variables)
- (prolog-ensure-process)
))
(defun prolog-inferior-guess-flavor (&optional ignored)
@@ -1349,56 +1349,57 @@ With prefix argument ARG, restart the Prolog process if
running before."
"If Prolog process is not running, run it.
If the optional argument WAIT is non-nil, wait for Prolog prompt specified by
the variable `prolog-prompt-regexp'."
- (if (null (prolog-program-name))
- (error "This Prolog system has defined no interpreter."))
- (if (comint-check-proc "*prolog*")
- ()
- (with-current-buffer (get-buffer-create "*prolog*")
- (prolog-inferior-mode)
-
- ;; The "INFERIOR=yes" hack is for SWI-Prolog 7.2.3 and earlier,
- ;; which assumes it is running under Emacs if either INFERIOR=yes or
- ;; if EMACS is set to a nonempty value. The EMACS setting is
- ;; obsolescent, so set INFERIOR. Newer versions of SWI-Prolog should
- ;; know about INSIDE_EMACS (which replaced EMACS) and should not need
- ;; this hack.
- (let ((process-environment
- (if (getenv "INFERIOR")
- process-environment
- (cons "INFERIOR=yes" process-environment))))
- (apply 'make-comint-in-buffer "prolog" (current-buffer)
- (prolog-program-name) nil (prolog-program-switches)))
-
- (unless prolog-system
- ;; Setup auto-detection.
- (setq-local
- prolog-system
- ;; Force re-detection.
- (let* ((proc (get-buffer-process (current-buffer)))
- (pmark (and proc (marker-position (process-mark proc)))))
- (cond
- ((null pmark) (1- (point-min)))
- ;; The use of insert-before-markers in comint.el together with
- ;; the potential use of comint-truncate-buffer in the output
- ;; filter, means that it's difficult to reliably keep track of
- ;; the buffer position where the process's output started.
- ;; If possible we use a marker at "start - 1", so that
- ;; insert-before-marker at `start' won't shift it. And if not,
- ;; we fall back on using a plain integer.
- ((> pmark (point-min)) (copy-marker (1- pmark)))
- (t (1- pmark)))))
- (add-hook 'comint-output-filter-functions
- 'prolog-inferior-guess-flavor nil t))
- (if wait
- (progn
- (goto-char (point-max))
- (while
- (save-excursion
- (not
- (re-search-backward
- (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=")
- nil t)))
- (sit-for 0.1)))))))
+ (let ((pname (prolog-program-name))
+ (pswitches (prolog-program-switches)))
+ (if (null pname)
+ (error "This Prolog system has defined no interpreter."))
+ (unless (comint-check-proc "*prolog*")
+ (with-current-buffer (get-buffer-create "*prolog*")
+ (prolog-inferior-mode)
+
+ ;; The "INFERIOR=yes" hack is for SWI-Prolog 7.2.3 and earlier,
+ ;; which assumes it is running under Emacs if either INFERIOR=yes or
+ ;; if EMACS is set to a nonempty value. The EMACS setting is
+ ;; obsolescent, so set INFERIOR. Newer versions of SWI-Prolog should
+ ;; know about INSIDE_EMACS (which replaced EMACS) and should not need
+ ;; this hack.
+ (let ((process-environment
+ (if (getenv "INFERIOR")
+ process-environment
+ (cons "INFERIOR=yes" process-environment))))
+ (apply 'make-comint-in-buffer "prolog" (current-buffer)
+ pname nil pswitches))
+
+ (unless prolog-system
+ ;; Setup auto-detection.
+ (setq-local
+ prolog-system
+ ;; Force re-detection.
+ (let* ((proc (get-buffer-process (current-buffer)))
+ (pmark (and proc (marker-position (process-mark proc)))))
+ (cond
+ ((null pmark) (1- (point-min)))
+ ;; The use of insert-before-markers in comint.el together with
+ ;; the potential use of comint-truncate-buffer in the output
+ ;; filter, means that it's difficult to reliably keep track of
+ ;; the buffer position where the process's output started.
+ ;; If possible we use a marker at "start - 1", so that
+ ;; insert-before-marker at `start' won't shift it. And if not,
+ ;; we fall back on using a plain integer.
+ ((> pmark (point-min)) (copy-marker (1- pmark)))
+ (t (1- pmark)))))
+ (add-hook 'comint-output-filter-functions
+ 'prolog-inferior-guess-flavor nil t))
+ (if wait
+ (progn
+ (goto-char (point-max))
+ (while
+ (save-excursion
+ (not
+ (re-search-backward
+ (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=")
+ nil t)))
+ (sit-for 0.1))))))))
(defun prolog-inferior-buffer (&optional dont-run)
(or (get-buffer "*prolog*")
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index f7267bd..2557704 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -54,14 +54,7 @@
;; `python-nav-backward-statement',
;; `python-nav-beginning-of-statement', `python-nav-end-of-statement',
;; `python-nav-beginning-of-block', `python-nav-end-of-block' and
-;; `python-nav-if-name-main' are included but no bound to any key. At
-;; last but not least the specialized `python-nav-forward-sexp' allows
-;; easy navigation between code blocks. If you prefer `cc-mode'-like
-;; `forward-sexp' movement, setting `forward-sexp-function' to nil is
-;; enough, You can do that using the `python-mode-hook':
-
-;; (add-hook 'python-mode-hook
-;; (lambda () (setq forward-sexp-function nil)))
+;; `python-nav-if-name-main' are included but no bound to any key.
;; Shell interaction: is provided and allows opening Python shells
;; inside Emacs and executing any block of code of your current buffer
@@ -5505,6 +5498,13 @@ By default messages are considered errors."
:type '(alist :key-type (regexp)
:value-type (symbol)))
+(defcustom python-forward-sexp-function #'python-nav-forward-sexp
+ "Function to use when navigating between expressions."
+ :version "28.1"
+ :type '(choice (const :tag "Python blocks" python-nav-forward-sexp)
+ (const :tag "CC-mode like" nil)
+ function))
+
(defvar-local python--flymake-proc nil)
(defun python--flymake-parse-output (source proc report-fn)
@@ -5602,7 +5602,7 @@ REPORT-FN is Flymake's callback function."
(setq-local parse-sexp-lookup-properties t)
(setq-local parse-sexp-ignore-comments t)
- (setq-local forward-sexp-function #'python-nav-forward-sexp)
+ (setq-local forward-sexp-function python-forward-sexp-function)
(setq-local font-lock-defaults
`(,python-font-lock-keywords
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index c3a12c5..91db4ae 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -2192,6 +2192,8 @@ Point should be before the newline."
When used interactively, insert the proper starting #!-line,
and make the visited file executable via `executable-set-magic',
perhaps querying depending on the value of `executable-query'.
+(If given a prefix (i.e., `C-u') don't insert any starting #!
+line.)
When this function is called noninteractively, INSERT-FLAG (the third
argument) controls whether to insert a #!-line and think about making
@@ -2215,7 +2217,7 @@ whose value is the shell name (don't quote it)."
'("csh" "rc" "sh"))
nil nil nil nil sh-shell-file)
(eq executable-query 'function)
- t))
+ (not current-prefix-arg)))
(if (string-match "\\.exe\\'" shell)
(setq shell (substring shell 0 (match-beginning 0))))
(setq sh-shell (sh-canonicalize-shell shell))
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 2b88120..7c8ccea 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -5112,7 +5112,6 @@ primitive or interface named NAME."
(;- task/function/initial et cetera
t
- (match-end 0)
(goto-char (match-end 0))
(setq there (point))
(setq err nil)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index b7a926f..69378a5 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -657,7 +657,7 @@ quit the *xref* buffer."
(interactive "P")
(let* ((buffer (current-buffer))
(xref (or (xref--item-at-point)
- (user-error "No reference at point")))
+ (user-error "Choose a reference to visit")))
(xref--current-item xref))
(xref--show-location (xref-item-location xref) (if quit 'quit t))
(if (fboundp 'next-error-found)
@@ -959,12 +959,15 @@ GROUP is a string for decoration purposes and XREF is an
(prefix
(cond
((not line) " ")
- ((equal line prev-line) "")
+ ((and (equal line prev-line)
+ (equal prev-group group))
+ "")
(t (propertize (format line-format line)
'face 'xref-line-number)))))
;; Render multiple matches on the same line, together.
(when (and (equal prev-group group)
- (not (equal prev-line line)))
+ (or (null line)
+ (not (equal prev-line line))))
(insert "\n"))
(xref--insert-propertized
(list 'xref-item xref
@@ -1353,7 +1356,9 @@ This command is intended to be bound to a mouse event."
The argument has the same meaning as in `apropos'."
(interactive (list (read-string
"Search for pattern (word list or regexp): "
- nil 'xref--read-pattern-history)))
+ nil 'xref--read-pattern-history
+ (xref-backend-identifier-at-point
+ (xref-find-backend)))))
(require 'apropos)
(let* ((newpat
(if (and (version< emacs-version "28.0.50")
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index fcc6e1f..1b8654e 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -6506,10 +6506,11 @@ If FACE is not a valid face name, use default face."
(and (buffer-live-p ps-buffer)
(buffer-modified-p ps-buffer)
(not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
- (error "Unprinted PostScript"))))
+ (error "Unprinted PostScript")))
+ t)
(unless noninteractive
- (add-hook 'kill-emacs-hook #'ps-kill-emacs-check))
+ (add-hook 'kill-emacs-query-functions #'ps-kill-emacs-check))
(provide 'ps-print)
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 503cb34..cec3cb6 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -397,7 +397,7 @@ When Repeat mode is enabled, and the command symbol has the
property named
(and (commandp s)
(get s 'repeat-map)
(push (get s 'repeat-map) keymaps))))))
- (message "Repeat mode is enabled for %d commands and %d keymaps; see
`describe-repeat'."
+ (message "Repeat mode is enabled for %d commands and %d keymaps; see
`describe-repeat-maps'."
(length commands)
(length (delete-dups keymaps))))))
@@ -489,10 +489,10 @@ When Repeat mode is enabled, and the command symbol has
the property named
repeat-echo-mode-line-string)))
(force-mode-line-update t)))
-(defun describe-repeat ()
- "Describe repeatable commands and keymaps."
+(defun describe-repeat-maps ()
+ "Describe mappings of commands repeatable by symbol property `repeat-map'."
(interactive)
- (help-setup-xref (list #'describe-repeat)
+ (help-setup-xref (list #'describe-repeat-maps)
(called-interactively-p 'interactive))
(let ((keymaps nil))
(all-completions
@@ -502,7 +502,7 @@ When Repeat mode is enabled, and the command symbol has the
property named
(push s (alist-get (get s 'repeat-map) keymaps)))))
(with-help-window (help-buffer)
(with-current-buffer standard-output
- (princ "This is a list of repeatable keymaps and commands.\n\n")
+ (princ "A list of keymaps used by commands with the symbol property
`repeat-map'.\n\n")
(dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car
b)))))
(princ (format-message "`%s' keymap is repeatable by these
commands:\n"
diff --git a/lisp/replace.el b/lisp/replace.el
index fe2cbc4..ee46286 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -792,12 +792,8 @@ which will run faster and will not set the mark or print
anything."
Maximum length of the history list is determined by the value
of `history-length', which see.")
-(defvar occur-highlight-regexp t
- "Regexp matching part of visited source lines to highlight temporarily.
-Highlight entire line if t; don't highlight source lines if nil.")
-
-(defvar occur-highlight-overlay nil
- "Overlay used to temporarily highlight occur matches.")
+(defvar occur-highlight-overlays nil
+ "Overlays used to temporarily highlight occur matches.")
(defvar occur-collect-regexp-history '("\\1")
"History of regexp for occur's collect operation")
@@ -1054,6 +1050,130 @@ also print the number."
count))
count))
+(defun kill-matching-lines (regexp &optional rstart rend interactive)
+ "Kill lines containing matches for REGEXP.
+
+When called from Lisp (and usually when called interactively as
+well, see below), applies to the part of the buffer after point.
+The line point is in is killed if and only if it contains a match
+for REGEXP starting after point.
+
+If REGEXP contains upper case characters (excluding those
+preceded by `\\') and `search-upper-case' is non-nil, the
+matching is case-sensitive.
+
+Second and third args RSTART and REND specify the region to
+operate on. Lines partially contained in this region are killed
+if and only if they contain a match entirely contained in the
+region.
+
+Interactively, in Transient Mark mode when the mark is active,
+operate on the contents of the region. Otherwise, operate from
+point to the end of (the accessible portion of) the buffer.
+
+If a match is split across lines, all the lines it lies in are
+killed. They are killed _before_ looking for the next match.
+Hence, a match starting on the same line at which another match
+ended is ignored.
+
+Return the number of killed matching lines. When called
+interactively, also print the number."
+ (interactive
+ (progn
+ (barf-if-buffer-read-only)
+ (keep-lines-read-args "Kill lines containing match for regexp")))
+ (if rstart
+ (progn
+ (goto-char (min rstart rend))
+ (setq rend (copy-marker (max rstart rend))))
+ (if (and interactive (use-region-p))
+ (setq rstart (region-beginning)
+ rend (copy-marker (region-end)))
+ (setq rstart (point)
+ rend (point-max-marker)))
+ (goto-char rstart))
+ (let ((count 0)
+ (case-fold-search
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)))
+ (save-excursion
+ (while (and (< (point) rend)
+ (re-search-forward regexp rend t))
+ (unless (zerop count)
+ (setq last-command 'kill-region))
+ (kill-region (save-excursion (goto-char (match-beginning 0))
+ (forward-line 0)
+ (point))
+ (progn (forward-line 1) (point)))
+ (setq count (1+ count))))
+ (set-marker rend nil)
+ (when interactive (message (ngettext "Killed %d matching line"
+ "Killed %d matching lines"
+ count)
+ count))
+ count))
+
+(defun copy-matching-lines (regexp &optional rstart rend interactive)
+ "Copy lines containing matches for REGEXP to the kill ring.
+
+When called from Lisp (and usually when called interactively as
+well, see below), applies to the part of the buffer after point.
+The line point is in is copied if and only if it contains a match
+for REGEXP starting after point.
+
+If REGEXP contains upper case characters (excluding those
+preceded by `\\') and `search-upper-case' is non-nil, the
+matching is case-sensitive.
+
+Second and third args RSTART and REND specify the region to
+operate on. Lines partially contained in this region are copied
+if and only if they contain a match entirely contained in the
+region.
+
+Interactively, in Transient Mark mode when the mark is active,
+operate on the contents of the region. Otherwise, operate from
+point to the end of (the accessible portion of) the buffer.
+
+If a match is split across lines, all the lines it lies in are
+copied.
+
+Return the number of copied matching lines. When called
+interactively, also print the number."
+ (interactive
+ (keep-lines-read-args "Copy lines containing match for regexp"))
+ (if rstart
+ (progn
+ (goto-char (min rstart rend))
+ (setq rend (copy-marker (max rstart rend))))
+ (if (and interactive (use-region-p))
+ (setq rstart (region-beginning)
+ rend (copy-marker (region-end)))
+ (setq rstart (point)
+ rend (point-max-marker)))
+ (goto-char rstart))
+ (let ((count 0)
+ (case-fold-search
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)))
+ (save-excursion
+ (while (and (< (point) rend)
+ (re-search-forward regexp rend t))
+ (unless (zerop count)
+ (setq last-command 'kill-region))
+ (copy-region-as-kill (save-excursion (goto-char (match-beginning 0))
+ (forward-line 0)
+ (point))
+ (progn (forward-line 1) (point)))
+ (setq count (1+ count))))
+ (set-marker rend nil)
+ (when interactive (message (ngettext "Copied %d matching line"
+ "Copied %d matching lines"
+ count)
+ count))
+ count))
+
(defun how-many (regexp &optional rstart rend interactive)
"Print and return number of matches for REGEXP following point.
When called from Lisp and INTERACTIVE is omitted or nil, just return
@@ -1089,17 +1209,17 @@ a previously found match."
rend (point-max)))
(goto-char rstart))
(let ((count 0)
- opoint
(case-fold-search
(if (and case-fold-search search-upper-case)
(isearch-no-upper-case-p regexp t)
case-fold-search)))
(while (and (< (point) rend)
- (progn (setq opoint (point))
- (re-search-forward regexp rend t)))
- (if (= opoint (point))
- (forward-char 1)
- (setq count (1+ count))))
+ (re-search-forward regexp rend t))
+ ;; Ensure forward progress on zero-length matches like "^$".
+ (when (and (= (match-beginning 0) (match-end 0))
+ (not (eobp)))
+ (forward-char 1))
+ (setq count (1+ count)))
(when interactive (message (ngettext "%d occurrence"
"%d occurrences"
count)
@@ -1233,18 +1353,27 @@ To return to ordinary Occur mode, use
\\[occur-cease-edit]."
(occur-mode)
(message "Switching to Occur mode.")))
+(defun occur--targets-start (targets)
+ "First marker of the `occur-target' property value TARGETS."
+ (if (consp targets)
+ (caar targets)
+ ;; Tolerate an `occur-target' value that is a single marker for
+ ;; compatibility.
+ targets))
+
(defun occur-after-change-function (beg end length)
(save-excursion
(goto-char beg)
(let* ((line-beg (line-beginning-position))
- (m (get-text-property line-beg 'occur-target))
+ (targets (get-text-property line-beg 'occur-target))
+ (m (occur--targets-start targets))
(buf (marker-buffer m))
col)
(when (and (get-text-property line-beg 'occur-prefix)
(not (get-text-property end 'occur-prefix)))
(when (= length 0)
;; Apply occur-target property to inserted (e.g. yanked) text.
- (put-text-property beg end 'occur-target m)
+ (put-text-property beg end 'occur-target targets)
;; Did we insert a newline? Occur Edit mode can't create new
;; Occur entries; just discard everything after the newline.
(save-excursion
@@ -1269,8 +1398,27 @@ To return to ordinary Occur mode, use
\\[occur-cease-edit]."
(recenter line)
(if readonly
(message "Buffer `%s' is read only." buf)
- (delete-region (line-beginning-position) (line-end-position))
- (insert text))
+ ;; Replace the line, but make the change as small as
+ ;; possible by shrink-wrapping. That way, we avoid
+ ;; disturbing markers unnecessarily.
+ (let* ((beg-pos (line-beginning-position))
+ (end-pos (line-end-position))
+ (buf-str (buffer-substring-no-properties beg-pos end-pos))
+ (common-prefix
+ (lambda (s1 s2)
+ (let ((c (compare-strings s1 nil nil s2 nil nil)))
+ (if (numberp c)
+ (1- (abs c))
+ (length s1)))))
+ (prefix-len (funcall common-prefix buf-str text))
+ (suffix-len (funcall common-prefix
+ (reverse buf-str) (reverse text))))
+ (setq beg-pos (+ beg-pos prefix-len))
+ (setq end-pos (- end-pos suffix-len))
+ (setq text (substring text prefix-len (- suffix-len)))
+ (delete-region beg-pos end-pos)
+ (goto-char beg-pos)
+ (insert text)))
(move-to-column col)))))))
@@ -1278,35 +1426,56 @@ To return to ordinary Occur mode, use
\\[occur-cease-edit]."
"Handle `revert-buffer' for Occur mode buffers."
(apply #'occur-1 (append occur-revert-arguments (list (buffer-name)))))
+;; Retained for compatibility.
(defun occur-mode-find-occurrence ()
- (let ((pos (get-text-property (point) 'occur-target)))
- (unless pos
+ "Return a marker to the first match of the line at point."
+ (occur--targets-start (occur-mode--find-occurrences)))
+
+(defun occur-mode--find-occurrences ()
+ ;; The `occur-target' property value is a list of (BEG . END) for each
+ ;; match on the line, or (for compatibility) a single marker to the start
+ ;; of the first match.
+ (let* ((targets (get-text-property (point) 'occur-target))
+ (start (occur--targets-start targets)))
+ (unless targets
(error "No occurrence on this line"))
- (unless (buffer-live-p (marker-buffer pos))
+ (unless (buffer-live-p (marker-buffer start))
(error "Buffer for this occurrence was killed"))
- pos))
+ targets))
+
+(defun occur--set-arrow ()
+ "Set the overlay arrow at the first line of the occur match at point."
+ (save-excursion
+ (let ((target (get-text-property (point) 'occur-target))
+ ;; Find the start of the occur match, in case it's multi-line.
+ (prev (previous-single-property-change (point) 'occur-target)))
+ (when (and prev (eq (get-text-property prev 'occur-target) target))
+ (goto-char prev))
+ (setq overlay-arrow-position
+ (set-marker (or overlay-arrow-position (make-marker))
+ (line-beginning-position))))))
(defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence)
(defun occur-mode-goto-occurrence (&optional event)
"Go to the occurrence specified by EVENT, a mouse click.
If not invoked by a mouse click, go to occurrence on the current line."
(interactive (list last-nonmenu-event))
- (let ((buffer (when event (current-buffer)))
- (pos
- (if (null event)
- ;; Actually `event-end' works correctly with a nil argument as
- ;; well, so we could dispense with this test, but let's not
- ;; rely on this undocumented behavior.
- (occur-mode-find-occurrence)
- (with-current-buffer (window-buffer (posn-window (event-end event)))
- (save-excursion
- (goto-char (posn-point (event-end event)))
- (occur-mode-find-occurrence)))))
- (regexp occur-highlight-regexp))
+ (let* ((buffer (when event (current-buffer)))
+ (targets
+ (if (null event)
+ ;; Actually `event-end' works correctly with a nil argument as
+ ;; well, so we could dispense with this test, but let's not
+ ;; rely on this undocumented behavior.
+ (occur-mode--find-occurrences)
+ (with-current-buffer (window-buffer (posn-window (event-end
event)))
+ (save-excursion
+ (goto-char (posn-point (event-end event)))
+ (occur-mode--find-occurrences)))))
+ (pos (occur--targets-start targets)))
+ (occur--set-arrow)
(pop-to-buffer (marker-buffer pos))
(goto-char pos)
- (let ((end-mk (save-excursion (re-search-forward regexp nil t))))
- (occur--highlight-occurrence pos end-mk))
+ (occur--highlight-occurrences targets)
(when buffer (next-error-found buffer (current-buffer)))
(run-hooks 'occur-mode-find-occurrence-hook)))
@@ -1314,15 +1483,16 @@ If not invoked by a mouse click, go to occurrence on
the current line."
"Go to the occurrence the current line describes, in another window."
(interactive)
(let ((buffer (current-buffer))
- (pos (occur-mode-find-occurrence)))
+ (pos (occur--targets-start (occur-mode--find-occurrences))))
+ (occur--set-arrow)
(switch-to-buffer-other-window (marker-buffer pos))
(goto-char pos)
(next-error-found buffer (current-buffer))
(run-hooks 'occur-mode-find-occurrence-hook)))
-;; Stolen from compile.el
(defun occur-goto-locus-delete-o ()
- (delete-overlay occur-highlight-overlay)
+ (mapc #'delete-overlay occur-highlight-overlays)
+ (setq occur-highlight-overlays nil)
;; Get rid of timer and hook that would try to do this again.
(if (timerp next-error-highlight-timer)
(cancel-timer next-error-highlight-timer))
@@ -1330,64 +1500,56 @@ If not invoked by a mouse click, go to occurrence on
the current line."
#'occur-goto-locus-delete-o))
;; Highlight the current visited occurrence.
-;; Adapted from `compilation-goto-locus'.
-(defun occur--highlight-occurrence (mk end-mk)
- (let ((highlight-regexp occur-highlight-regexp))
- (if (timerp next-error-highlight-timer)
- (cancel-timer next-error-highlight-timer))
- (unless occur-highlight-overlay
- (setq occur-highlight-overlay
- (make-overlay (point-min) (point-min)))
- (overlay-put occur-highlight-overlay 'face 'next-error))
- (with-current-buffer (marker-buffer mk)
- (save-excursion
- (if end-mk (goto-char end-mk) (end-of-line))
- (let ((end (point)))
- (if mk (goto-char mk) (beginning-of-line))
- (if (and (stringp highlight-regexp)
- (re-search-forward highlight-regexp end t))
- (progn
- (goto-char (match-beginning 0))
- (move-overlay occur-highlight-overlay
- (match-beginning 0) (match-end 0)
- (current-buffer)))
- (move-overlay occur-highlight-overlay
- (point) end (current-buffer)))
- (if (or (eq next-error-highlight t)
- (numberp next-error-highlight))
- ;; We want highlighting: delete overlay on next input.
- (add-hook 'pre-command-hook
- #'occur-goto-locus-delete-o)
- ;; We don't want highlighting: delete overlay now.
- (delete-overlay occur-highlight-overlay))
- ;; We want highlighting for a limited time:
- ;; set up a timer to delete it.
- (when (numberp next-error-highlight)
- (setq next-error-highlight-timer
- (run-at-time next-error-highlight nil
- 'occur-goto-locus-delete-o))))))
- (when (eq next-error-highlight 'fringe-arrow)
- ;; We want a fringe arrow (instead of highlighting).
- (setq next-error-overlay-arrow-position
- (copy-marker (line-beginning-position))))))
+(defun occur--highlight-occurrences (targets)
+ (let ((start-marker (occur--targets-start targets)))
+ (occur-goto-locus-delete-o)
+ (with-current-buffer (marker-buffer start-marker)
+ (when (or (eq next-error-highlight t)
+ (numberp next-error-highlight))
+ (setq occur-highlight-overlays
+ (mapcar (lambda (target)
+ (let ((o (make-overlay (car target) (cdr target))))
+ (overlay-put o 'face 'next-error)
+ o))
+ (if (listp targets)
+ targets
+ ;; `occur-target' compatibility: when we only
+ ;; have a single starting point, highlight the
+ ;; rest of the line.
+ (let ((end-pos (save-excursion
+ (goto-char start-marker)
+ (line-end-position))))
+ (list (cons start-marker end-pos))))))
+ (add-hook 'pre-command-hook #'occur-goto-locus-delete-o)
+ (when (numberp next-error-highlight)
+ ;; We want highlighting for a limited time:
+ ;; set up a timer to delete it.
+ (setq next-error-highlight-timer
+ (run-at-time next-error-highlight nil
+ 'occur-goto-locus-delete-o))))
+
+ (when (eq next-error-highlight 'fringe-arrow)
+ ;; We want a fringe arrow (instead of highlighting).
+ (setq next-error-overlay-arrow-position
+ (copy-marker (line-beginning-position)))))))
(defun occur-mode-display-occurrence ()
"Display in another window the occurrence the current line describes."
(interactive)
- (let ((buffer (current-buffer))
- (pos (occur-mode-find-occurrence))
- (regexp occur-highlight-regexp)
- (next-error-highlight next-error-highlight-no-select)
- (display-buffer-overriding-action
- '(nil (inhibit-same-window . t)))
- window)
+ (let* ((buffer (current-buffer))
+ (targets (occur-mode--find-occurrences))
+ (pos (occur--targets-start targets))
+ (next-error-highlight next-error-highlight-no-select)
+ (display-buffer-overriding-action
+ '(nil (inhibit-same-window . t)))
+ window)
(setq window (display-buffer (marker-buffer pos) t))
+ (occur--set-arrow)
;; This is the way to set point in the proper window.
(save-selected-window
(select-window window)
(goto-char pos)
- (let ((end-mk (save-excursion (re-search-forward regexp nil t))))
- (occur--highlight-occurrence pos end-mk))
+ (occur--highlight-occurrences targets)
(next-error-found buffer (current-buffer))
(run-hooks 'occur-mode-find-occurrence-hook))))
@@ -1736,6 +1898,7 @@ See also `multi-occur'."
;; Make the default-directory of the *Occur* buffer match that of
;; the buffer where the occurrences come from
(setq default-directory source-buffer-default-directory)
+ (setq overlay-arrow-position nil)
(if (stringp nlines)
(fundamental-mode) ;; This is for collect operation.
(occur-mode))
@@ -1744,7 +1907,6 @@ See also `multi-occur'."
(buffer-undo-list t)
(occur--final-pos nil))
(erase-buffer)
- (setq-local occur-highlight-regexp regexp)
(let ((count
(if (stringp nlines)
;; Treat nlines as a regexp to collect.
@@ -1844,7 +2006,7 @@ See also `multi-occur'."
(origpt nil)
(begpt nil)
(endpt nil)
- (marker nil)
+ markers ; list of (BEG-MARKER . END-MARKER)
(curstring "")
(ret nil)
;; The following binding is for when case-fold-search
@@ -1870,8 +2032,7 @@ See also `multi-occur'."
(setq endpt (line-end-position)))
;; Sum line numbers up to the first match line.
(setq curr-line (+ curr-line (count-lines origpt begpt)))
- (setq marker (make-marker))
- (set-marker marker matchbeg)
+ (setq markers nil)
(setq curstring (occur-engine-line begpt endpt
keep-props))
;; Highlight the matches
(let ((len (length curstring))
@@ -1893,6 +2054,11 @@ See also `multi-occur'."
(setq orig-line-shown-p t)))
(while (and (< start len)
(string-match regexp curstring start))
+ (push (cons (set-marker (make-marker)
+ (+ begpt (match-beginning
0)))
+ (set-marker (make-marker)
+ (+ begpt (match-end 0))))
+ markers)
(setq matches (1+ matches))
(add-text-properties
(match-beginning 0) (match-end 0)
@@ -1905,6 +2071,7 @@ See also `multi-occur'."
;; Avoid infloop (Bug#7593).
(let ((end (match-end 0)))
(setq start (if (= start end) (1+ start) end)))))
+ (setq markers (nreverse markers))
;; Generate the string to insert for this match
(let* ((match-prefix
;; Using 7 digits aligns tabs properly.
@@ -1918,7 +2085,7 @@ See also `multi-occur'."
;; (for Occur Edit mode).
front-sticky t
rear-nonsticky t
- occur-target ,marker
+ occur-target ,markers
follow-link t
help-echo "mouse-2: go to
this occurrence"))))
(match-str
@@ -1926,7 +2093,7 @@ See also `multi-occur'."
;; because that loses. And don't put it
;; on context lines to reduce flicker.
(propertize curstring
- 'occur-target marker
+ 'occur-target markers
'follow-link t
'help-echo
"mouse-2: go to this occurrence"))
@@ -1938,15 +2105,17 @@ See also `multi-occur'."
"\n"
(if prefix-face
(propertize
- "\n :" 'font-lock-face prefix-face)
- "\n :")
+ "\n :" 'font-lock-face prefix-face
+ 'occur-target markers)
+ (propertize
+ "\n :" 'occur-target markers))
;; Add mouse face in one section to
;; ensure the prefix and the string
;; get a contiguous highlight.
(propertize (concat match-prefix match-str)
'mouse-face 'highlight))
- ;; Add marker at eol, but no mouse props.
- (propertize "\n" 'occur-target marker)))
+ ;; Add markers at eol, but no mouse props.
+ (propertize "\n" 'occur-target markers)))
(data
(if (= nlines 0)
;; The simple display style
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index f654702..2a95b39 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -87,6 +87,11 @@ this happens automatically before saving `save-place-alist'
to
`save-place-file'."
:type 'boolean)
+(defcustom save-place-abbreviate-file-names nil
+ "If non-nil, abbreviate file names before saving them."
+ :type 'boolean
+ :version "28.1")
+
(defcustom save-place-save-skipped t
"If non-nil, remember files matching `save-place-skip-check-regexp'.
@@ -177,7 +182,10 @@ file:
"Add current buffer filename and position to `save-place-alist'.
Put filename and point in a cons box and then cons that onto the
front of the `save-place-alist', if `save-place-mode' is non-nil.
-Otherwise, just delete that file from the alist."
+Otherwise, just delete that file from the alist.
+
+If `save-place-abbreviate-file-names' is non-nil, abbreviate the
+file names."
;; First check to make sure alist has been loaded in from the master
;; file. If not, do so, then feel free to modify the alist. It
;; will be saved again when Emacs is killed.
@@ -195,6 +203,8 @@ Otherwise, just delete that file from the alist."
(or (not save-place-ignore-files-regexp)
(not (string-match save-place-ignore-files-regexp
item))))
+ (when save-place-abbreviate-file-names
+ (setq item (abbreviate-file-name item)))
(let ((cell (assoc item save-place-alist))
(position (cond ((eq major-mode 'hexl-mode)
(with-no-warnings
diff --git a/lisp/select.el b/lisp/select.el
index c39bc93..eaa74ce 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -184,11 +184,17 @@ decoded. If `gui-get-selection' signals an error, return
nil."
(let ((clip-text
(when select-enable-clipboard
(let ((text (gui--selection-value-internal 'CLIPBOARD)))
- (if (string= text "") (setq text nil))
-
- ;; Check the CLIPBOARD selection for 'newness', is it different
- ;; from what we remembered them to be last time we did a
- ;; cut/paste operation.
+ (when (string= text "")
+ (setq text nil))
+ ;; When `select-enable-clipboard' is non-nil,
+ ;; killing/copying text (with, say, `C-w') will push the
+ ;; text to the clipboard (and store it in
+ ;; `gui--last-selected-text-clipboard'). We check
+ ;; whether the text on the clipboard is identical to this
+ ;; text, and if so, we report that the clipboard is
+ ;; empty. See (bug#27442) for further discussion about
+ ;; this DWIM action, and possible ways to make this check
+ ;; less fragile, if so desired.
(prog1
(unless (equal text gui--last-selected-text-clipboard)
text)
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index f39f173..f67b0b9 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -128,7 +128,7 @@ Default: ~/.emacs.d/shadow_todo"
(defvar shadow-system-name (concat "/" (system-name) ":")
"The identification for local files on this machine.")
-(defvar shadow-homedir "~"
+(defvar shadow-homedir "~/"
"Your home directory on this machine.")
;;;
@@ -284,9 +284,13 @@ Argument can be a simple name, remote file name, or
already a
(defsubst shadow-make-fullname (hup &optional host name)
"Make a Tramp style fullname out of HUP, a `tramp-file-name' structure.
-Replace HOST, and NAME when non-nil."
+Replace HOST, and NAME when non-nil. HOST can also be a remote file name."
(let ((hup (copy-tramp-file-name hup)))
- (when host (setf (tramp-file-name-host hup) host))
+ (when host
+ (if (file-remote-p host)
+ (setq name (or name (and hup (tramp-file-name-localname hup)))
+ hup (tramp-dissect-file-name (file-remote-p host)))
+ (setf (tramp-file-name-host hup) host)))
(when name (setf (tramp-file-name-localname hup) name))
(if (null (tramp-file-name-method hup))
(format
@@ -348,15 +352,16 @@ Will return the name bare if it is a local file."
(defun shadow-contract-file-name (file)
"Simplify FILE.
-Do so by replacing (when possible) home directory with ~, and hostname
-with cluster name that includes it. Filename should be absolute and
-true."
+Do so by replacing (when possible) home directory with ~/, and
+hostname with cluster name that includes it. Filename should be
+absolute and true."
(let* ((hup (shadow-parse-name file))
(homedir (if (shadow-local-file hup)
shadow-homedir
(file-name-as-directory
(file-local-name
- (expand-file-name (shadow-make-fullname hup nil "~"))))))
+ (expand-file-name
+ (shadow-make-fullname hup nil shadow-homedir))))))
(suffix (shadow-suffix homedir (tramp-file-name-localname hup)))
(cluster (shadow-site-cluster (shadow-make-fullname hup nil ""))))
(when cluster
@@ -365,7 +370,7 @@ true."
(shadow-make-fullname
hup nil
(if suffix
- (concat "~/" suffix)
+ (concat shadow-homedir suffix)
(tramp-file-name-localname hup)))))
(defun shadow-same-site (pattern file)
diff --git a/lisp/shell.el b/lisp/shell.el
index 4339e8c..5aab80d 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -459,6 +459,16 @@ Useful for shells like zsh that has this feature."
(push (mapconcat #'identity (nreverse arg) "") args)))
(cons (nreverse args) (nreverse begins)))))
+;;;###autoload
+(defun split-string-shell-command (string)
+ "Split STRING (a shell command) into a list of strings.
+General shell syntax, like single and double quoting, as well as
+backslash quoting, is respected."
+ (with-temp-buffer
+ (insert string)
+ (let ((comint-file-name-quote-list shell-file-name-quote-list))
+ (car (shell--parse-pcomplete-arguments)))))
+
(defun shell-command-completion-function ()
"Completion function for shell command names.
This is the value of `pcomplete-command-completion-function' for
diff --git a/lisp/simple.el b/lisp/simple.el
index f746d73..3ad8634 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -695,6 +695,30 @@ When called from Lisp code, ARG may be a prefix string to
copy."
(indent-to col 0)
(goto-char pos)))
+(defface separator-line
+ '((((type graphic) (background dark))
+ :height 0.1 :background "#505050")
+ (((type graphic) (background light))
+ :height 0.1 :background "#a0a0a0")
+ (t :foreground "ForestGreen"))
+ "Face for separator lines."
+ :version "28.1"
+ :group 'text)
+
+(defun make-separator-line (&optional length)
+ "Make a string appropriate for usage as a visual separator line.
+This uses the `separator-line' face.
+
+If LENGTH is nil, use the window width."
+ (if (display-graphic-p)
+ (if length
+ (concat (propertize (make-string length ?\s) 'face 'separator-line)
+ "\n")
+ (propertize "\n" 'face '(:inherit separator-line :extend t)))
+ (concat (propertize (make-string (or length (1- (window-width))) ?-)
+ 'face 'separator-line)
+ "\n")))
+
(defun delete-indentation (&optional arg beg end)
"Join this line to previous and fix up whitespace at join.
If there is a fill prefix, delete it from the beginning of this
@@ -2855,8 +2879,10 @@ Go to the history element by the absolute history
position HIST-POS."
The same as `command-error-default-function' but display error messages
at the end of the minibuffer using `minibuffer-message' to not obscure
the minibuffer contents."
- (discard-input)
- (ding)
+ (if (memq 'minibuffer-quit (get (car data) 'error-conditions))
+ (ding t)
+ (discard-input)
+ (ding))
(let ((string (error-message-string data)))
;; If we know from where the error was signaled, show it in
;; *Messages*.
@@ -5842,7 +5868,13 @@ Can be `untabify' -- turn a tab to many spaces, then
delete one space;
(defun backward-delete-char-untabify (arg &optional killp)
"Delete characters backward, changing tabs into spaces.
The exact behavior depends on `backward-delete-char-untabify-method'.
+
Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
+
+If Transient Mark mode is enabled, the mark is active, and ARG is 1,
+delete the text in the region and deactivate the mark instead.
+To disable this, set option ‘delete-active-region’ to nil.
+
Interactively, ARG is the prefix arg (default 1)
and KILLP is t if a prefix arg was specified."
(interactive "*p\nP")
@@ -6676,6 +6708,10 @@ or \"mark.*active\" at the prompt."
;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
:variable (default-value 'transient-mark-mode))
+(define-minor-mode indent-tabs-mode
+ "Toggle whether indentation can insert TAB characters."
+ :global t :group 'indent :variable indent-tabs-mode)
+
(defvar widen-automatically t
"Non-nil means it is ok for commands to call `widen' when they want to.
Some commands will do this in order to go to positions outside
@@ -8107,15 +8143,19 @@ is defined.
The function should take a single optional argument, which is a flag
indicating whether it should use soft newlines.")
-(defun default-indent-new-line (&optional soft)
+(defun default-indent-new-line (&optional soft force)
"Break line at point and indent.
If a comment syntax is defined, call `comment-line-break-function'.
The inserted newline is marked hard if variable `use-hard-newlines' is true,
unless optional argument SOFT is non-nil."
- (interactive)
+ (interactive (list nil t))
(if comment-start
- (funcall comment-line-break-function soft)
+ ;; Force breaking the line when called interactively.
+ (if force
+ (let ((comment-auto-fill-only-comments nil))
+ (funcall comment-line-break-function soft))
+ (funcall comment-line-break-function soft))
;; Insert the newline before removing empty space so that markers
;; get preserved better.
(if soft (insert-and-inherit ?\n) (newline 1))
@@ -9499,9 +9539,9 @@ call `normal-erase-is-backspace-mode' (which see)
instead."
:set (lambda (symbol value)
;; The fboundp is because of a problem with :set when
;; dumping Emacs. It doesn't really matter.
- (if (fboundp 'normal-erase-is-backspace-mode)
- (normal-erase-is-backspace-mode (or value 0))
- (set-default symbol value))))
+ (when (fboundp 'normal-erase-is-backspace-mode)
+ (normal-erase-is-backspace-mode (or value 0)))
+ (set-default symbol value)))
(defun normal-erase-is-backspace-setup-frame (&optional frame)
"Set up `normal-erase-is-backspace-mode' on FRAME, if necessary."
diff --git a/lisp/so-long.el b/lisp/so-long.el
index d765d34..7bf15e8 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -8,7 +8,7 @@
;; Keywords: convenience
;; Created: 23 Dec 2015
;; Package-Requires: ((emacs "24.4"))
-;; Version: 1.0
+;; Version: 1.1.1
;; This file is part of GNU Emacs.
@@ -50,16 +50,17 @@
;; performance further, as well as making the so-long activity more obvious to
;; the user. These kinds of minified files are typically not intended to be
;; edited, so not providing the usual editing mode in such cases will rarely be
-;; an issue. However, you can reinstate the original state of the buffer by
-;; calling `so-long-revert' (the key binding of which is advertised when the
major
-;; mode change occurs). If you prefer that the major mode not be changed, you
-;; can customize the `so-long-minor-mode' action.
+;; an issue; however you can restore the buffer to its original state by
calling
+;; `so-long-revert' (the key binding of which is advertised when the major mode
+;; change occurs). If you prefer that the major mode not be changed in the
+;; first place, there is a `so-long-minor-mode' action available, which you can
+;; select by customizing the `so-long-action' user option.
;;
;; The user options `so-long-action' and `so-long-action-alist' determine what
-;; actions `so-long' and `so-long-revert' will take. This allows you to
configure
-;; alternative actions (including custom actions). As well as
-;; the major and minor mode actions provided by this library, `longlines-mode'
-;; is also supported by default as an alternative action.
+;; `so-long' and `so-long-revert' will do, enabling you to configure
alternative
+;; actions (including custom actions). As well as the major and minor mode
+;; actions provided by this library, `longlines-mode' is also supported by
+;; default as an alternative action.
;;
;; Note that while the measures taken can improve performance dramatically when
;; dealing with such files, this library does not have any effect on the
@@ -127,9 +128,9 @@
;; Use M-x customize-group RET so-long RET
;; (or M-x so-long-customize RET)
;;
-;; The user options `so-long-target-modes', `so-long-threshold', and
-;; `so-long-max-lines' determine whether action will be taken automatically
when
-;; visiting a file, and `so-long-action' determines what will be done.
+;; The user options `so-long-target-modes' and `so-long-threshold' determine
+;; whether action will be taken automatically when visiting a file, and
+;; `so-long-action' determines what will be done.
;; * Actions and menus
;; -------------------
@@ -152,7 +153,7 @@
;; * Files with a file-local 'mode'
;; --------------------------------
;; A file-local major mode is likely to be safe even if long lines are detected
-;; (as the author of the file would otherwise be unlikely to have set that
mode),
+;; (the author of the file would otherwise be unlikely to have set that mode),
;; and so these files are treated as special cases. When a file-local 'mode'
is
;; present, the function defined by the `so-long-file-local-mode-function' user
;; option is called. The default value will cause the `so-long-minor-mode'
@@ -213,6 +214,24 @@
;; performance or otherwise avoid undesirable behaviours. If `so-long-revert'
;; is called, then the original values are restored.
+;; * Retaining minor modes and settings when switching to `so-long-mode'
+;; ---------------------------------------------------------------------
+;; A consequence of switching to a new major mode is that many buffer-local
+;; minor modes and variables from the original major mode will be disabled.
+;; For performance purposes this is a desirable trait of `so-long-mode', but
+;; specified modes and variables can also be preserved across the major mode
+;; transition by customizing the `so-long-mode-preserved-minor-modes' and
+;; `so-long-mode-preserved-variables' user options.
+;;
+;; When `so-long-mode' is called, the states of any modes and variables
+;; configured by these options are remembered in the original major mode, and
+;; reinstated after switching to `so-long-mode'. Likewise, if `so-long-revert'
+;; is used to switch back to the original major mode, these modes and variables
+;; are again set to the same states.
+;;
+;; The default values for these options ensure that if `view-mode' was active
+;; in the original mode, then it will also be active in `so-long-mode'.
+
;; * Hooks
;; -------
;; `so-long-hook' runs at the end of the `so-long' command, after the
configured
@@ -287,8 +306,9 @@
;; the criteria for calling `so-long' in any given mode (plus its derivatives)
;; by setting buffer-local values for the variables in question. This includes
;; `so-long-predicate' itself, as well as any variables used by the predicate
-;; when determining the result. By default this means `so-long-max-lines',
-;; `so-long-skip-leading-comments', and `so-long-threshold'. E.g.:
+;; when determining the result. By default this means `so-long-threshold' and
+;; possibly also `so-long-max-lines' and `so-long-skip-leading-comments' (these
+;; latter two are not used by default starting from Emacs 28.1). E.g.:
;;
;; (add-hook 'js-mode-hook 'my-js-mode-hook)
;;
@@ -390,6 +410,14 @@
;; * Change Log:
;;
+;; 1.1.1 - Identical to 1.1, but fixing an incorrect GNU ELPA release.
+;; 1.1 - Utilise `buffer-line-statistics' in Emacs 28+, with the new
+;; `so-long-predicate' function `so-long-statistics-excessive-p'.
+;; - Increase `so-long-threshold' from 250 to 10,000.
+;; - Increase `so-long-max-lines' from 5 to 500.
+;; - Include `fundamental-mode' in `so-long-target-modes'.
+;; - New user option `so-long-mode-preserved-minor-modes'.
+;; - New user option `so-long-mode-preserved-variables'.
;; 1.0 - Included in Emacs 27.1, and in GNU ELPA for prior versions of Emacs.
;; - New global mode `global-so-long-mode' to enable/disable the library.
;; - New user option `so-long-action'.
@@ -442,13 +470,19 @@
(require 'cl-lib)
+;; Map each :package-version to the associated Emacs version.
+;; (This eliminates the need for explicit :version keywords on the
+;; custom definitions.)
(add-to-list 'customize-package-emacs-version-alist
- '(so-long ("1.0" . "27.1")))
+ '(so-long ("1.0" . "27.1")
+ ("1.1" . "28.1")))
-(defconst so-long--latest-version "1.0")
+(defconst so-long--latest-version "1.1")
+(declare-function buffer-line-statistics "fns.c" t t) ;; Emacs 28+
(declare-function longlines-mode "longlines")
(defvar longlines-mode)
+
(defvar so-long-enabled nil
;; This was initially a renaming of the old `so-long-mode-enabled' and
;; documented as "Set to nil to prevent `so-long' from being triggered
@@ -488,16 +522,24 @@
:prefix "so-long"
:group 'convenience)
-(defcustom so-long-threshold 250
+(defcustom so-long-threshold 10000
"Maximum line length permitted before invoking `so-long-function'.
-See `so-long-detected-long-line-p' for details."
+Line length is counted in either bytes or characters, depending on
+`so-long-predicate'.
+
+This is the only variable used to determine the presence of long lines if
+the `so-long-predicate' function is `so-long-statistics-excessive-p'."
:type 'integer
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
-(defcustom so-long-max-lines 5
+(defcustom so-long-max-lines 500
"Number of non-blank, non-comment lines to test for excessive length.
+This option normally has no effect in Emacs versions >= 28.1, as the default
+`so-long-predicate' sees the entire buffer. Older versions of Emacs still make
+use of this option.
+
If nil then all lines will be tested, until either a long line is detected,
or the end of the buffer is reached.
@@ -507,11 +549,15 @@ be counted.
See `so-long-detected-long-line-p' for details."
:type '(choice (integer :tag "Limit")
(const :tag "Unlimited" nil))
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
(defcustom so-long-skip-leading-comments t
"Non-nil to ignore all leading comments and whitespace.
+This option normally has no effect in Emacs versions >= 28.1, as the default
+`so-long-predicate' sees the entire buffer. Older versions of Emacs still make
+use of this option.
+
If the file begins with a shebang (#!), this option also causes that line to be
ignored even if it doesn't match the buffer's comment syntax, to ensure that
comments following the shebang will be ignored.
@@ -521,7 +567,7 @@ See `so-long-detected-long-line-p' for details."
:package-version '(so-long . "1.0"))
(defcustom so-long-target-modes
- '(prog-mode css-mode sgml-mode nxml-mode)
+ '(prog-mode css-mode sgml-mode nxml-mode fundamental-mode)
"`so-long' affects only these modes and their derivatives.
Our primary use-case is minified programming code, so `prog-mode' covers
@@ -534,7 +580,7 @@ files would prevent Emacs from handling them correctly."
;; Use 'symbol', as 'function' may be unknown => mismatch.
:type '(choice (repeat :tag "Specified modes" symbol)
(const :tag "All modes" t))
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
(defcustom so-long-invisible-buffer-function #'so-long-deferred
"Function called in place of `so-long' when the buffer is not displayed.
@@ -566,7 +612,9 @@ the mentioned options might interfere with some intended
processing."
(function :tag "Custom function"))
:package-version '(so-long . "1.0"))
-(defcustom so-long-predicate 'so-long-detected-long-line-p
+(defcustom so-long-predicate (if (fboundp 'buffer-line-statistics)
+ 'so-long-statistics-excessive-p
+ 'so-long-detected-long-line-p)
"Function, called after `set-auto-mode' to decide whether action is needed.
Only called if the major mode is a member of `so-long-target-modes'.
@@ -574,10 +622,14 @@ Only called if the major mode is a member of
`so-long-target-modes'.
The specified function will be called with no arguments. If it returns non-nil
then `so-long' will be invoked.
-Defaults to `so-long-detected-long-line-p'."
- :type '(radio (const so-long-detected-long-line-p)
+Defaults to `so-long-statistics-excessive-p' starting from Emacs 28.1, or
+`so-long-detected-long-line-p' in earlier versions.
+
+Note that `so-long-statistics-excessive-p' requires Emacs 28.1 or later."
+ :type '(radio (const so-long-statistics-excessive-p)
+ (const so-long-detected-long-line-p)
(function :tag "Custom function"))
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
;; Silence byte-compiler warning. `so-long-action-alist' is defined below
;; as a user option; but the definition sequence required for its setter
@@ -757,6 +809,7 @@ was established."
display-line-numbers-mode
flymake-mode
flyspell-mode
+ glasses-mode
goto-address-mode
goto-address-prog-mode
hi-lock-mode
@@ -776,6 +829,8 @@ was established."
hl-sexp-mode
idle-highlight-mode
rainbow-delimiters-mode
+ smartparens-mode
+ smartparens-strict-mode
)
;; It's not clear to me whether all of these would be problematic, but they
;; seemed like reasonable targets. Some are certainly excessive in smaller
@@ -800,7 +855,7 @@ disabled modes are re-enabled by calling them with the
numeric argument 1.
Please submit bug reports to recommend additional modes for this list, whether
they are in Emacs core, GNU ELPA, or elsewhere."
:type '(repeat symbol) ;; not function, as may be unknown => mismatch.
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
(defcustom so-long-variable-overrides
'((bidi-inhibit-bpa . t)
@@ -848,6 +903,44 @@ intended to be edited manually."
(which-func-mode boolean))
:package-version '(so-long . "1.0"))
+(defcustom so-long-mode-preserved-minor-modes
+ '(view-mode)
+ "List of buffer-local minor modes to preserve in `so-long-mode'.
+
+These will be enabled or disabled after switching to `so-long-mode' (by calling
+them with the numeric argument 1 or 0) in accordance with their state in the
+buffer's original major mode. Unknown modes, and modes which are already in
the
+desired state, are ignored.
+
+This happens before `so-long-variable-overrides' and `so-long-minor-modes'
+have been processed.
+
+By default this happens only if `so-long-action' is set to `so-long-mode'.
+If `so-long-revert' is subsequently invoked, then the modes are again set
+to their original state after the original major mode has been called.
+
+See also `so-long-mode-preserved-variables' (processed after this)."
+ :type '(repeat symbol) ;; not function, as may be unknown => mismatch.
+ :package-version '(so-long . "1.1"))
+
+(defcustom so-long-mode-preserved-variables
+ '(view-old-buffer-read-only)
+ "List of buffer-local variables to preserve in `so-long-mode'.
+
+The original value of each variable will be maintained after switching to
+`so-long-mode'. Unknown variables are ignored.
+
+This happens before `so-long-variable-overrides' and `so-long-minor-modes'
+have been processed.
+
+By default this happens only if `so-long-action' is set to `so-long-mode'.
+If `so-long-revert' is subsequently invoked, then the variables are again
+set to their original values after the original major mode has been called.
+
+See also `so-long-mode-preserved-minor-modes' (processed before this)."
+ :type '(repeat variable)
+ :package-version '(so-long . "1.1"))
+
(defcustom so-long-hook nil
"List of functions to call after `so-long' is called.
@@ -934,10 +1027,17 @@ If RESET is non-nil, remove any existing values before
storing the new ones."
(setq so-long-original-values nil))
(so-long-remember 'so-long-variable-overrides)
(so-long-remember 'so-long-minor-modes)
+ (so-long-remember 'so-long-mode-preserved-variables)
+ (so-long-remember 'so-long-mode-preserved-minor-modes)
(dolist (ovar so-long-variable-overrides)
(so-long-remember (car ovar)))
(dolist (mode so-long-minor-modes)
(when (and (boundp mode) mode)
+ (so-long-remember mode)))
+ (dolist (var so-long-mode-preserved-variables)
+ (so-long-remember var))
+ (dolist (mode so-long-mode-preserved-minor-modes)
+ (when (and (boundp mode) mode)
(so-long-remember mode))))
(defun so-long-menu ()
@@ -1077,12 +1177,23 @@ serves the same purpose.")
;; We change automatically to faster code
;; And then I won't feel so mad
+(defun so-long-statistics-excessive-p ()
+ "Non-nil if the buffer contains a line longer than `so-long-threshold' bytes.
+
+This uses `buffer-line-statistics' (available from Emacs 28.1) to establish the
+longest line in the buffer (counted in bytes rather than characters).
+
+This is the default value of `so-long-predicate' in Emacs versions >= 28.1.
+\(In earlier versions `so-long-detected-long-line-p' is used by default.)"
+ (> (cadr (buffer-line-statistics))
+ so-long-threshold))
+
(defun so-long-detected-long-line-p ()
"Determine whether the current buffer contains long lines.
Following any initial comments and blank lines, the next N lines of the buffer
-will be tested for excessive length (where \"excessive\" means above
-`so-long-threshold', and N is `so-long-max-lines').
+will be tested for excessive length (where \"excessive\" means greater than
+`so-long-threshold' characters, and N is `so-long-max-lines').
Returns non-nil if any such excessive-length line is detected.
@@ -1090,7 +1201,9 @@ If `so-long-skip-leading-comments' is nil then the N
lines will be counted
starting from the first line of the buffer. In this instance you will likely
want to increase `so-long-max-lines' to allow for possible comments.
-This is the default value of `so-long-predicate'."
+This is the default `so-long-predicate' function in Emacs versions < 28.1.
+\(Starting from 28.1, the default and recommended predicate function is
+`so-long-statistics-excessive-p', which is faster and sees the entire buffer.)"
(let ((count 0) start)
(save-excursion
(goto-char (point-min))
@@ -1191,7 +1304,8 @@ This minor mode is a standard `so-long-action' option."
;; Housekeeping. `so-long-minor-mode' might be invoked directly rather
;; than via `so-long', so replicate the necessary behaviours. The
minor
;; mode also cares about whether `so-long' was already active, as we do
- ;; not want to remember values which were potentially overridden
already.
+ ;; not want to remember values which were (potentially) overridden
+ ;; already.
(unless (or so-long--calling so-long--active)
(so-long--ensure-enabled)
(setq so-long--active t
@@ -1321,6 +1435,16 @@ This advice acts before `so-long-mode', with the
previous mode still active."
"Run by `so-long-mode' in `after-change-major-mode-hook'.
Calls `so-long-disable-minor-modes' and `so-long-override-variables'."
+ ;; Check/set the state of 'preserved' variables and minor modes.
+ ;; (See also `so-long-mode-revert'.)
+ ;; The "modes before variables" sequence is important for the default
+ ;; preserved mode `view-mode' which remembers the `buffer-read-only' state
+ ;; (which is also permanent-local). That causes problems unless we restore
+ ;; the original value of `view-old-buffer-read-only' after; otherwise the
+ ;; sequence `view-mode' -> `so-long' -> `so-long-revert' -> `view-mode'
+ ;; results in `view-mode' being disabled but the buffer still read-only.
+ (so-long-mode-maintain-preserved-minor-modes)
+ (so-long-mode-maintain-preserved-variables)
;; Disable minor modes.
(so-long-disable-minor-modes)
;; Override variables (again). We already did this in `so-long-mode' in
@@ -1334,14 +1458,15 @@ Calls `so-long-disable-minor-modes' and
`so-long-override-variables'."
(defun so-long-disable-minor-modes ()
"Disable any active minor modes listed in `so-long-minor-modes'."
(dolist (mode (so-long-original 'so-long-minor-modes))
- (when (and (boundp mode) mode)
+ (when (and (boundp mode)
+ (symbol-value mode))
(funcall mode 0))))
(defun so-long-restore-minor-modes ()
"Restore the minor modes which were disabled.
The modes are enabled in accordance with what was remembered in `so-long'."
- (dolist (mode so-long-minor-modes)
+ (dolist (mode (so-long-original 'so-long-minor-modes))
(when (and (so-long-original mode)
(boundp mode)
(not (symbol-value mode)))
@@ -1356,7 +1481,7 @@ The modes are enabled in accordance with what was
remembered in `so-long'."
"Restore the remembered values for the overridden variables.
The variables are set in accordance with what was remembered in `so-long'."
- (dolist (ovar so-long-variable-overrides)
+ (dolist (ovar (so-long-original 'so-long-variable-overrides))
(so-long-restore-variable (car ovar))))
(defun so-long-restore-variable (variable)
@@ -1364,7 +1489,7 @@ The variables are set in accordance with what was
remembered in `so-long'."
;; In the instance where `so-long-mode-revert' has just reverted the major
;; mode, note that `kill-all-local-variables' was already called by the
;; original mode function, and so these 'overridden' variables may now have
- ;; global rather than buffer-local values.
+ ;; global rather than buffer-local values (if they are not permanent-local).
(let* ((remembered (so-long-original variable :exists))
(originally-local (nth 2 remembered)))
(if originally-local
@@ -1380,6 +1505,24 @@ The variables are set in accordance with what was
remembered in `so-long'."
;; the old value as a buffer-local value, so we keep it simple.
(kill-local-variable variable))))
+(defun so-long-mode-maintain-preserved-variables ()
+ "Set any 'preserved' variables.
+
+The variables are set in accordance with what was remembered in `so-long'."
+ (dolist (var (so-long-original 'so-long-mode-preserved-variables))
+ (so-long-restore-variable var)))
+
+(defun so-long-mode-maintain-preserved-minor-modes ()
+ "Enable or disable 'preserved' minor modes.
+
+The modes are set in accordance with what was remembered in `so-long'."
+ (dolist (mode (so-long-original 'so-long-mode-preserved-minor-modes))
+ (when (boundp mode)
+ (let ((original (so-long-original mode))
+ (current (symbol-value mode)))
+ (unless (equal current original)
+ (funcall mode (if original 1 0)))))))
+
(defun so-long-mode-revert ()
"Call the `major-mode' which was selected before `so-long-mode' replaced it.
@@ -1407,6 +1550,10 @@ This is the `so-long-revert-function' for
`so-long-mode'."
;; `kill-all-local-variables' was already called by the original mode
;; function, so we may be seeing global values.
(so-long-restore-variables)
+ ;; Check/set the state of 'preserved' variables and minor modes.
+ ;; (Refer to `so-long-after-change-major-mode' regarding the sequence.)
+ (so-long-mode-maintain-preserved-minor-modes)
+ (so-long-mode-maintain-preserved-variables)
;; Restore the mode line construct.
(unless (derived-mode-p 'so-long-mode)
(setq so-long-mode-line-info (so-long-mode-line-info)))))
@@ -1648,8 +1795,7 @@ invoking the new action."
(when so-long--active
(so-long-revert))
;; Invoke the new action.
- (let ((so-long--calling t)
- (view-mode-active view-mode))
+ (let ((so-long--calling t))
(so-long--ensure-enabled)
;; ACTION takes precedence if supplied.
(when action
@@ -1678,10 +1824,7 @@ invoking the new action."
;; functions need to modify the buffer. We use `inhibit-read-only' to
;; side-step the issue (and likewise in `so-long-revert').
(let ((inhibit-read-only t))
- (run-hooks 'so-long-hook))
- ;; Restore `view-mode'.
- (when view-mode-active
- (view-mode)))))
+ (run-hooks 'so-long-hook)))))
(defun so-long-revert ()
"Revert the active `so-long-action' and run `so-long-revert-hook'.
@@ -1896,7 +2039,7 @@ If it appears in `%s', you should remove it."
(unless global-so-long-mode
(global-so-long-mode 1)))
(makunbound 'so-long-mode-enabled))
- ;; Update to version 1.N:
+ ;; Update to version 1.N from earlier versions:
;; (when (version< so-long-version "1.N") ...)
;;
;; All updates completed.
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 4666026..34fbec9 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1822,9 +1822,9 @@ matches the user directory ~, then it is replaced with a
~.
INDEX is not used, but is required by the caller."
(let* ((tilde (expand-file-name "~/"))
(dd (expand-file-name directory))
- (junk (string-prefix-p "~/" dd))
+ (junk (string-match (regexp-quote tilde) dd))
(displayme (if junk
- (concat "~/" (substring dd 2 nil))
+ (concat "~/" (substring dd (match-end 0)))
dd))
(p (point)))
(if (string-match "^~[/\\]?\\'" displayme) (setq displayme tilde))
diff --git a/lisp/startup.el b/lisp/startup.el
index 456c01e..f337f7c 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -2391,6 +2391,7 @@ nil default-directory" name)
(command-line-normalize-file-name name)
dir))
(buf (find-file-noselect file)))
+ (file-name-history--add file)
(setq displayable-buffers (cons buf displayable-buffers))
;; Set the file buffer to the current buffer so
;; that it will be used with "--eval" and
diff --git a/lisp/subr.el b/lisp/subr.el
index e49c277..b828660 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -31,7 +31,8 @@
"Tell the byte-compiler that function FN is defined, in FILE.
The FILE argument is not used by the byte-compiler, but by the
`check-declare' package, which checks that FILE contains a
-definition for FN.
+definition for FN. (FILE can be nil, and that disables this
+check.)
FILE can be either a Lisp file (in which case the \".el\"
extension is optional), or a C file. C files are expanded
@@ -2000,10 +2001,10 @@ all symbols are bound before any of the VALUEFORMs are
evalled."
(t `(let* ,(nreverse seqbinds) ,nbody))))))
(defmacro dlet (binders &rest body)
- "Like `let*' but using dynamic scoping."
+ "Like `let' but using dynamic scoping."
(declare (indent 1) (debug let))
;; (defvar FOO) only affects the current scope, but in order for
- ;; this not to affect code after the `let*' we need to create a new scope,
+ ;; this not to affect code after the main `let' we need to create a new
scope,
;; which is what the surrounding `let' is for.
;; FIXME: (let () ...) currently doesn't actually create a new scope,
;; which is why we use (let (_) ...).
@@ -2011,7 +2012,7 @@ all symbols are bound before any of the VALUEFORMs are
evalled."
,@(mapcar (lambda (binder)
`(defvar ,(if (consp binder) (car binder) binder)))
binders)
- (let* ,binders ,@body)))
+ (let ,binders ,@body)))
(defmacro with-wrapper-hook (hook args &rest body)
@@ -3850,6 +3851,14 @@ Before insertion, process text properties according to
(insert-buffer-substring buffer start end)
(remove-yank-excluded-properties opoint (point))))
+(defun insert-into-buffer (buffer &optional start end)
+ "Insert the contents of the current buffer into BUFFER.
+If START/END, only insert that region from the current buffer.
+Point in BUFFER will be placed after the inserted text."
+ (let ((current (current-buffer)))
+ (with-current-buffer buffer
+ (insert-buffer-substring current start end))))
+
(defun yank-handle-font-lock-face-property (face start end)
"If `font-lock-defaults' is nil, apply FACE as a `face' property.
START and END denote the start and end of the text to act on.
@@ -6303,4 +6312,12 @@ of fill.el (for example `fill-region')."
This is intended for internal use only."
(internal--fill-string-single-line (apply #'format string objects)))
+(defun json-available-p ()
+ "Return non-nil if Emacs has libjansson support."
+ (and (fboundp 'json-serialize)
+ (condition-case nil
+ (json-serialize t)
+ (:success t)
+ (json-unavailable nil))))
+
;;; subr.el ends here
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 41d565a..7459e1b 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -136,14 +136,13 @@ Possible modifier keys are `control', `meta', `shift',
`hyper', `super' and
;; Replace default value with a condition that supports displaying
;; global-mode-string in the tab bar instead of the mode line.
(when (and (memq 'tab-bar-format-global tab-bar-format)
- (member '(global-mode-string ("" global-mode-string " "))
+ (member '(global-mode-string ("" global-mode-string))
mode-line-misc-info))
(setf (alist-get 'global-mode-string mode-line-misc-info)
'(("" (:eval (if (and tab-bar-mode
(memq 'tab-bar-format-global
tab-bar-format))
- "" global-mode-string))
- " ")))))
+ "" global-mode-string)))))))
(defun tab-bar--undefine-keys ()
"Uninstall key bindings previously bound by `tab-bar--define-keys'."
@@ -748,7 +747,7 @@ 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)))
+ `((global menu-item ,(string-trim-right (format-mode-line
global-mode-string)) ignore)))
(defun tab-bar-format-list (format-list)
(let ((i 0))
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 0d97da8..d5fad35 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -471,7 +471,10 @@ should return the formatted tab name to display in the tab
line."
(dolist (fn tab-line-tab-face-functions)
(setf face (funcall fn tab tabs face buffer-p selected-p)))
(apply 'propertize
- (concat (propertize name 'keymap tab-line-tab-map)
+ (concat (propertize name
+ 'keymap tab-line-tab-map
+ ;; Don't turn mouse-1 into mouse-2 (bug#49247)
+ 'follow-link 'ignore)
(or (and (or buffer-p (assq 'buffer tab) (assq 'close tab))
tab-line-close-button-show
(not (eq tab-line-close-button-show
diff --git a/lisp/term.el b/lisp/term.el
index d41895a..27f0bb1 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -864,8 +864,30 @@ is buffer-local."
["Paging" term-pager-toggle :style toggle :selected term-pager-count
:help "Toggle paging feature"]))
+(defun term--update-term-menu (&optional force)
+ (when (and (lookup-key term-mode-map [menu-bar terminal])
+ (or force (frame-or-buffer-changed-p)))
+ (let ((buffer-list
+ (seq-filter
+ (lambda (buffer)
+ (provided-mode-derived-p (buffer-local-value 'major-mode buffer)
+ 'term-mode))
+ (buffer-list))))
+ (easy-menu-change
+ '("Terminal")
+ "Terminal Buffers"
+ (mapcar
+ (lambda (buffer)
+ (vector (format "%s (%s)" (buffer-name buffer)
+ (abbreviate-file-name
+ (buffer-local-value 'default-directory buffer)))
+ (lambda ()
+ (interactive)
+ (switch-to-buffer buffer))))
+ buffer-list)))))
+
(easy-menu-define term-signals-menu
- (list term-mode-map term-raw-map term-pager-break-map)
+ (list term-mode-map term-raw-map term-pager-break-map)
"Signals menu for Term mode."
'("Signals"
["BREAK" term-interrupt-subjob :active t
@@ -1076,6 +1098,7 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(setq-local term-pending-delete-marker (make-marker))
(make-local-variable 'term-current-face)
(term-ansi-reset)
+ (add-hook 'menu-bar-update-hook 'term--update-term-menu)
(setq-local term-pending-frame nil)
;; Cua-mode's keybindings interfere with the term keybindings, disable it.
(setq-local cua-mode nil)
@@ -1275,7 +1298,10 @@ without any interpretation."
(defun term-char-mode ()
"Switch to char (\"raw\") sub-mode of term mode.
Each character you type is sent directly to the inferior without
-intervention from Emacs, except for the escape character (usually C-c)."
+intervention from Emacs, except for the escape character (usually C-c).
+
+This command will send existing partial lines to the terminal
+process."
(interactive)
;; FIXME: Emit message? Cfr ilisp-raw-message
(when (term-in-line-mode)
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index ba8fac8..877658a 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -38,7 +38,7 @@
;;; Code:
-(provide 'enriched)
+(require 'facemenu)
;;;
;;; Variables controlling the display
@@ -538,4 +538,6 @@ the range of text to assign text property SYMBOL with value
VALUE."
(list start end 'display prop)
(list start end 'display (list 'disable-eval prop)))))
+(provide 'enriched)
+
;;; enriched.el ends here
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 3914bde..f394171 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -133,6 +133,8 @@ A nil return value means the function has not determined
the fill prefix."
(defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks.
"Whether or not filling should try to use the major mode's indentation.")
+(defvar current-fill-column--has-warned nil)
+
(defun current-fill-column ()
"Return the fill-column to use for this line.
The fill-column to use for a buffer is stored in the variable `fill-column',
@@ -158,7 +160,14 @@ number equals or exceeds the local fill-column -
right-margin difference."
(< col fill-col)))
(setq here change
here-col col))
- (max here-col fill-col)))))
+ (max here-col fill-col))
+ ;; This warning was added in 28.1. It should be removed later,
+ ;; and this function changed to never return nil.
+ (unless current-fill-column--has-warned
+ (lwarn '(fill-column) :warning
+ "Setting this variable to nil is obsolete; use `(auto-fill-mode
-1)' instead")
+ (setq current-fill-column--has-warned t))
+ most-positive-fixnum)))
(defun canonically-space-region (beg end)
"Remove extra spaces between words in region.
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 0a82bf5..4c64531 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -649,11 +649,7 @@ Otherwise returns the library directory name, if that is
defined."
result libvar status ispell-program-version)
(with-temp-buffer
- (setq status (ispell-call-process
- ispell-program-name nil t nil
- (let ((case-fold-search
- (memq system-type '(ms-dos windows-nt))))
- "-vv")))
+ (setq status (ispell-call-process ispell-program-name nil t nil "-vv"))
(goto-char (point-min))
(if interactivep
;; Report version information of ispell
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index 4acdc9f..fbb66fe 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -223,8 +223,10 @@ recorded somewhere by that function."
;;; Internal Variables:
-(defvar remember-buffer "*Remember*"
- "The name of the remember data entry buffer.")
+(defcustom remember-buffer "*Remember*"
+ "The name of the remember data entry buffer."
+ :version "28.1"
+ :type 'string)
(defcustom remember-save-after-remembering t
"Non-nil means automatically save after remembering."
@@ -240,10 +242,10 @@ recorded somewhere by that function."
(defvar remember-annotation nil
"Current annotation.")
(defvar remember-initial-contents nil
- "Initial contents to place into *Remember* buffer.")
+ "Initial contents to place into `remember-buffer'.")
(defcustom remember-before-remember-hook nil
- "Functions run before switching to the *Remember* buffer."
+ "Functions run before switching to the `remember-buffer'."
:type 'hook)
(defcustom remember-run-all-annotation-functions-flag nil
@@ -253,8 +255,8 @@ recorded somewhere by that function."
;;;###autoload
(defun remember (&optional initial)
"Remember an arbitrary piece of data.
-INITIAL is the text to initially place in the *Remember* buffer,
-or nil to bring up a blank *Remember* buffer.
+INITIAL is the text to initially place in the `remember-buffer',
+or nil to bring up a blank `remember-buffer'.
With a prefix or a visible region, use the region as INITIAL."
(interactive
@@ -422,7 +424,7 @@ return the text to be remembered."
(defun remember-region (&optional beg end)
"Remember the data from BEG to END.
-It is called from within the *Remember* buffer to save the text
+It is called from within the `remember-buffer' to save the text
that was entered.
If BEG and END are nil, the entire buffer will be remembered.
@@ -478,7 +480,7 @@ Most useful for remembering things from other applications."
(remember-region (point-min) (point-max)))
(defun remember-destroy ()
- "Destroy the current *Remember* buffer."
+ "Destroy the current `remember-buffer'."
(interactive)
(when (equal remember-buffer (buffer-name))
(kill-buffer (current-buffer))
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 8b8108c..d9d8059 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1426,20 +1426,25 @@ on the line for the invalidity you want to see."
;; Skip "Mismatches:" header line.
(forward-line 1)
(setq num-matches (1+ num-matches))
- (insert-buffer-substring buffer start end)
- (let (text-beg (text-end (point-marker)))
- (forward-char (- start end))
- (setq text-beg (point-marker))
- (insert (format "%3d: " linenum))
- (add-text-properties
- text-beg (- text-end 1)
- '(mouse-face highlight
- help-echo
- "mouse-2: go to this invalidity"))
- (put-text-property text-beg (- text-end 1)
- 'occur-target tem))))))))
+ (let ((inhibit-read-only t))
+ (insert-buffer-substring buffer start end)
+ (let ((text-end (point-marker))
+ text-beg)
+ (forward-char (- start end))
+ (setq text-beg (point-marker))
+ (insert (format "%3d: " linenum))
+ (add-text-properties
+ text-beg (- text-end 1)
+ '(mouse-face highlight
+ help-echo
+ "mouse-2: go to this invalidity"))
+ (put-text-property (point) (- text-end 1)
+ 'occur-match t)
+ (put-text-property text-beg text-end
+ 'occur-target tem)))))))))
(with-current-buffer standard-output
- (let ((no-matches (zerop num-matches)))
+ (let ((no-matches (zerop num-matches))
+ (inhibit-read-only t))
(if no-matches
(insert "None!\n"))
(if (called-interactively-p 'interactive)
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 8ca0f42..5bbf1a8 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -73,8 +73,8 @@ provider functions are called with no parameters at the point
in
question.
\"things\" include `symbol', `list', `sexp', `defun', `filename',
-`url', `email', `uuid', `word', `sentence', `whitespace', `line',
-and `page'.")
+`existing-filename', `url', `email', `uuid', `word', `sentence',
+`whitespace', `line', and `page'.")
;; Basic movement
@@ -156,8 +156,8 @@ positions of the thing found."
"Return the THING at point.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
-`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
-`line', `number', and `page'.
+`filename', `existing-filename', `url', `email', `uuid', `word',
+`sentence', `whitespace', `line', `number', and `page'.
When the optional argument NO-PROPERTIES is non-nil,
strip text properties from the return value.
@@ -301,6 +301,17 @@ E.g.:
(define-thing-chars filename thing-at-point-file-name-chars)
+;; Files
+
+(defun thing-at-point-file-at-point (&optional _lax _bounds)
+ "Return the name of the existing file at point."
+ (when-let ((filename (thing-at-point 'filename)))
+ (setq filename (expand-file-name filename))
+ (and (file-exists-p filename)
+ filename)))
+
+(put 'existing-filename 'thing-at-point 'thing-at-point-file-at-point)
+
;; URIs
(defvar thing-at-point-beginning-of-url-regexp nil
@@ -677,14 +688,14 @@ Signal an error if the entire string was not used."
"Return the number at point, or nil if none is found.
Decimal numbers like \"14\" or \"-14.5\", as well as hex numbers
like \"0xBEEF09\" or \"#xBEEF09\", are recognized."
- (when (thing-at-point-looking-at
- "\\(-?[0-9]+\\.?[0-9]*\\)\\|\\(0x\\|#x\\)\\([a-zA-Z0-9]+\\)" 500)
- (if (match-beginning 1)
- (string-to-number
- (buffer-substring (match-beginning 1) (match-end 1)))
- (string-to-number
- (buffer-substring (match-beginning 3) (match-end 3))
- 16))))
+ (cond
+ ((thing-at-point-looking-at "\\(0x\\|#x\\)\\([a-fA-F0-9]+\\)" 500)
+ (string-to-number
+ (buffer-substring (match-beginning 2) (match-end 2))
+ 16))
+ ((thing-at-point-looking-at "-?[0-9]+\\.?[0-9]*" 500)
+ (string-to-number
+ (buffer-substring (match-beginning 0) (match-end 0))))))
(put 'number 'thing-at-point 'number-at-point)
;;;###autoload
diff --git a/lisp/time.el b/lisp/time.el
index fd53f63..9f25f99 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -205,7 +205,8 @@ depend on `display-time-day-and-date' and
`display-time-24hr-format'."
'mouse-face 'mode-line-highlight
'local-map (make-mode-line-mouse-map 'mouse-2
read-mail-command)))
- ""))
+ "")
+ " ")
"List of expressions governing display of the time in the mode line.
For most purposes, you can control the time format using `display-time-format'
which is a more standard interface.
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 7c913bc..8b79736 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -335,10 +335,13 @@ instead of just \"key\" as in the example above."
;;;###autoload
(defun url-unhex-string (str &optional allow-newlines)
- "Remove %XX embedded spaces, etc in a URL.
+ "Decode %XX sequences in a percent-encoded URL.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
decoding of carriage returns and line feeds in the string, which is normally
-forbidden in URL encoding."
+forbidden in URL encoding.
+
+The resulting string in general requires decoding using an
+appropriate coding-system; see `decode-coding-string'."
(setq str (or str ""))
(let ((tmp "")
(case-fold-search t))
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 8daf9f0..ccc95a6 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -208,9 +208,10 @@ URL-encoded before it's used."
(url-find-proxy-for-url url (url-host url))))
(buffer nil)
(asynch (url-scheme-get-property (url-type url) 'asynchronous-p)))
- (if url-using-proxy
- (setq asynch t
- loader #'url-proxy))
+ (when url-using-proxy
+ (setf asynch t
+ loader #'url-proxy
+ (url-asynchronous url) t))
(if asynch
(let ((url-current-object url))
(setq buffer (funcall loader url callback cbargs)))
@@ -234,85 +235,55 @@ If INHIBIT-COOKIES is non-nil, refuse to store cookies.
If
TIMEOUT is passed, it should be a number that says (in seconds)
how long to wait for a response before giving up."
(url-do-setup)
-
- (let ((retrieval-done nil)
- (start-time (current-time))
- (url-asynchronous nil)
- (asynch-buffer nil)
- (timed-out nil))
- (setq asynch-buffer
- (url-retrieve url (lambda (&rest ignored)
- (url-debug 'retrieval "Synchronous fetching done
(%S)" (current-buffer))
- (setq retrieval-done t
- asynch-buffer (current-buffer)))
- nil silent inhibit-cookies))
- (if (null asynch-buffer)
- ;; We do not need to do anything, it was a mailto or something
- ;; similar that takes processing completely outside of the URL
- ;; package.
- nil
- (let ((proc (get-buffer-process asynch-buffer)))
- ;; If the access method was synchronous, `retrieval-done' should
- ;; hopefully already be set to t. If it is nil, and `proc' is also
- ;; nil, it implies that the async process is not running in
- ;; asynch-buffer. This happens e.g. for FTP files. In such a case
- ;; url-file.el should probably set something like a `url-process'
- ;; buffer-local variable so we can find the exact process that we
- ;; should be waiting for. In the mean time, we'll just wait for any
- ;; process output.
- (while (and (not retrieval-done)
- (or (not timeout)
- (not (setq timed-out
- (time-less-p timeout
- (time-since start-time))))))
- (url-debug 'retrieval
- "Spinning in url-retrieve-synchronously: %S (%S)"
- retrieval-done asynch-buffer)
- (if (buffer-local-value 'url-redirect-buffer asynch-buffer)
- (setq proc (get-buffer-process
- (setq asynch-buffer
- (buffer-local-value 'url-redirect-buffer
- asynch-buffer))))
- (if (and proc (memq (process-status proc)
- '(closed exit signal failed))
- ;; Make sure another process hasn't been started.
- (eq proc (or (get-buffer-process asynch-buffer) proc)))
- ;; FIXME: It's not clear whether url-retrieve's callback is
- ;; guaranteed to be called or not. It seems that url-http
- ;; decides sometimes consciously not to call it, so it's not
- ;; clear that it's a bug, but even then we need to decide how
- ;; url-http can then warn us that the download has completed.
- ;; In the mean time, we use this here workaround.
- ;; XXX: The callback must always be called. Any
- ;; exception is a bug that should be fixed, not worked
- ;; around.
- (progn ;; Call delete-process so we run any sentinel now.
- (delete-process proc)
- (setq retrieval-done t)))
- ;; We used to use `sit-for' here, but in some cases it wouldn't
- ;; work because apparently pending keyboard input would always
- ;; interrupt it before it got a chance to handle process input.
- ;; `sleep-for' was tried but it lead to other forms of
- ;; hanging. --Stef
- (unless (or (with-local-quit
- (accept-process-output proc 1))
- (null proc))
- ;; accept-process-output returned nil, maybe because the process
- ;; exited (and may have been replaced with another). If we got
- ;; a quit, just stop.
- (when quit-flag
- (delete-process proc))
- (setq proc (and (not quit-flag)
- (get-buffer-process asynch-buffer))))))
- ;; On timeouts, make sure we kill any pending processes.
- ;; There may be more than one if we had a redirect.
- (when timed-out
- (when (process-live-p proc)
- (delete-process proc))
- (when-let ((aproc (get-buffer-process asynch-buffer)))
- (when (process-live-p aproc)
- (delete-process aproc))))))
- asynch-buffer))
+ (let* (url-asynchronous
+ data-buffer
+ (callback (lambda (&rest _args)
+ (setq data-buffer (current-buffer))
+ (url-debug 'retrieval
+ "Synchronous fetching done (%S)"
+ data-buffer)))
+ (start-time (current-time))
+ (proc-buffer (url-retrieve url callback nil silent
+ inhibit-cookies)))
+ (if (not proc-buffer)
+ (url-debug 'retrieval "Synchronous fetching unnecessary %s" url)
+ (unwind-protect
+ (catch 'done
+ (while (not data-buffer)
+ (when (and timeout (time-less-p timeout
+ (time-since start-time)))
+ (url-debug 'retrieval "Timed out %s (after %ss)" url
+ (float-time (time-since start-time)))
+ (throw 'done 'timeout))
+ (url-debug 'retrieval
+ "Spinning in url-retrieve-synchronously: nil (%S)"
+ proc-buffer)
+ (when-let ((redirect-buffer
+ (buffer-local-value 'url-redirect-buffer
+ proc-buffer)))
+ (unless (eq redirect-buffer proc-buffer)
+ (url-debug
+ 'retrieval "Redirect in url-retrieve-synchronously: %S ->
%S"
+ proc-buffer redirect-buffer)
+ (let (kill-buffer-query-functions)
+ (kill-buffer proc-buffer))
+ ;; Accommodate hack in commit 55d1d8b.
+ (setq proc-buffer redirect-buffer)))
+ (when-let ((proc (get-buffer-process proc-buffer)))
+ (when (memq (process-status proc)
+ '(closed exit signal failed))
+ ;; Process sentinel vagaries occasionally cause
+ ;; url-retrieve to fail calling callback.
+ (unless data-buffer
+ (url-debug 'retrieval "Dead process %s" url)
+ (throw 'done 'exception))))
+ ;; Querying over consumer internet in the US takes 100
+ ;; ms, so split the difference.
+ (accept-process-output nil 0.05)))
+ (unless (eq data-buffer proc-buffer)
+ (let (kill-buffer-query-functions)
+ (kill-buffer proc-buffer)))))
+ data-buffer))
;; url-mm-callback called from url-mm, which requires mm-decode.
(declare-function mm-dissect-buffer "mm-decode"
diff --git a/lisp/userlock.el b/lisp/userlock.el
index 4a75815..38aaf6a 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -230,7 +230,7 @@ to get the latest version of the file, then make the change
again."
(display-warning
'(unlock-file)
;; There is no need to explain that this is an unlock error because
- ;; ERR is a `file-error' condition, which explains this.
+ ;; ERROR is a `file-error' condition, which explains this.
(message "%s, ignored" (error-message-string error))
:warning))
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index b2b92b1..0cbea2c 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -563,8 +563,9 @@ to invocation.")
(set-visited-file-name merge-buffer-file))))
(ediff-with-current-buffer ediff-buffer-C
(setq buffer-offer-save t) ; ask before killing buffer
- ;; make sure the contents is auto-saved
- (auto-save-mode 1))
+ (when make-backup-files
+ ;; make sure the contents is auto-saved
+ (auto-save-mode 1)))
))
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 694d452..956d9b3 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -214,6 +214,9 @@ Used in `smerge-diff-base-upper' and related functions."
["Invoke Ediff" smerge-ediff
:help "Use Ediff to resolve the conflicts"
:active (smerge-check 1)]
+ ["Refine" smerge-refine
+ :help "Highlight different words of the conflict"
+ :active (smerge-check 1)]
["Auto Resolve" smerge-resolve
:help "Try auto-resolution heuristics"
:active (smerge-check 1)]
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 89f9800..1430871 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -375,7 +375,7 @@ in the order given by `git status'."
"Return a string for `vc-mode-line' to put in the mode line for FILE."
(let* ((rev (vc-working-revision file 'Git))
(disp-rev (or (vc-git--symbolic-ref file)
- (substring rev 0 7)))
+ (and rev (substring rev 0 7))))
(def-ml (vc-default-mode-line-string 'Git file))
(help-echo (get-text-property 0 'help-echo def-ml))
(face (get-text-property 0 'face def-ml)))
@@ -1772,6 +1772,7 @@ The difference to vc-do-command is that this function
always invokes
(process-environment
(append
`("GIT_DIR"
+ "GIT_LITERAL_PATHSPECS=1"
;; Avoid repository locking during background operations
;; (bug#21559).
,@(when revert-buffer-in-progress-p
@@ -1806,6 +1807,7 @@ The difference to vc-do-command is that this function
always invokes
(process-environment
(append
`("GIT_DIR"
+ "GIT_LITERAL_PATHSPECS=1"
;; Avoid repository locking during background operations
;; (bug#21559).
,@(when revert-buffer-in-progress-p
diff --git a/lisp/wdired.el b/lisp/wdired.el
index 22c1ceb..fd549ba 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -297,26 +297,28 @@ or \\[wdired-abort-changes] to abort changes")))
(defun wdired--before-change-fn (beg end)
(save-match-data
(save-excursion
- ;; Make sure to process entire lines.
- (goto-char end)
- (setq end (line-end-position))
- (goto-char beg)
- (forward-line 0)
-
- (while (< (point) end)
- (unless (wdired--line-preprocessed-p)
+ (save-restriction
+ (widen)
+ ;; Make sure to process entire lines.
+ (goto-char end)
+ (setq end (line-end-position))
+ (goto-char beg)
+ (forward-line 0)
+
+ (while (< (point) end)
+ (unless (wdired--line-preprocessed-p)
+ (with-silent-modifications
+ (put-text-property (point) (1+ (point)) 'front-sticky t)
+ (wdired--preprocess-files)
+ (when wdired-allow-to-change-permissions
+ (wdired--preprocess-perms))
+ (when (fboundp 'make-symbolic-link)
+ (wdired--preprocess-symlinks))))
+ (forward-line))
+ (when (eobp)
(with-silent-modifications
- (put-text-property (point) (1+ (point)) 'front-sticky t)
- (wdired--preprocess-files)
- (when wdired-allow-to-change-permissions
- (wdired--preprocess-perms))
- (when (fboundp 'make-symbolic-link)
- (wdired--preprocess-symlinks))))
- (forward-line))
- (when (eobp)
- (with-silent-modifications
- ;; Is this good enough? Assumes no extra white lines from dired.
- (put-text-property (1- (point-max)) (point-max) 'read-only t))))))
+ ;; Is this good enough? Assumes no extra white lines from dired.
+ (put-text-property (1- (point-max)) (point-max) 'read-only t)))))))
(defun wdired-isearch-filter-read-only (beg end)
"Skip matches that have a read-only property."
@@ -700,47 +702,49 @@ Optional arguments are ignored."
(defun wdired--restore-properties (beg end _len)
(save-match-data
(save-excursion
- (let ((lep (line-end-position))
- (used-F (dired-check-switches
- dired-actual-switches
- "F" "classify")))
- ;; Deleting the space between the link name and the arrow (a
- ;; noop) also deletes the end-name property, so restore it.
- (when (and (save-excursion
- (re-search-backward dired-permission-flags-regexp nil t)
- (looking-at "l"))
- (get-text-property (1- (point)) 'dired-filename)
- (not (get-text-property (point) 'dired-filename))
- (not (get-text-property (point) 'end-name)))
+ (save-restriction
+ (widen)
+ (let ((lep (line-end-position))
+ (used-F (dired-check-switches
+ dired-actual-switches
+ "F" "classify")))
+ ;; Deleting the space between the link name and the arrow (a
+ ;; noop) also deletes the end-name property, so restore it.
+ (when (and (save-excursion
+ (re-search-backward dired-permission-flags-regexp nil t)
+ (looking-at "l"))
+ (get-text-property (1- (point)) 'dired-filename)
+ (not (get-text-property (point) 'dired-filename))
+ (not (get-text-property (point) 'end-name)))
(put-text-property (point) (1+ (point)) 'end-name t))
- (beginning-of-line)
- (when (re-search-forward
- directory-listing-before-filename-regexp lep t)
- (setq beg (point)
- end (if (or
- ;; If the file is a symlink, put the
- ;; dired-filename property only on the link
- ;; name. (Using (file-symlink-p
- ;; (dired-get-filename)) fails in
- ;; wdired-mode, bug#32673.)
- (and (re-search-backward
- dired-permission-flags-regexp nil t)
- (looking-at "l")
- ;; macOS and Ultrix adds "@" to the end
- ;; of symlinks when using -F.
- (if (and used-F
- dired-ls-F-marks-symlinks)
- (re-search-forward "@? -> " lep t)
- (search-forward " -> " lep t)))
- ;; When dired-listing-switches includes "F"
- ;; or "classify", don't treat appended
- ;; indicator characters as part of the file
- ;; name (bug#34915).
- (and used-F
- (re-search-forward "[*/@|=>]$" lep t)))
- (goto-char (match-beginning 0))
- lep))
- (put-text-property beg end 'dired-filename t))))))
+ (beginning-of-line)
+ (when (re-search-forward
+ directory-listing-before-filename-regexp lep t)
+ (setq beg (point)
+ end (if (or
+ ;; If the file is a symlink, put the
+ ;; dired-filename property only on the link
+ ;; name. (Using (file-symlink-p
+ ;; (dired-get-filename)) fails in
+ ;; wdired-mode, bug#32673.)
+ (and (re-search-backward
+ dired-permission-flags-regexp nil t)
+ (looking-at "l")
+ ;; macOS and Ultrix adds "@" to the end
+ ;; of symlinks when using -F.
+ (if (and used-F
+ dired-ls-F-marks-symlinks)
+ (re-search-forward "@? -> " lep t)
+ (search-forward " -> " lep t)))
+ ;; When dired-listing-switches includes "F"
+ ;; or "classify", don't treat appended
+ ;; indicator characters as part of the file
+ ;; name (bug#34915).
+ (and used-F
+ (re-search-forward "[*/@|=>]$" lep t)))
+ (goto-char (match-beginning 0))
+ lep))
+ (put-text-property beg end 'dired-filename t)))))))
(defun wdired-next-line (arg)
"Move down lines then position at filename or the current column.
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index aaa5683..a2dc6ab 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -593,7 +593,7 @@ Used when `whitespace-style' includes the value `empty'.")
(defface whitespace-empty
'((((class mono)) :inverse-video t :weight bold :underline t)
- (t :background "yellow" :foreground "firebrick"))
+ (t :background "yellow" :foreground "firebrick" :extend t))
"Face used to visualize empty lines at beginning and/or end of buffer."
:group 'whitespace)
diff --git a/lisp/window.el b/lisp/window.el
index c0511be..0346397 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -8733,6 +8733,13 @@ documentation for additional customization information."
BUFFER-OR-NAME may be a buffer, a string (a buffer name), or
nil. Return the buffer switched to.
+This uses the function `display-buffer' as a subroutine to
+display the buffer; see its documentation for additional
+customization information. By default, if the buffer is already
+displayed (even in the current frame), that window is selected.
+If the buffer isn't displayed in any frame, a new frame is popped
+up and the buffer is displayed there.
+
If called interactively, read the buffer name using `read-buffer'.
The variable `confirm-nonexistent-file-or-buffer' determines
whether to request confirmation before creating a new buffer.
@@ -8744,10 +8751,7 @@ buffer, create a new buffer with that name. If
BUFFER-OR-NAME is
nil, switch to the buffer returned by `other-buffer'.
Optional second arg NORECORD non-nil means do not put this
-buffer at the front of the list of recently selected ones.
-
-This uses the function `display-buffer' as a subroutine; see its
-documentation for additional customization information."
+buffer at the front of the list of recently selected ones."
(interactive
(list (read-buffer-to-switch "Switch to buffer in other frame: ")))
(pop-to-buffer buffer-or-name display-buffer--other-frame-action norecord))
diff --git a/lisp/woman.el b/lisp/woman.el
index d9aa573..0bc992d 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1274,9 +1274,11 @@ cache to be re-read."
;; Complete topic more carefully, i.e. use the completion
;; rather than the string entered by the user:
((setq files (all-completions topic woman-topic-all-completions))
- (while (/= (length topic) (length (car files)))
+ (while (and files
+ (/= (length topic) (length (car files))))
(setq files (cdr files)))
- (setq files (woman-file-name-all-completions (car files)))))
+ (when files
+ (setq files (woman-file-name-all-completions (car files))))))
(cond
((null files) nil) ; no file found for topic.
((null (cdr files)) (car (car files))) ; only 1 file for topic.
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index cd6f7b4..05e7faa 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -89,6 +89,7 @@ AC_DEFUN([gl_EARLY],
# Code from module fcntl:
# Code from module fcntl-h:
# Code from module fdopendir:
+ # Code from module file-has-acl:
# Code from module filemode:
# Code from module filename:
# Code from module filevercmp:
@@ -287,6 +288,7 @@ AC_DEFUN([gl_INIT],
fi
gl_DIRENT_MODULE_INDICATOR([fdopendir])
gl_MODULE_INDICATOR([fdopendir])
+ gl_FILE_HAS_ACL
gl_FILEMODE
AC_C_FLEXIBLE_ARRAY_MEMBER
gl_FUNC_FPENDING
@@ -1045,6 +1047,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/fcntl.c
lib/fcntl.in.h
lib/fdopendir.c
+ lib/file-has-acl.c
lib/filemode.c
lib/filemode.h
lib/filename.h
diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk
index 5cdbde6..c85b915 100644
--- a/nt/gnulib-cfg.mk
+++ b/nt/gnulib-cfg.mk
@@ -68,3 +68,4 @@ OMIT_GNULIB_MODULE_fchmodat = true
OMIT_GNULIB_MODULE_lchmod = true
OMIT_GNULIB_MODULE_futimens = true
OMIT_GNULIB_MODULE_utimensat = true
+OMIT_GNULIB_MODULE_file-has-acl = true
diff --git a/oldXMenu/Create.c b/oldXMenu/Create.c
index 7eb17c5..e209bbe 100644
--- a/oldXMenu/Create.c
+++ b/oldXMenu/Create.c
@@ -598,6 +598,8 @@ XMenuCreate(Display *display, Window parent, register char
const *def_env)
* Create pane, active, and inactive GC's.
*/
values = (XGCValues *)malloc(sizeof(XGCValues));
+ if (!values)
+ return NULL;
valuemask = (GCForeground | GCBackground | GCFont | GCLineWidth);
/*
diff --git a/oldXMenu/Internal.c b/oldXMenu/Internal.c
index f489e27..3e97f9a 100644
--- a/oldXMenu/Internal.c
+++ b/oldXMenu/Internal.c
@@ -534,7 +534,6 @@ _XMRecomputePane(register Display *display, register XMenu
*menu, register XMPan
register int window_y; /* Recomputed window Y coordinate. */
unsigned long change_mask; /* Value mask to reconfigure window. */
- XWindowChanges *changes; /* Values to use in configure window. */
register Bool config_p = False; /* Reconfigure pane window? */
@@ -612,21 +611,19 @@ _XMRecomputePane(register Display *display, register
XMenu *menu, register XMPan
* it for creation with the new configuration.
*/
if (p_ptr->window) {
+ XWindowChanges changes;
change_mask = (CWX | CWY | CWWidth | CWHeight);
- changes = (XWindowChanges *)malloc(sizeof(XWindowChanges));
- changes->x = p_ptr->window_x;
- changes->y = p_ptr->window_y;
- changes->width = p_ptr->window_w;
- changes->height = p_ptr->window_h;
+ changes.x = p_ptr->window_x;
+ changes.y = p_ptr->window_y;
+ changes.width = p_ptr->window_w;
+ changes.height = p_ptr->window_h;
XConfigureWindow(
display,
p_ptr->window,
change_mask,
- changes
+ &changes
);
- free(changes);
-
}
else {
if (_XMWinQueAddPane(display, menu, p_ptr) == _FAILURE) {
@@ -681,7 +678,6 @@ _XMRecomputeSelection(register Display *display, register
XMenu *menu, register
/* Selection sequence number. */
{
register Bool config_s = False; /* Reconfigure selection window? */
- XWindowChanges *changes; /* Values to change in configure. */
unsigned long change_mask; /* Value mask for XConfigureWindow. */
/*
@@ -738,22 +734,19 @@ _XMRecomputeSelection(register Display *display, register
XMenu *menu, register
* for creation with the new configuration.
*/
if (s_ptr->window) {
- changes = (XWindowChanges *)malloc(sizeof(XWindowChanges));
+ XWindowChanges changes;
change_mask = (CWX | CWY | CWWidth | CWHeight);
- changes = (XWindowChanges *)malloc(sizeof(XWindowChanges));
- changes->x = s_ptr->window_x;
- changes->y = s_ptr->window_y;
- changes->width = s_ptr->window_w;
- changes->height = s_ptr->window_h;
+ changes.x = s_ptr->window_x;
+ changes.y = s_ptr->window_y;
+ changes.width = s_ptr->window_w;
+ changes.height = s_ptr->window_h;
XConfigureWindow(
display,
s_ptr->window,
change_mask,
- changes
+ &changes
);
- free(changes);
-
}
else {
if (_XMWinQueAddSelection(display, menu, s_ptr) == _FAILURE) {
diff --git a/oldXMenu/XMakeAssoc.c b/oldXMenu/XMakeAssoc.c
index 9bbde2c..2530e8e 100644
--- a/oldXMenu/XMakeAssoc.c
+++ b/oldXMenu/XMakeAssoc.c
@@ -69,6 +69,8 @@ XMakeAssoc(register Display *dpy, register XAssocTable
*table, register XID x_id
/* before the current value of "Entry". */
/* Create a new XAssoc and load it with new provided data. */
new_entry = (XAssoc *) malloc(sizeof(XAssoc));
+ if (!new_entry)
+ return; /* This obsolete API has no way to report failure! */
new_entry->display = dpy;
new_entry->x_id = x_id;
new_entry->data = data;
diff --git a/src/Makefile.in b/src/Makefile.in
index 22c7aee..732cd8f 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -326,7 +326,8 @@ GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
LIBGMP = @LIBGMP@
-LIBGCCJIT = @LIBGCCJIT_LIB@
+LIBGCCJIT_LIBS = @LIBGCCJIT_LIBS@
+LIBGCCJIT_CFLAGS = @LIBGCCJIT_CFLAGS@
## dynlib.o if necessary, else empty
DYNLIB_OBJ = @DYNLIB_OBJ@
@@ -367,7 +368,7 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \
-I$(lib) -I$(top_srcdir)/lib \
$(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \
$(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
- $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \
+ $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(LIBGCCJIT_CFLAGS) $(DBUS_CFLAGS) \
$(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) $(XDBE_CFLAGS) \
$(WEBKIT_CFLAGS) $(LCMS2_CFLAGS) \
$(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
@@ -516,7 +517,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE)
$(LIBIMAGE) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS)
$(M17N_FLT_LIBS) \
$(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \
$(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \
- $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT)
+ $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS)
## FORCE it so that admin/unidata can decide whether this file is
## up-to-date. Although since charprop depends on bootstrap-emacs,
diff --git a/src/alloc.c b/src/alloc.c
index 76d8c7d..8edcd06 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -4740,7 +4740,7 @@ live_small_vector_p (struct mem_node *m, void *p)
marked. */
static void
-mark_maybe_pointer (void *p)
+mark_maybe_pointer (void *p, bool symbol_only)
{
struct mem_node *m;
@@ -4755,14 +4755,32 @@ mark_maybe_pointer (void *p)
definitely _don't_ have an object. */
if (pdumper_object_p (p))
{
+ /* FIXME: This code assumes that every reachable pdumper object
+ is addressed either by a pointer to the object start, or by
+ the same pointer with an LSB-style tag. This assumption
+ fails if a pdumper object is reachable only via machine
+ addresses of non-initial object components. Although such
+ addressing is rare in machine code generated by C compilers
+ from Emacs source code, it can occur in some cases. To fix
+ this problem, the pdumper code should grok non-initial
+ addresses, as the non-pdumper code does. */
+ uintptr_t mask = VALMASK & UINTPTR_MAX;
+ uintptr_t masked_p = (uintptr_t) p & mask;
+ void *po = (void *) masked_p;
+ char *cp = p;
+ char *cpo = po;
/* Don't use pdumper_object_p_precise here! It doesn't check the
tag bits. OBJ here might be complete garbage, so we need to
verify both the pointer and the tag. */
- int type = pdumper_find_object_type (p);
- if (pdumper_valid_object_type_p (type))
- mark_object (type == Lisp_Symbol
- ? make_lisp_symbol (p)
- : make_lisp_ptr (p, type));
+ int type = pdumper_find_object_type (po);
+ if (pdumper_valid_object_type_p (type)
+ && (!USE_LSB_TAG || p == po || cp - cpo == type))
+ {
+ if (type == Lisp_Symbol)
+ mark_object (make_lisp_symbol (po));
+ else if (!symbol_only)
+ mark_object (make_lisp_ptr (po, type));
+ }
return;
}
@@ -4780,6 +4798,8 @@ mark_maybe_pointer (void *p)
case MEM_TYPE_CONS:
{
+ if (symbol_only)
+ return;
struct Lisp_Cons *h = live_cons_holding (m, p);
if (!h)
return;
@@ -4789,6 +4809,8 @@ mark_maybe_pointer (void *p)
case MEM_TYPE_STRING:
{
+ if (symbol_only)
+ return;
struct Lisp_String *h = live_string_holding (m, p);
if (!h)
return;
@@ -4807,6 +4829,8 @@ mark_maybe_pointer (void *p)
case MEM_TYPE_FLOAT:
{
+ if (symbol_only)
+ return;
struct Lisp_Float *h = live_float_holding (m, p);
if (!h)
return;
@@ -4816,6 +4840,8 @@ mark_maybe_pointer (void *p)
case MEM_TYPE_VECTORLIKE:
{
+ if (symbol_only)
+ return;
struct Lisp_Vector *h = live_large_vector_holding (m, p);
if (!h)
return;
@@ -4825,6 +4851,8 @@ mark_maybe_pointer (void *p)
case MEM_TYPE_VECTOR_BLOCK:
{
+ if (symbol_only)
+ return;
struct Lisp_Vector *h = live_small_vector_holding (m, p);
if (!h)
return;
@@ -4886,7 +4914,7 @@ mark_memory (void const *start, void const *end)
for (pp = start; (void const *) pp < end; pp += GC_POINTER_ALIGNMENT)
{
void *p = *(void *const *) pp;
- mark_maybe_pointer (p);
+ mark_maybe_pointer (p, false);
/* Unmask any struct Lisp_Symbol pointer that make_lisp_symbol
previously disguised by adding the address of 'lispsym'.
@@ -4895,7 +4923,7 @@ mark_memory (void const *start, void const *end)
non-adjacent words and P might be the low-order word's value. */
intptr_t ip;
INT_ADD_WRAPV ((intptr_t) p, (intptr_t) lispsym, &ip);
- mark_maybe_pointer ((void *) ip);
+ mark_maybe_pointer ((void *) ip, true);
}
}
diff --git a/src/buffer.c b/src/buffer.c
index 565577e..b177c5e 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -781,15 +781,22 @@ fetch_buffer_markers (struct buffer *b)
DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
- 2, 3,
+ 2, 4,
"bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
doc: /* Create and return an indirect buffer for buffer BASE-BUFFER,
named NAME.
BASE-BUFFER should be a live buffer, or the name of an existing buffer.
+
NAME should be a string which is not the name of an existing buffer.
Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
such as major and minor modes, in the indirect buffer.
-CLONE nil means the indirect buffer's state is reset to default values. */)
- (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone)
+
+CLONE nil means the indirect buffer's state is reset to default values.
+
+If optional argument INHIBIT-BUFFER-HOOKS is non-nil, the new buffer
+does not run the hooks `kill-buffer-hook',
+`kill-buffer-query-functions', and `buffer-list-update-hook'. */)
+ (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone,
+ Lisp_Object inhibit_buffer_hooks)
{
Lisp_Object buf, tem;
struct buffer *b;
@@ -834,6 +841,7 @@ CLONE nil means the indirect buffer's state is reset to
default values. */)
b->pt_byte = b->base_buffer->pt_byte;
b->begv_byte = b->base_buffer->begv_byte;
b->zv_byte = b->base_buffer->zv_byte;
+ b->inhibit_buffer_hooks = !NILP (inhibit_buffer_hooks);
b->newline_cache = 0;
b->width_run_cache = 0;
@@ -1076,12 +1084,12 @@ reset_buffer_local_variables (struct buffer *b, bool
permanent_too)
for (newlist = Qnil; CONSP (list); list = XCDR (list))
{
Lisp_Object elt = XCAR (list);
- /* Preserve element ELT if it's t,
- if it is a function with a `permanent-local-hook'
property,
- or if it's not a symbol. */
- if (! SYMBOLP (elt)
- || EQ (elt, Qt)
- || !NILP (Fget (elt, Qpermanent_local_hook)))
+ /* Preserve element ELT if it's t, or if it is a
+ function with a `permanent-local-hook'
+ property. */
+ if (EQ (elt, Qt)
+ || (SYMBOLP (elt)
+ && !NILP (Fget (elt, Qpermanent_local_hook))))
newlist = Fcons (elt, newlist);
}
newlist = Fnreverse (newlist);
@@ -1449,9 +1457,9 @@ state of the current buffer. Use with care. */)
{
bool already = SAVE_MODIFF < MODIFF;
if (!already && !NILP (flag))
- lock_file (fn);
+ Flock_file (fn);
else if (already && NILP (flag))
- unlock_file (fn);
+ Funlock_file (fn);
}
}
@@ -1757,7 +1765,7 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
if (thread_check_current_buffer (b))
return Qnil;
- /* Run hooks with the buffer to be killed the current buffer. */
+ /* Run hooks with the buffer to be killed as the current buffer. */
{
ptrdiff_t count = SPECPDL_INDEX ();
@@ -4214,7 +4222,11 @@ OVERLAY. */)
DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 2, 0,
doc: /* Return a list of the overlays that contain the character at POS.
-If SORTED is non-nil, then sort them by decreasing priority. */)
+If SORTED is non-nil, then sort them by decreasing priority.
+
+Zero-length overlays that start and stop at POS are not included in
+the return value. Instead use `overlays-in' if those overlays are of
+interest. */)
(Lisp_Object pos, Lisp_Object sorted)
{
ptrdiff_t len, noverlays;
diff --git a/src/callint.c b/src/callint.c
index 1862463..6f8a7f1 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -892,7 +892,10 @@ behave as if the mark were still active. */);
Vmark_even_if_inactive = Qt;
DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
- doc: /* Hook to run when about to switch windows with a mouse
command.
+ doc: /* Hook run when the user mouse-clicks in a window.
+It can be run both before and after switching windows, or even when
+not actually switching windows.
+
Its purpose is to give temporary modes such as Isearch mode
a way to turn themselves off when a mouse command switches windows. */);
Vmouse_leave_buffer_hook = Qnil;
diff --git a/src/callproc.c b/src/callproc.c
index aabc393..675b78d 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -116,11 +116,13 @@ static CHILD_SETUP_TYPE child_setup (int, int, int, char
**, char **,
const char *);
/* Return the current buffer's working directory, or the home
- directory if it's unreachable, as a string suitable for a system call.
- Signal an error if the result would not be an accessible directory. */
+ directory if it's unreachable. If ENCODE is true, return as a string
+ suitable for a system call; otherwise, return a string in its
+ internal representation. Signal an error if the result would not be
+ an accessible directory. */
Lisp_Object
-encode_current_directory (void)
+get_current_directory (bool encode)
{
Lisp_Object curdir = BVAR (current_buffer, directory);
Lisp_Object dir = Funhandled_file_name_directory (curdir);
@@ -131,12 +133,12 @@ encode_current_directory (void)
dir = build_string ("~");
dir = expand_and_dir_to_file (dir);
- dir = ENCODE_FILE (remove_slash_colon (dir));
+ Lisp_Object encoded_dir = ENCODE_FILE (remove_slash_colon (dir));
- if (! file_accessible_directory_p (dir))
+ if (! file_accessible_directory_p (encoded_dir))
report_file_error ("Setting current directory", curdir);
- return dir;
+ return encode ? encoded_dir : dir;
}
/* If P is reapable, record it as a deleted process and kill it.
@@ -225,8 +227,9 @@ DEFUN ("call-process", Fcall_process, Scall_process, 1,
MANY, 0,
The remaining arguments are optional.
The program's input comes from file INFILE (nil means `null-device').
-If you want to make the input come from an Emacs buffer, use
-`call-process-region' instead.
+If INFILE is a relative path, it will be looked for relative to the
+directory where the process is run (see below). If you want to make the
+input come from an Emacs buffer, use `call-process-region' instead.
Third argument DESTINATION specifies how to handle program's output.
If DESTINATION is a buffer, or t that stands for the current buffer,
@@ -270,7 +273,9 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION
DISPLAY &rest ARGS) *
if (nargs >= 2 && ! NILP (args[1]))
{
- infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory));
+ /* Expand infile relative to the current buffer's current
+ directory, or its unhandled equivalent ("~"). */
+ infile = Fexpand_file_name (args[1], get_current_directory (false));
CHECK_STRING (infile);
}
else
@@ -439,7 +444,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
buffer's current directory, or its unhandled equivalent. We
can't just have the child check for an error when it does the
chdir, since it's in a vfork. */
- current_dir = encode_current_directory ();
+ current_dir = get_current_directory (true);
if (STRINGP (error_file))
{
diff --git a/src/chartab.c b/src/chartab.c
index 331e859..6f0bc28 100644
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -62,6 +62,9 @@ typedef Lisp_Object (*uniprop_encoder_t) (Lisp_Object,
Lisp_Object);
static Lisp_Object uniprop_table_uncompress (Lisp_Object, int);
static uniprop_decoder_t uniprop_get_decoder (Lisp_Object);
+static Lisp_Object
+sub_char_table_ref_and_range (Lisp_Object, int, int *, int *,
+ Lisp_Object, bool);
/* 1 iff TABLE is a uniprop table. */
#define UNIPROP_TABLE_P(TABLE) \
@@ -247,6 +250,23 @@ char_table_ref (Lisp_Object table, int c)
return val;
}
+static inline Lisp_Object
+char_table_ref_simple (Lisp_Object table, int idx, int c, int *from, int *to,
+ Lisp_Object defalt, bool is_uniprop, bool is_subtable)
+{
+ Lisp_Object val = is_subtable ?
+ XSUB_CHAR_TABLE (table)->contents[idx]:
+ XCHAR_TABLE (table)->contents[idx];
+ if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
+ val = uniprop_table_uncompress (table, idx);
+ if (SUB_CHAR_TABLE_P (val))
+ val = sub_char_table_ref_and_range (val, c, from, to,
+ defalt, is_uniprop);
+ else if (NILP (val))
+ val = defalt;
+ return val;
+}
+
static Lisp_Object
sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to,
Lisp_Object defalt, bool is_uniprop)
@@ -254,31 +274,18 @@ sub_char_table_ref_and_range (Lisp_Object table, int c,
int *from, int *to,
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = tbl->depth, min_char = tbl->min_char;
int chartab_idx = CHARTAB_IDX (c, depth, min_char), idx;
- Lisp_Object val;
-
- val = tbl->contents[chartab_idx];
- if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
- val = uniprop_table_uncompress (table, chartab_idx);
- if (SUB_CHAR_TABLE_P (val))
- val = sub_char_table_ref_and_range (val, c, from, to, defalt, is_uniprop);
- else if (NILP (val))
- val = defalt;
+ Lisp_Object val
+ = char_table_ref_simple (table, chartab_idx, c, from, to,
+ defalt, is_uniprop, true);
idx = chartab_idx;
while (idx > 0 && *from < min_char + idx * chartab_chars[depth])
{
- Lisp_Object this_val;
-
c = min_char + idx * chartab_chars[depth] - 1;
idx--;
- this_val = tbl->contents[idx];
- if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
- this_val = uniprop_table_uncompress (table, idx);
- if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt,
- is_uniprop);
- else if (NILP (this_val))
- this_val = defalt;
+ Lisp_Object this_val
+ = char_table_ref_simple (table, idx, c, from, to,
+ defalt, is_uniprop, true);
if (! EQ (this_val, val))
{
@@ -290,17 +297,11 @@ sub_char_table_ref_and_range (Lisp_Object table, int c,
int *from, int *to,
< chartab_chars[depth - 1])
&& (c += min_char) <= *to)
{
- Lisp_Object this_val;
-
chartab_idx++;
- this_val = tbl->contents[chartab_idx];
- if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
- this_val = uniprop_table_uncompress (table, chartab_idx);
- if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt,
- is_uniprop);
- else if (NILP (this_val))
- this_val = defalt;
+ Lisp_Object this_val
+ = char_table_ref_simple (table, chartab_idx, c, from, to,
+ defalt, is_uniprop, true);
+
if (! EQ (this_val, val))
{
*to = c - 1;
@@ -321,37 +322,26 @@ Lisp_Object
char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
- int chartab_idx = CHARTAB_IDX (c, 0, 0), idx;
- Lisp_Object val;
+ int chartab_idx = CHARTAB_IDX (c, 0, 0);
bool is_uniprop = UNIPROP_TABLE_P (table);
- val = tbl->contents[chartab_idx];
if (*from < 0)
*from = 0;
if (*to < 0)
*to = MAX_CHAR;
- if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
- val = uniprop_table_uncompress (table, chartab_idx);
- if (SUB_CHAR_TABLE_P (val))
- val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt,
- is_uniprop);
- else if (NILP (val))
- val = tbl->defalt;
- idx = chartab_idx;
+
+ Lisp_Object val
+ = char_table_ref_simple (table, chartab_idx, c, from, to,
+ tbl->defalt, is_uniprop, false);
+
+ int idx = chartab_idx;
while (*from < idx * chartab_chars[0])
{
- Lisp_Object this_val;
-
c = idx * chartab_chars[0] - 1;
idx--;
- this_val = tbl->contents[idx];
- if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
- this_val = uniprop_table_uncompress (table, idx);
- if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, c, from, to,
- tbl->defalt, is_uniprop);
- else if (NILP (this_val))
- this_val = tbl->defalt;
+ Lisp_Object this_val
+ = char_table_ref_simple (table, idx, c, from, to,
+ tbl->defalt, is_uniprop, false);
if (! EQ (this_val, val))
{
@@ -361,18 +351,12 @@ char_table_ref_and_range (Lisp_Object table, int c, int
*from, int *to)
}
while (*to >= (chartab_idx + 1) * chartab_chars[0])
{
- Lisp_Object this_val;
-
chartab_idx++;
c = chartab_idx * chartab_chars[0];
- this_val = tbl->contents[chartab_idx];
- if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
- this_val = uniprop_table_uncompress (table, chartab_idx);
- if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, c, from, to,
- tbl->defalt, is_uniprop);
- else if (NILP (this_val))
- this_val = tbl->defalt;
+ Lisp_Object this_val
+ = char_table_ref_simple (table, chartab_idx, c, from, to,
+ tbl->defalt, is_uniprop, false);
+
if (! EQ (this_val, val))
{
*to = c - 1;
diff --git a/src/cmds.c b/src/cmds.c
index c8a96d9..00fde0e 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -455,7 +455,7 @@ internal_self_insert (int c, EMACS_INT n)
ptrdiff_t to;
if (INT_ADD_WRAPV (PT, chars_to_delete, &to))
to = PTRDIFF_MAX;
- replace_range (PT, to, string, 1, 1, 1, 0);
+ replace_range (PT, to, string, 1, 1, 1, 0, false);
Fforward_char (make_fixnum (n));
}
else if (n > 1)
diff --git a/src/coding.c b/src/coding.c
index 46e7fca..87b55ae 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -9476,7 +9476,7 @@ not fully specified.) */)
}
/* Whether STRING only contains chars in the 0..127 range. */
-static bool
+bool
string_ascii_p (Lisp_Object string)
{
ptrdiff_t nbytes = SBYTES (string);
diff --git a/src/data.c b/src/data.c
index 059f31e..ffca7e7 100644
--- a/src/data.c
+++ b/src/data.c
@@ -581,8 +581,8 @@ DEFUN ("condition-variable-p", Fcondition_variable_p,
Scondition_variable_p,
/* Extract and set components of lists. */
DEFUN ("car", Fcar, Scar, 1, 1, 0,
- doc: /* Return the car of LIST. If arg is nil, return nil.
-Error if arg is not nil and not a cons cell. See also `car-safe'.
+ doc: /* Return the car of LIST. If LIST is nil, return nil.
+Error if LIST is not nil and not a cons cell. See also `car-safe'.
See Info node `(elisp)Cons Cells' for a discussion of related basic
Lisp concepts such as car, cdr, cons cell and list. */)
@@ -599,8 +599,8 @@ DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
}
DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
- doc: /* Return the cdr of LIST. If arg is nil, return nil.
-Error if arg is not nil and not a cons cell. See also `cdr-safe'.
+ doc: /* Return the cdr of LIST. If LIST is nil, return nil.
+Error if LIST is not nil and not a cons cell. See also `cdr-safe'.
See Info node `(elisp)Cons Cells' for a discussion of related basic
Lisp concepts such as cdr, car, cons cell and list. */)
@@ -3901,6 +3901,7 @@ syms_of_data (void)
DEFSYM (Qerror, "error");
DEFSYM (Quser_error, "user-error");
DEFSYM (Qquit, "quit");
+ DEFSYM (Qminibuffer_quit, "minibuffer-quit");
DEFSYM (Qwrong_length_argument, "wrong-length-argument");
DEFSYM (Qwrong_type_argument, "wrong-type-argument");
DEFSYM (Qargs_out_of_range, "args-out-of-range");
@@ -3973,6 +3974,7 @@ syms_of_data (void)
Fput (sym, Qerror_message, build_pure_c_string (msg))
PUT_ERROR (Qquit, Qnil, "Quit");
+ PUT_ERROR (Qminibuffer_quit, pure_cons (Qquit, Qnil), "Quit");
PUT_ERROR (Quser_error, error_tail, "");
PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument");
diff --git a/src/dispnew.c b/src/dispnew.c
index 1378c34..0c31319 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -473,6 +473,10 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix
*matrix, int x, int y
= row->glyphs[LEFT_MARGIN_AREA] + left;
row->glyphs[RIGHT_MARGIN_AREA]
= row->glyphs[TEXT_AREA] + dim.width - left - right;
+ /* Leave room for a border glyph. */
+ if (!FRAME_WINDOW_P (XFRAME (w->frame))
+ && !WINDOW_RIGHTMOST_P (w))
+ row->glyphs[RIGHT_MARGIN_AREA] -= 1;
row->glyphs[LAST_AREA]
= row->glyphs[LEFT_MARGIN_AREA] + dim.width;
}
@@ -1140,7 +1144,13 @@ prepare_desired_row (struct window *w, struct glyph_row
*row, bool mode_line_p)
row->glyphs[TEXT_AREA] = row->glyphs[LEFT_MARGIN_AREA] + left;
if (w->right_margin_cols > 0
&& (right != row->glyphs[LAST_AREA] - row->glyphs[RIGHT_MARGIN_AREA]))
- row->glyphs[RIGHT_MARGIN_AREA] = row->glyphs[LAST_AREA] - right;
+ {
+ row->glyphs[RIGHT_MARGIN_AREA] = row->glyphs[LAST_AREA] - right;
+ /* Leave room for a border glyph. */
+ if (!FRAME_WINDOW_P (XFRAME (w->frame))
+ && !WINDOW_RIGHTMOST_P (w))
+ row->glyphs[RIGHT_MARGIN_AREA] -= 1;
+ }
}
}
diff --git a/src/editfns.c b/src/editfns.c
index aa0f46f..c8219de 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2137,7 +2137,7 @@ nil. */)
the file now. */
if (SAVE_MODIFF == MODIFF
&& STRINGP (BVAR (a, file_truename)))
- unlock_file (BVAR (a, file_truename));
+ Funlock_file (BVAR (a, file_truename));
}
return Qt;
@@ -2371,7 +2371,7 @@ Both characters must have the same length of multi-byte
form. */)
/* replace_range is less efficient, because it moves the gap,
but it handles combining correctly. */
replace_range (pos, pos + 1, string,
- false, false, true, false);
+ false, false, true, false, false);
pos_byte_next = CHAR_TO_BYTE (pos);
if (pos_byte_next > pos_byte)
/* Before combining happened. We should not increment
@@ -2578,7 +2578,7 @@ It returns the number of characters changed. */)
but it should handle multibyte characters correctly. */
string = make_multibyte_string ((char *) str, 1, str_len);
replace_range (pos, pos + 1, string,
- true, false, true, false);
+ true, false, true, false, false);
len = str_len;
}
else
@@ -2613,7 +2613,8 @@ It returns the number of characters changed. */)
= (VECTORP (val)
? Fconcat (1, &val)
: Fmake_string (make_fixnum (1), val, Qnil));
- replace_range (pos, pos + len, string, true, false, true, false);
+ replace_range (pos, pos + len, string, true, false, true, false,
+ false);
pos_byte += SBYTES (string);
pos += SCHARS (string);
characters_changed += SCHARS (string);
diff --git a/src/emacs.c b/src/emacs.c
index b7982ec..866e43f 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -670,7 +670,9 @@ argmatch (char **argv, int argc, const char *sstr, const
char *lstr,
}
arglen = (valptr != NULL && (p = strchr (arg, '=')) != NULL
? p - arg : strlen (arg));
- if (lstr == 0 || arglen < minlen || strncmp (arg, lstr, arglen) != 0)
+ if (!lstr)
+ return 0;
+ if (arglen < minlen || strncmp (arg, lstr, arglen) != 0)
return 0;
else if (valptr == NULL)
{
diff --git a/src/eval.c b/src/eval.c
index 18faa0b..48104bd 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -462,7 +462,7 @@ DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
usage: (progn BODY...) */)
(Lisp_Object body)
{
- Lisp_Object val = Qnil;
+ Lisp_Object CACHEABLE val = Qnil;
while (CONSP (body))
{
@@ -1429,7 +1429,7 @@ internal_lisp_condition_case (Lisp_Object var,
Lisp_Object bodyform,
}
}
- Lisp_Object result = eval_sub (bodyform);
+ Lisp_Object CACHEABLE result = eval_sub (bodyform);
handlerlist = oldhandlerlist;
if (!NILP (success_handler))
{
@@ -2026,6 +2026,18 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
return 0;
}
+/* Say whether SIGNAL is a `quit' symbol (or inherits from it). */
+bool
+signal_quit_p (Lisp_Object signal)
+{
+ Lisp_Object list;
+
+ return EQ (signal, Qquit)
+ || (!NILP (Fsymbolp (signal))
+ && CONSP (list = Fget (signal, Qerror_conditions))
+ && !NILP (Fmemq (Qquit, list)));
+}
+
/* Call the debugger if calling it is currently enabled for CONDITIONS.
SIG and DATA describe the signal. There are two ways to pass them:
= SIG is the error symbol, and DATA is the rest of the data.
@@ -2044,7 +2056,7 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object
sig, Lisp_Object data)
! input_blocked_p ()
&& NILP (Vinhibit_debugger)
/* Does user want to enter debugger for this kind of error? */
- && (EQ (sig, Qquit)
+ && (signal_quit_p (sig)
? debug_on_quit
: wants_debugger (Vdebug_on_error, conditions))
&& ! skip_debugger (conditions, combined_data)
diff --git a/src/fileio.c b/src/fileio.c
index c0d1a50..13c99be 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -749,6 +749,114 @@ For that reason, you should normally use `make-temp-file'
instead. */)
empty_unibyte_string, Qnil);
}
+DEFUN ("file-name-concat", Ffile_name_concat, Sfile_name_concat, 1, MANY, 0,
+ doc: /* Append COMPONENTS to DIRECTORY and return the resulting string.
+Elements in COMPONENTS must be a string or nil.
+DIRECTORY or the non-final elements in COMPONENTS may or may not end
+with a slash -- if they don't end with a slash, a slash will be
+inserted before contatenating.
+usage: (record DIRECTORY &rest COMPONENTS) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ ptrdiff_t chars = 0, bytes = 0, multibytes = 0, eargs = 0;
+ Lisp_Object *elements = args;
+ Lisp_Object result;
+ ptrdiff_t i;
+
+ /* First go through the list to check the types and see whether
+ they're all of the same multibytedness. */
+ for (i = 0; i < nargs; i++)
+ {
+ Lisp_Object arg = args[i];
+ /* Skip empty and nil elements. */
+ if (NILP (arg))
+ continue;
+ CHECK_STRING (arg);
+ if (SCHARS (arg) == 0)
+ continue;
+ eargs++;
+ /* Multibyte and non-ASCII. */
+ if (STRING_MULTIBYTE (arg) && SCHARS (arg) != SBYTES (arg))
+ multibytes++;
+ /* We're not adding a slash to the final part. */
+ if (i == nargs - 1
+ || IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1)))
+ {
+ bytes += SBYTES (arg);
+ chars += SCHARS (arg);
+ }
+ else
+ {
+ bytes += SBYTES (arg) + 1;
+ chars += SCHARS (arg) + 1;
+ }
+ }
+
+ /* Convert if needed. */
+ if ((multibytes != 0 && multibytes != nargs)
+ || eargs != nargs)
+ {
+ int j = 0;
+ elements = xmalloc (eargs * sizeof *elements);
+ bytes = 0;
+ chars = 0;
+
+ /* Filter out nil/"". */
+ for (i = 0; i < nargs; i++)
+ {
+ Lisp_Object arg = args[i];
+ if (!NILP (arg) && SCHARS (arg) != 0)
+ elements[j++] = arg;
+ }
+
+ for (i = 0; i < eargs; i++)
+ {
+ Lisp_Object arg = elements[i];
+ /* Use multibyte or all-ASCII strings as is. */
+ if (!STRING_MULTIBYTE (arg) && !string_ascii_p (arg))
+ elements[i] = Fstring_to_multibyte (arg);
+ arg = elements[i];
+ /* We have to recompute the number of bytes. */
+ if (i == eargs - 1
+ || IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1)))
+ {
+ bytes += SBYTES (arg);
+ chars += SCHARS (arg);
+ }
+ else
+ {
+ bytes += SBYTES (arg) + 1;
+ chars += SCHARS (arg) + 1;
+ }
+ }
+ }
+
+ /* Allocate an empty string. */
+ if (multibytes == 0)
+ result = make_uninit_string (chars);
+ else
+ result = make_uninit_multibyte_string (chars, bytes);
+ /* Null-terminate the string. */
+ *(SSDATA (result) + SBYTES (result)) = 0;
+
+ /* Copy over the data. */
+ char *p = SSDATA (result);
+ for (i = 0; i < eargs; i++)
+ {
+ Lisp_Object arg = elements[i];
+ memcpy (p, SSDATA (arg), SBYTES (arg));
+ p += SBYTES (arg);
+ /* The last element shouldn't have a slash added at the end. */
+ if (i < eargs - 1 && !IS_DIRECTORY_SEP (*(p - 1)))
+ *p++ = DIRECTORY_SEP;
+ }
+
+ if (elements != args)
+ xfree (elements);
+
+ return result;
+}
+
/* NAME must be a string. */
static bool
file_name_absolute_no_tilde_p (Lisp_Object name)
@@ -4544,7 +4652,7 @@ by calling `format-decode', which see. */)
if (inserted == 0)
{
if (we_locked_file)
- unlock_file (BVAR (current_buffer, file_truename));
+ Funlock_file (BVAR (current_buffer, file_truename));
Vdeactivate_mark = old_Vdeactivate_mark;
}
else
@@ -4706,8 +4814,8 @@ by calling `format-decode', which see. */)
if (NILP (handler))
{
if (!NILP (BVAR (current_buffer, file_truename)))
- unlock_file (BVAR (current_buffer, file_truename));
- unlock_file (filename);
+ Funlock_file (BVAR (current_buffer, file_truename));
+ Funlock_file (filename);
}
if (not_regular)
xsignal2 (Qfile_error,
@@ -5168,7 +5276,7 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
if (open_and_close_file && !auto_saving)
{
- lock_file (lockname);
+ Flock_file (lockname);
file_locked = 1;
}
@@ -5193,7 +5301,7 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
{
int open_errno = errno;
if (file_locked)
- unlock_file (lockname);
+ Funlock_file (lockname);
report_file_errno ("Opening output file", filename, open_errno);
}
@@ -5208,7 +5316,7 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
{
int lseek_errno = errno;
if (file_locked)
- unlock_file (lockname);
+ Funlock_file (lockname);
report_file_errno ("Lseek error", filename, lseek_errno);
}
}
@@ -5345,7 +5453,7 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
unbind_to (count, Qnil);
if (file_locked)
- unlock_file (lockname);
+ Funlock_file (lockname);
/* Do this before reporting IO error
to avoid a "file has changed on disk" warning on
@@ -5370,14 +5478,14 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
bset_filename (current_buffer, visit_file);
update_mode_lines = 14;
if (auto_saving_into_visited_file)
- unlock_file (lockname);
+ Funlock_file (lockname);
}
else if (quietly)
{
if (auto_saving_into_visited_file)
{
SAVE_MODIFF = MODIFF;
- unlock_file (lockname);
+ Funlock_file (lockname);
}
return Qnil;
@@ -6488,6 +6596,7 @@ This includes interactive calls to `delete-file' and
defsubr (&Sdirectory_file_name);
defsubr (&Smake_temp_file_internal);
defsubr (&Smake_temp_name);
+ defsubr (&Sfile_name_concat);
defsubr (&Sexpand_file_name);
defsubr (&Ssubstitute_in_file_name);
defsubr (&Scopy_file);
diff --git a/src/filelock.c b/src/filelock.c
index 446a262..cc185d9 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -51,7 +51,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#ifdef WINDOWSNT
#include <share.h>
#include <sys/socket.h> /* for fcntl */
-#include "w32.h" /* for dostounix_filename */
#endif
#ifndef MSDOS
@@ -294,25 +293,6 @@ typedef struct
char user[MAX_LFINFO + 1 + sizeof " (pid )" - sizeof "."];
} lock_info_type;
-/* Write the name of the lock file for FNAME into LOCKNAME. Length
- will be that of FNAME plus two more for the leading ".#", plus one
- for the null. */
-#define MAKE_LOCK_NAME(lockname, fname) \
- (lockname = SAFE_ALLOCA (SBYTES (fname) + 2 + 1), \
- fill_in_lock_file_name (lockname, fname))
-
-static void
-fill_in_lock_file_name (char *lockfile, Lisp_Object fn)
-{
- char *last_slash = memrchr (SSDATA (fn), '/', SBYTES (fn));
- char *base = last_slash + 1;
- ptrdiff_t dirlen = base - SSDATA (fn);
- memcpy (lockfile, SSDATA (fn), dirlen);
- lockfile[dirlen] = '.';
- lockfile[dirlen + 1] = '#';
- strcpy (lockfile + dirlen + 2, base);
-}
-
/* For some reason Linux kernels return EPERM on file systems that do
not support hard or symbolic links. This symbol documents the quirk.
There is no way to tell whether a symlink call fails due to
@@ -639,6 +619,12 @@ lock_if_free (lock_info_type *clasher, char *lfname)
return err;
}
+static Lisp_Object
+make_lock_file_name (Lisp_Object fn)
+{
+ return call1 (Qmake_lock_file_name, Fexpand_file_name (fn, Qnil));
+}
+
/* lock_file locks file FN,
meaning it serves notice on the world that you intend to edit that file.
This should be done only when about to modify a file-visiting
@@ -657,86 +643,78 @@ lock_if_free (lock_info_type *clasher, char *lfname)
This function can signal an error, or return t meaning
take away the lock, or return nil meaning ignore the lock. */
-void
+static Lisp_Object
lock_file (Lisp_Object fn)
{
- Lisp_Object orig_fn, encoded_fn;
- char *lfname = NULL;
lock_info_type lock_info;
- USE_SAFE_ALLOCA;
/* Don't do locking while dumping Emacs.
Uncompressing wtmp files uses call-process, which does not work
in an uninitialized Emacs. */
if (will_dump_p ())
- return;
+ return Qnil;
- orig_fn = fn;
- fn = Fexpand_file_name (fn, Qnil);
-#ifdef WINDOWSNT
- /* Ensure we have only '/' separators, to avoid problems with
- looking (inside fill_in_lock_file_name) for backslashes in file
- names encoded by some DBCS codepage. */
- dostounix_filename (SSDATA (fn));
-#endif
- encoded_fn = ENCODE_FILE (fn);
- if (create_lockfiles)
- /* Create the name of the lock-file for file fn */
- MAKE_LOCK_NAME (lfname, encoded_fn);
+ /* If the file name has special constructs in it,
+ call the corresponding file name handler. */
+ Lisp_Object handler;
+ handler = Ffind_file_name_handler (fn, Qlock_file);
+ if (!NILP (handler))
+ {
+ return call2 (handler, Qlock_file, fn);
+ }
+
+ Lisp_Object lock_filename = make_lock_file_name (fn);
+ if (NILP (lock_filename))
+ return Qnil;
+ char *lfname = SSDATA (ENCODE_FILE (lock_filename));
/* See if this file is visited and has changed on disk since it was
visited. */
- Lisp_Object subject_buf = get_truename_buffer (orig_fn);
+ Lisp_Object subject_buf = get_truename_buffer (fn);
if (!NILP (subject_buf)
&& NILP (Fverify_visited_file_modtime (subject_buf))
&& !NILP (Ffile_exists_p (fn))
- && !(lfname && current_lock_owner (NULL, lfname) == -2))
+ && current_lock_owner (NULL, lfname) != -2)
call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
- /* Don't do locking if the user has opted out. */
- if (lfname)
+ /* Try to lock the lock. FIXME: This ignores errors when
+ lock_if_free returns a positive errno value. */
+ if (lock_if_free (&lock_info, lfname) < 0)
{
- /* Try to lock the lock. FIXME: This ignores errors when
- lock_if_free returns a positive errno value. */
- if (lock_if_free (&lock_info, lfname) < 0)
- {
- /* Someone else has the lock. Consider breaking it. */
- Lisp_Object attack;
- char *dot = lock_info.dot;
- ptrdiff_t pidlen = lock_info.colon - (dot + 1);
- static char const replacement[] = " (pid ";
- int replacementlen = sizeof replacement - 1;
- memmove (dot + replacementlen, dot + 1, pidlen);
- strcpy (dot + replacementlen + pidlen, ")");
- memcpy (dot, replacement, replacementlen);
- attack = call2 (intern ("ask-user-about-lock"), fn,
- build_string (lock_info.user));
- /* Take the lock if the user said so. */
- if (!NILP (attack))
- lock_file_1 (lfname, 1);
- }
- SAFE_FREE ();
+ /* Someone else has the lock. Consider breaking it. */
+ Lisp_Object attack;
+ char *dot = lock_info.dot;
+ ptrdiff_t pidlen = lock_info.colon - (dot + 1);
+ static char const replacement[] = " (pid ";
+ int replacementlen = sizeof replacement - 1;
+ memmove (dot + replacementlen, dot + 1, pidlen);
+ strcpy (dot + replacementlen + pidlen, ")");
+ memcpy (dot, replacement, replacementlen);
+ attack = call2 (intern ("ask-user-about-lock"), fn,
+ build_string (lock_info.user));
+ /* Take the lock if the user said so. */
+ if (!NILP (attack))
+ lock_file_1 (lfname, 1);
}
+ return Qnil;
}
static Lisp_Object
-unlock_file_body (Lisp_Object fn)
+unlock_file (Lisp_Object fn)
{
char *lfname;
- USE_SAFE_ALLOCA;
-
- Lisp_Object filename = Fexpand_file_name (fn, Qnil);
- fn = ENCODE_FILE (filename);
- MAKE_LOCK_NAME (lfname, fn);
+ Lisp_Object lock_filename = make_lock_file_name (fn);
+ if (NILP (lock_filename))
+ return Qnil;
+ lfname = SSDATA (ENCODE_FILE (lock_filename));
int err = current_lock_owner (0, lfname);
if (err == -2 && unlink (lfname) != 0 && errno != ENOENT)
err = errno;
if (0 < err)
- report_file_errno ("Unlocking file", filename, err);
+ report_file_errno ("Unlocking file", fn, err);
- SAFE_FREE ();
return Qnil;
}
@@ -747,26 +725,6 @@ unlock_file_handle_error (Lisp_Object err)
return Qnil;
}
-void
-unlock_file (Lisp_Object fn)
-{
- internal_condition_case_1 (unlock_file_body,
- fn,
- list1(Qfile_error),
- unlock_file_handle_error);
-}
-
-#else /* MSDOS */
-void
-lock_file (Lisp_Object fn)
-{
-}
-
-void
-unlock_file (Lisp_Object fn)
-{
-}
-
#endif /* MSDOS */
void
@@ -780,10 +738,51 @@ unlock_all_files (void)
b = XBUFFER (buf);
if (STRINGP (BVAR (b, file_truename))
&& BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
- unlock_file (BVAR (b, file_truename));
+ Funlock_file (BVAR (b, file_truename));
}
}
+DEFUN ("lock-file", Flock_file, Slock_file, 1, 1, 0,
+ doc: /* Lock FILE.
+If the option `create-lockfiles' is nil, this does nothing. */)
+ (Lisp_Object file)
+{
+#ifndef MSDOS
+ /* Don't do locking if the user has opted out. */
+ if (create_lockfiles)
+ {
+ CHECK_STRING (file);
+ lock_file (file);
+ }
+#endif /* MSDOS */
+ return Qnil;
+}
+
+DEFUN ("unlock-file", Funlock_file, Sunlock_file, 1, 1, 0,
+ doc: /* Unlock FILE. */)
+ (Lisp_Object file)
+{
+#ifndef MSDOS
+ CHECK_STRING (file);
+
+ /* If the file name has special constructs in it,
+ call the corresponding file name handler. */
+ Lisp_Object handler;
+ handler = Ffind_file_name_handler (file, Qunlock_file);
+ if (!NILP (handler))
+ {
+ call2 (handler, Qunlock_file, file);
+ return Qnil;
+ }
+
+ internal_condition_case_1 (unlock_file,
+ file,
+ list1 (Qfile_error),
+ unlock_file_handle_error);
+#endif /* MSDOS */
+ return Qnil;
+}
+
DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
0, 1, 0,
doc: /* Lock FILE, if current buffer is modified.
@@ -799,7 +798,7 @@ If the option `create-lockfiles' is nil, this does nothing.
*/)
CHECK_STRING (file);
if (SAVE_MODIFF < MODIFF
&& !NILP (file))
- lock_file (file);
+ Flock_file (file);
return Qnil;
}
@@ -815,7 +814,7 @@ error did not occur. */)
{
if (SAVE_MODIFF < MODIFF
&& STRINGP (BVAR (current_buffer, file_truename)))
- unlock_file (BVAR (current_buffer, file_truename));
+ Funlock_file (BVAR (current_buffer, file_truename));
return Qnil;
}
@@ -826,7 +825,7 @@ unlock_buffer (struct buffer *buffer)
{
if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
&& STRINGP (BVAR (buffer, file_truename)))
- unlock_file (BVAR (buffer, file_truename));
+ Funlock_file (BVAR (buffer, file_truename));
}
DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
@@ -839,14 +838,22 @@ t if it is locked by you, else a string saying which user
has locked it. */)
return Qnil;
#else
Lisp_Object ret;
- char *lfname;
int owner;
lock_info_type locker;
- USE_SAFE_ALLOCA;
- filename = Fexpand_file_name (filename, Qnil);
- Lisp_Object encoded_filename = ENCODE_FILE (filename);
- MAKE_LOCK_NAME (lfname, encoded_filename);
+ /* If the file name has special constructs in it,
+ call the corresponding file name handler. */
+ Lisp_Object handler;
+ handler = Ffind_file_name_handler (filename, Qfile_locked_p);
+ if (!NILP (handler))
+ {
+ return call2 (handler, Qfile_locked_p, filename);
+ }
+
+ Lisp_Object lock_filename = make_lock_file_name (filename);
+ if (NILP (lock_filename))
+ return Qnil;
+ char *lfname = SSDATA (ENCODE_FILE (lock_filename));
owner = current_lock_owner (&locker, lfname);
switch (owner)
@@ -857,7 +864,6 @@ t if it is locked by you, else a string saying which user
has locked it. */)
default: report_file_errno ("Testing file lock", filename, owner);
}
- SAFE_FREE ();
return ret;
#endif
}
@@ -876,7 +882,14 @@ The name of the (per-buffer) lockfile is constructed by
prepending a
Info node `(emacs)Interlocking'. */);
create_lockfiles = true;
- defsubr (&Sunlock_buffer);
+ DEFSYM (Qlock_file, "lock-file");
+ DEFSYM (Qunlock_file, "unlock-file");
+ DEFSYM (Qfile_locked_p, "file-locked-p");
+ DEFSYM (Qmake_lock_file_name, "make-lock-file-name");
+
+ defsubr (&Slock_file);
+ defsubr (&Sunlock_file);
defsubr (&Slock_buffer);
+ defsubr (&Sunlock_buffer);
defsubr (&Sfile_locked_p);
}
diff --git a/src/fns.c b/src/fns.c
index a178216..932800a 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -3955,7 +3955,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
if (c == '=')
continue;
- if (v1 < 0)
+ if (v1 == 0)
return -1;
value += v1 - 1;
@@ -5769,16 +5769,6 @@ characters. */ )
return list3 (make_int (lines), make_int (longest), make_float (mean));
}
-static bool
-string_ascii_p (Lisp_Object string)
-{
- ptrdiff_t nbytes = SBYTES (string);
- for (ptrdiff_t i = 0; i < nbytes; i++)
- if (SREF (string, i) > 127)
- return false;
- return true;
-}
-
DEFUN ("string-search", Fstring_search, Sstring_search, 2, 3, 0,
doc: /* Search for the string NEEDLE in the string HAYSTACK.
The return value is the position of the first occurrence of NEEDLE in
diff --git a/src/fontset.c b/src/fontset.c
index 332be6c..7d4bd65 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1361,7 +1361,11 @@ check_fontset_name (Lisp_Object name, Lisp_Object *frame)
if (EQ (name, Qt))
return Vdefault_fontset;
if (NILP (name))
- id = FRAME_FONTSET (f);
+ {
+ if (!FRAME_WINDOW_P (f))
+ error ("Can't use fontsets in non-GUI frames");
+ id = FRAME_FONTSET (f);
+ }
else
{
CHECK_STRING (name);
diff --git a/src/frame.c b/src/frame.c
index 623e4ba..b105268 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -1018,6 +1018,10 @@ make_frame (bool mini_p)
rw->total_lines = FRAME_LINES (f) - (mini_p ? 1 : 0);
rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f);
+ fset_face_hash_table
+ (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
+ DEFAULT_REHASH_THRESHOLD, Qnil, false));
+
if (mini_p)
{
mw->top_line = rw->total_lines;
@@ -1326,7 +1330,7 @@ affects all frames on the same terminal device. */)
{
struct frame *f;
struct terminal *t = NULL;
- Lisp_Object frame, tem;
+ Lisp_Object frame;
struct frame *sf = SELECTED_FRAME ();
#ifdef MSDOS
@@ -1408,14 +1412,16 @@ affects all frames on the same terminal device. */)
store_in_alist (&parms, Qminibuffer, Qt);
Fmodify_frame_parameters (frame, parms);
- /* Make the frame face alist be frame-specific, so that each
+ /* Make the frame face hash be frame-specific, so that each
frame could change its face definitions independently. */
- fset_face_alist (f, Fcopy_alist (sf->face_alist));
- /* Simple Fcopy_alist isn't enough, because we need the contents of
- the vectors which are the CDRs of associations in face_alist to
+ fset_face_hash_table (f, Fcopy_hash_table (sf->face_hash_table));
+ /* Simple copy_hash_table isn't enough, because we need the contents of
+ the vectors which are the values in face_hash_table to
be copied as well. */
- for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
- XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
+ ptrdiff_t idx = 0;
+ struct Lisp_Hash_Table *table = XHASH_TABLE (f->face_hash_table);
+ for (idx = 0; idx < table->count; ++idx)
+ set_hash_value_slot (table, idx, Fcopy_sequence (HASH_VALUE (table, idx)));
f->can_set_window_size = true;
f->after_make_frame = true;
diff --git a/src/frame.h b/src/frame.h
index cad3df5..a8ad011 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -158,8 +158,8 @@ struct frame
There are four additional elements of nil at the end, to terminate. */
Lisp_Object menu_bar_items;
- /* Alist of elements (FACE-NAME . FACE-VECTOR-DATA). */
- Lisp_Object face_alist;
+ /* Hash table of FACE-NAME keys and FACE-VECTOR-DATA values. */
+ Lisp_Object face_hash_table;
/* A vector that records the entire structure of this frame's menu bar.
For the format of the data, see extensive comments in xmenu.c.
@@ -672,9 +672,9 @@ fset_condemned_scroll_bars (struct frame *f, Lisp_Object
val)
f->condemned_scroll_bars = val;
}
INLINE void
-fset_face_alist (struct frame *f, Lisp_Object val)
+fset_face_hash_table (struct frame *f, Lisp_Object val)
{
- f->face_alist = val;
+ f->face_hash_table = val;
}
#if defined (HAVE_WINDOW_SYSTEM)
INLINE void
diff --git a/src/ftfont.c b/src/ftfont.c
index 0603dd9..12d0d72 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -2798,10 +2798,31 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font
*font,
if (gstring.used > LGSTRING_GLYPH_LEN (lgstring))
return Qnil;
+
+ /* mflt_run may fail to set g->g.to (which must be a valid index
+ into lgstring) correctly if the font has an OTF table that is
+ different from what the m17n library expects. */
for (i = 0; i < gstring.used; i++)
{
MFLTGlyphFT *g = (MFLTGlyphFT *) (gstring.glyphs) + i;
+ if (g->g.to >= len)
+ {
+ /* Invalid g->g.to. */
+ g->g.to = len - 1;
+ int from = g->g.from;
+ /* Fix remaining glyphs. */
+ for (++i; i < gstring.used; i++)
+ {
+ g = (MFLTGlyphFT *) (gstring.glyphs) + i;
+ g->g.from = from;
+ g->g.to = len - 1;
+ }
+ }
+ }
+ for (i = 0; i < gstring.used; i++)
+ {
+ MFLTGlyphFT *g = (MFLTGlyphFT *) (gstring.glyphs) + i;
g->g.from = LGLYPH_FROM (LGSTRING_GLYPH (lgstring, g->g.from));
g->g.to = LGLYPH_TO (LGSTRING_GLYPH (lgstring, g->g.to));
}
diff --git a/src/gtkutil.c b/src/gtkutil.c
index dee2a93..313cfc8 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -3221,7 +3221,7 @@ xg_update_menu_item (widget_value *val,
gtk_label_set_text (wkey, utf8_key);
}
- if (! old_label || strcmp (utf8_label, old_label) != 0)
+ if (utf8_label && (! old_label || strcmp (utf8_label, old_label) != 0))
{
label_changed = true;
gtk_label_set_text (wlbl, utf8_label);
diff --git a/src/image.c b/src/image.c
index 07de4d3..bcd45eb 100644
--- a/src/image.c
+++ b/src/image.c
@@ -4991,7 +4991,7 @@ xpm_load_image (struct frame *f,
while (num_colors-- > 0)
{
- char *color, *max_color;
+ char *color, *max_color = NULL;
int key, next_key, max_key = 0;
Lisp_Object symbol_color = Qnil, color_val;
Emacs_Color cdef;
@@ -5052,7 +5052,7 @@ xpm_load_image (struct frame *f,
cdef.blue));
}
}
- if (NILP (color_val) && max_key > 0)
+ if (NILP (color_val) && max_color)
{
if (xstrcasecmp (max_color, "None") == 0)
color_val = Qt;
@@ -7774,6 +7774,13 @@ tiff_image_p (Lisp_Object object)
# include <tiffio.h>
+/* libtiff version 4.3.0 deprecated uint32 typedef. */
+#if TIFFLIB_VERSION >= 20210416
+# define UINT32 uint32_t
+#else
+# define UINT32 uint32
+#endif
+
# ifdef WINDOWSNT
/* TIFF library details. */
@@ -7785,7 +7792,7 @@ DEF_DLL_FN (TIFF *, TIFFClientOpen,
TIFFReadWriteProc, TIFFSeekProc, TIFFCloseProc, TIFFSizeProc,
TIFFMapFileProc, TIFFUnmapFileProc));
DEF_DLL_FN (int, TIFFGetField, (TIFF *, ttag_t, ...));
-DEF_DLL_FN (int, TIFFReadRGBAImage, (TIFF *, uint32, uint32, uint32 *, int));
+DEF_DLL_FN (int, TIFFReadRGBAImage, (TIFF *, UINT32, UINT32, UINT32 *, int));
DEF_DLL_FN (void, TIFFClose, (TIFF *));
DEF_DLL_FN (int, TIFFSetDirectory, (TIFF *, tdir_t));
@@ -7977,7 +7984,7 @@ tiff_load (struct frame *f, struct image *img)
Lisp_Object specified_data;
TIFF *tiff;
int width, height, x, y, count;
- uint32 *buf;
+ UINT32 *buf;
int rc;
Emacs_Pix_Container ximg;
tiff_memory_source memsrc;
@@ -8103,11 +8110,11 @@ tiff_load (struct frame *f, struct image *img)
/* Process the pixel raster. Origin is in the lower-left corner. */
for (y = 0; y < height; ++y)
{
- uint32 *row = buf + y * width;
+ UINT32 *row = buf + y * width;
for (x = 0; x < width; ++x)
{
- uint32 abgr = row[x];
+ UINT32 abgr = row[x];
int r = TIFFGetR (abgr) << 8;
int g = TIFFGetG (abgr) << 8;
int b = TIFFGetB (abgr) << 8;
diff --git a/src/insdel.c b/src/insdel.c
index e38b091..40674e1 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1392,7 +1392,7 @@ adjust_after_insert (ptrdiff_t from, ptrdiff_t from_byte,
void
replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
bool prepare, bool inherit, bool markers,
- bool adjust_match_data)
+ bool adjust_match_data, bool inhibit_mod_hooks)
{
ptrdiff_t inschars = SCHARS (new);
ptrdiff_t insbytes = SBYTES (new);
@@ -1552,8 +1552,11 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object
new,
if (adjust_match_data)
update_search_regs (from, to, from + SCHARS (new));
- signal_after_change (from, nchars_del, GPT - from);
- update_compositions (from, GPT, CHECK_BORDER);
+ if (!inhibit_mod_hooks)
+ {
+ signal_after_change (from, nchars_del, GPT - from);
+ update_compositions (from, GPT, CHECK_BORDER);
+ }
}
/* Replace the text from character positions FROM to TO with
@@ -1989,7 +1992,7 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t
end,
/* Make binding buffer-file-name to nil effective. */
&& !NILP (BVAR (base_buffer, filename))
&& SAVE_MODIFF >= MODIFF)
- lock_file (BVAR (base_buffer, file_truename));
+ Flock_file (BVAR (base_buffer, file_truename));
/* If `select-active-regions' is non-nil, save the region text. */
/* FIXME: Move this to Elisp (via before-change-functions). */
diff --git a/src/json.c b/src/json.c
index 3f1d27a..b0779b9 100644
--- a/src/json.c
+++ b/src/json.c
@@ -595,10 +595,8 @@ usage: (json-serialize OBJECT &rest ARGS) */)
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
- {
- message1 ("jansson library not found");
- return Qnil;
- }
+ Fsignal (Qjson_unavailable,
+ list1 (build_unibyte_string ("jansson library not found")));
#endif
struct json_configuration conf =
@@ -706,10 +704,8 @@ usage: (json-insert OBJECT &rest ARGS) */)
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
- {
- message1 ("jansson library not found");
- return Qnil;
- }
+ Fsignal (Qjson_unavailable,
+ list1 (build_unibyte_string ("jansson library not found")));
#endif
struct json_configuration conf =
@@ -965,10 +961,8 @@ usage: (json-parse-string STRING &rest ARGS) */)
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
- {
- message1 ("jansson library not found");
- return Qnil;
- }
+ Fsignal (Qjson_unavailable,
+ list1 (build_unibyte_string ("jansson library not found")));
#endif
Lisp_Object string = args[0];
@@ -1064,10 +1058,8 @@ usage: (json-parse-buffer &rest args) */)
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
- {
- message1 ("jansson library not found");
- return Qnil;
- }
+ Fsignal (Qjson_unavailable,
+ list1 (build_unibyte_string ("jansson library not found")));
#endif
struct json_configuration conf =
@@ -1129,6 +1121,7 @@ syms_of_json (void)
DEFSYM (Qjson_end_of_file, "json-end-of-file");
DEFSYM (Qjson_trailing_content, "json-trailing-content");
DEFSYM (Qjson_object_too_deep, "json-object-too-deep");
+ DEFSYM (Qjson_unavailable, "json-unavailable");
define_error (Qjson_error, "generic JSON error", Qerror);
define_error (Qjson_out_of_memory,
"not enough memory for creating JSON object", Qjson_error);
diff --git a/src/keyboard.c b/src/keyboard.c
index 051f2f8..820229c 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -725,6 +725,9 @@ recursive_edit_1 (void)
if (STRINGP (val))
xsignal1 (Qerror, val);
+ if (FUNCTIONP (val))
+ call0 (val);
+
return unbind_to (count, Qnil);
}
@@ -921,6 +924,7 @@ static Lisp_Object
cmd_error (Lisp_Object data)
{
Lisp_Object old_level, old_length;
+ Lisp_Object conditions;
char macroerror[sizeof "After..kbd macro iterations: "
+ INT_STRLEN_BOUND (EMACS_INT)];
@@ -940,10 +944,15 @@ cmd_error (Lisp_Object data)
else
*macroerror = 0;
+ conditions = Fget (XCAR (data), Qerror_conditions);
+ if (NILP (Fmemq (Qminibuffer_quit, conditions)))
+ {
+ Vexecuting_kbd_macro = Qnil;
+ executing_kbd_macro = Qnil;
+ }
+
Vstandard_output = Qt;
Vstandard_input = Qt;
- Vexecuting_kbd_macro = Qnil;
- executing_kbd_macro = Qnil;
kset_prefix_arg (current_kboard, Qnil);
kset_last_prefix_arg (current_kboard, Qnil);
cancel_echoing ();
@@ -976,7 +985,7 @@ cmd_error_internal (Lisp_Object data, const char *context)
{
/* The immediate context is not interesting for Quits,
since they are asynchronous. */
- if (EQ (XCAR (data), Qquit))
+ if (signal_quit_p (XCAR (data)))
Vsignaling_function = Qnil;
Vquit_flag = Qnil;
@@ -998,6 +1007,7 @@ Default value of `command-error-function'. */)
(Lisp_Object data, Lisp_Object context, Lisp_Object signal)
{
struct frame *sf = SELECTED_FRAME ();
+ Lisp_Object conditions;
CHECK_STRING (context);
@@ -1024,17 +1034,27 @@ Default value of `command-error-function'. */)
}
else
{
+ conditions = Fget (XCAR (data), Qerror_conditions);
+
clear_message (1, 0);
- Fdiscard_input ();
message_log_maybe_newline ();
- bitch_at_user ();
+
+ if (!NILP (Fmemq (Qminibuffer_quit, conditions)))
+ {
+ Fding (Qt);
+ }
+ else
+ {
+ Fdiscard_input ();
+ bitch_at_user ();
+ }
print_error_message (data, Qt, SSDATA (context), signal);
}
return Qnil;
}
-static Lisp_Object command_loop_2 (Lisp_Object);
+static Lisp_Object command_loop_1 (void);
static Lisp_Object top_level_1 (Lisp_Object);
/* Entry to editor-command-loop.
@@ -1062,7 +1082,7 @@ command_loop (void)
if (command_loop_level > 0 || minibuf_level > 0)
{
Lisp_Object val;
- val = internal_catch (Qexit, command_loop_2, Qnil);
+ val = internal_catch (Qexit, command_loop_2, Qerror);
executing_kbd_macro = Qnil;
return val;
}
@@ -1070,7 +1090,7 @@ command_loop (void)
while (1)
{
internal_catch (Qtop_level, top_level_1, Qnil);
- internal_catch (Qtop_level, command_loop_2, Qnil);
+ internal_catch (Qtop_level, command_loop_2, Qerror);
executing_kbd_macro = Qnil;
/* End of file in -batch run causes exit here. */
@@ -1083,15 +1103,16 @@ command_loop (void)
editing loop, and reenter the editing loop.
When there is an error, cmd_error runs and returns a non-nil
value to us. A value of nil means that command_loop_1 itself
- returned due to end of file (or end of kbd macro). */
+ returned due to end of file (or end of kbd macro). HANDLERS is a
+ list of condition names, passed to internal_condition_case. */
-static Lisp_Object
-command_loop_2 (Lisp_Object ignore)
+Lisp_Object
+command_loop_2 (Lisp_Object handlers)
{
register Lisp_Object val;
do
- val = internal_condition_case (command_loop_1, Qerror, cmd_error);
+ val = internal_condition_case (command_loop_1, handlers, cmd_error);
while (!NILP (val));
return Qnil;
@@ -1234,7 +1255,7 @@ static int read_key_sequence (Lisp_Object *, Lisp_Object,
bool, bool, bool, bool);
static void adjust_point_for_property (ptrdiff_t, bool);
-Lisp_Object
+static Lisp_Object
command_loop_1 (void)
{
modiff_count prev_modiff = 0;
@@ -6622,8 +6643,11 @@ DEFUN ("event-convert-list", Fevent_convert_list,
Sevent_convert_list, 1, 1, 0,
EVENT-DESC should contain one base event type (a character or symbol)
and zero or more modifier names (control, meta, hyper, super, shift, alt,
drag, down, double or triple). The base must be last.
-The return value is an event type (a character or symbol) which
-has the same base event type and all the specified modifiers. */)
+
+The return value is an event type (a character or symbol) which has
+essentially the same base event type and all the specified modifiers.
+(Some compatibility base types, like symbols that represent a
+character, are not returned verbatim.) */)
(Lisp_Object event_desc)
{
Lisp_Object base = Qnil;
@@ -7610,7 +7634,7 @@ menu_item_eval_property_1 (Lisp_Object arg)
{
/* If we got a quit from within the menu computation,
quit all the way out of it. This takes care of C-] in the debugger. */
- if (CONSP (arg) && EQ (XCAR (arg), Qquit))
+ if (CONSP (arg) && signal_quit_p (XCAR (arg)))
quit ();
return Qnil;
@@ -9595,17 +9619,23 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object
prompt,
(interrupted_kboard,
Fcons (make_lispy_switch_frame (frame),
KVAR (interrupted_kboard, kbd_queue)));
+ mock_input = 0;
+ }
+ else
+ {
+ if (FIXNUMP (key) && XFIXNUM (key) != -2)
+ {
+ /* If interrupted while initializing terminal, we
+ need to replay the interrupting key. See
+ Bug#5095 and Bug#37782. */
+ mock_input = 1;
+ keybuf[0] = key;
+ }
+ else
+ {
+ mock_input = 0;
+ }
}
- if (FIXNUMP (key) && XFIXNUM (key) != -2)
- {
- /* If interrupted while initializing terminal, we
- need to replay the interrupting key. See
- Bug#5095 and Bug#37782. */
- mock_input = 1;
- keybuf[0] = key;
- }
- else
- mock_input = 0;
goto replay_entire_sequence;
}
}
@@ -12141,10 +12171,11 @@ terminal device. See Info node `(elisp)Multiple
Terminals'. */);
DEFVAR_LISP ("overriding-local-map", Voverriding_local_map,
doc: /* Keymap that replaces (overrides) local keymaps.
If this variable is non-nil, Emacs looks up key bindings in this
-keymap INSTEAD OF the keymap char property, minor mode maps, and the
-buffer's local map. Hence, the only active keymaps would be
-`overriding-terminal-local-map', this keymap, and `global-keymap', in
-order of precedence. */);
+keymap INSTEAD OF `keymap' text properties, `local-map' and `keymap'
+overlay properties, minor mode maps, and the buffer's local map.
+
+Hence, the only active keymaps would be `overriding-terminal-local-map',
+this keymap, and `global-keymap', in order of precedence. */);
Voverriding_local_map = Qnil;
DEFVAR_LISP ("overriding-local-map-menu-flag",
Voverriding_local_map_menu_flag,
diff --git a/src/lisp.h b/src/lisp.h
index 4fb8923..1206a0d 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3586,6 +3586,7 @@ extern Lisp_Object detect_coding_system (const unsigned
char *, ptrdiff_t,
extern void init_coding (void);
extern void init_coding_once (void);
extern void syms_of_coding (void);
+extern bool string_ascii_p (Lisp_Object);
/* Defined in character.c. */
extern ptrdiff_t chars_in_text (const unsigned char *, ptrdiff_t);
@@ -3716,7 +3717,8 @@ extern void adjust_markers_for_delete (ptrdiff_t,
ptrdiff_t,
ptrdiff_t, ptrdiff_t);
extern void adjust_markers_bytepos (ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t, int);
-extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool,
bool, bool);
+extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool,
+ bool, bool, bool);
extern void replace_range_2 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
const char *, ptrdiff_t, ptrdiff_t, bool);
extern void syms_of_insdel (void);
@@ -4116,6 +4118,7 @@ extern Lisp_Object Vautoload_queue;
extern Lisp_Object Vrun_hooks;
extern Lisp_Object Vsignaling_function;
extern Lisp_Object inhibit_lisp_code;
+extern bool signal_quit_p (Lisp_Object);
/* To run a normal hook, use the appropriate function from the list below.
The calling convention:
@@ -4417,7 +4420,7 @@ extern bool detect_input_pending_ignore_squeezables
(void);
extern bool detect_input_pending_run_timers (bool);
extern void safe_run_hooks (Lisp_Object);
extern void cmd_error_internal (Lisp_Object, const char *);
-extern Lisp_Object command_loop_1 (void);
+extern Lisp_Object command_loop_2 (Lisp_Object);
extern Lisp_Object read_menu_command (void);
extern Lisp_Object recursive_edit_1 (void);
extern void record_auto_save (void);
@@ -4621,8 +4624,6 @@ extern int str_collate (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
extern void syms_of_sysdep (void);
/* Defined in filelock.c. */
-extern void lock_file (Lisp_Object);
-extern void unlock_file (Lisp_Object);
extern void unlock_all_files (void);
extern void unlock_buffer (struct buffer *);
extern void syms_of_filelock (void);
diff --git a/src/macros.c b/src/macros.c
index 60d0766..0752a5b 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -324,7 +324,7 @@ buffer before the macro is executed. */)
break;
}
- command_loop_1 ();
+ command_loop_2 (list1 (Qminibuffer_quit));
executing_kbd_macro_iterations = ++success_count;
diff --git a/src/minibuf.c b/src/minibuf.c
index 1b842b7..c9134ef 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -496,7 +496,7 @@ confirm the aborting of the current minibuffer and all
contained ones. */)
}
}
else
- Fthrow (Qexit, Qt);
+ CALLN (Ffuncall, intern ("minibuffer-quit-recursive-edit"));
return Qnil;
}
@@ -689,12 +689,15 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
call1 (Qpush_window_buffer_onto_prev, minibuf_window);
record_unwind_protect_void (minibuffer_unwind);
- record_unwind_protect (restore_window_configuration,
- list3 (Fcurrent_window_configuration (Qnil), Qt, Qt));
+ if (read_minibuffer_restore_windows)
+ record_unwind_protect (restore_window_configuration,
+ list3 (Fcurrent_window_configuration (Qnil),
+ Qt, Qt));
/* If the minibuffer window is on a different frame, save that
frame's configuration too. */
- if (!EQ (mini_frame, selected_frame))
+ if (read_minibuffer_restore_windows &&
+ !EQ (mini_frame, selected_frame))
record_unwind_protect (restore_window_configuration,
list3 (Fcurrent_window_configuration (mini_frame),
Qnil, Qt));
@@ -2527,6 +2530,19 @@ for instance when running a headless Emacs server.
Functions like
instead. */);
inhibit_interaction = 0;
+ DEFVAR_BOOL ("read-minibuffer-restore-windows",
read_minibuffer_restore_windows,
+ doc: /* Non-nil means restore window configurations on exit from
minibuffer.
+If this is non-nil (the default), reading input with the minibuffer will
+restore, on exit, the window configurations of the frame where the
+minibuffer was entered from and, if it is different, the frame that owns
+the associated minibuffer window.
+
+If this is nil, window configurations are not restored upon exiting
+the minibuffer. However, if `minibuffer-restore-windows' is present
+in `minibuffer-exit-hook', exiting the minibuffer will remove the window
+showing the *Completions* buffer, if any. */);
+ read_minibuffer_restore_windows = true;
+
defsubr (&Sactive_minibuffer_window);
defsubr (&Sset_minibuffer_window);
defsubr (&Sread_from_minibuffer);
diff --git a/src/nsfns.m b/src/nsfns.m
index 454a6fd..c403677 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -947,11 +947,7 @@ frame_parm_handler ns_frame_parm_handlers[] =
0, /* x_set_sticky */
0, /* x_set_tool_bar_position */
0, /* x_set_inhibit_double_buffering */
-#ifdef NS_IMPL_COCOA
ns_set_undecorated,
-#else
- 0, /* ns_set_undecorated */
-#endif
ns_set_parent_frame,
0, /* x_set_skip_taskbar */
ns_set_no_focus_on_map,
diff --git a/src/nsfont.m b/src/nsfont.m
index 06e10d5..5a9cdfe 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -277,30 +277,36 @@ ns_ascii_average_width (NSFont *sfont)
/* Return whether set1 covers set2 to a reasonable extent given by pct.
- We check, out of each 16 Unicode char range containing chars in set2,
- whether at least one character is present in set1.
- This must be true for pct of the pairs to consider it covering. */
+
+ The GNUstep bitmap representation doesn't match Apple's
+ description. It appears to be a single block of bytes, not broken
+ up into planes, where the last byte contains the highest character
+ the character set supports. */
static BOOL
ns_charset_covers(NSCharacterSet *set1, NSCharacterSet *set2, float pct)
{
- const unsigned short *bytes1 = [[set1 bitmapRepresentation] bytes];
- const unsigned short *bytes2 = [[set2 bitmapRepresentation] bytes];
- int i, off = 0, tot = 0;
+ NSData *font = [set1 bitmapRepresentation];
+ NSData *script = [set2 bitmapRepresentation];
- /* Work around what appears to be a GNUstep bug.
- See <https://bugs.gnu.org/11853>. */
- if (! (bytes1 && bytes2))
- return NO;
+ uint8_t *fontPlane = (uint8_t *)[font bytes];
+ uint8_t *scriptPlane = (uint8_t *)[script bytes];
- for (i=0; i<4096; i++, bytes1++, bytes2++)
- if (*bytes2)
- {
- tot++;
- if (*bytes1 == 0) // *bytes1 & *bytes2 != *bytes2
- off++;
- }
- // fprintf(stderr, "off = %d\ttot = %d\n", off,tot);
- return (float)off / tot < 1.0F - pct;
+ int covered = 0, total = 0;
+
+ for (ptrdiff_t b = 0 ; b < [script length] ; b++)
+ for (int i = 0 ; i < 8 ; i++)
+ {
+ if (*(scriptPlane + b) & (1 << i))
+ {
+ total++;
+
+ if (b < [font length]
+ && *(fontPlane + b) & (1 << i))
+ covered++;
+ }
+ }
+
+ return (float)covered / total >= 1.0F - pct;
}
diff --git a/src/nsimage.m b/src/nsimage.m
index 3c16cd3..dd2bb3b 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -265,16 +265,12 @@ ns_image_size_in_bytes (void *img)
image = [[EmacsImage alloc] initByReferencingFile:filename];
image->bmRep = nil;
-#ifdef NS_IMPL_COCOA
- imgRep = [NSBitmapImageRep imageRepWithData:[image TIFFRepresentation]];
-#else
- imgRep = [image bestRepresentationForDevice: nil];
-#endif
- if (imgRep == nil)
+ if (![image isValid])
{
[image release];
return nil;
}
+ imgRep = [[image representations] firstObject];
[image setSize: NSMakeSize([imgRep pixelsWide], [imgRep pixelsHigh])];
[image setName:filename];
@@ -381,51 +377,10 @@ ns_image_size_in_bytes (void *img)
}
}
- xbm_fg = fg;
[self addRepresentation: bmRep];
return self;
}
-/* Set color for a bitmap image. */
-- (instancetype)setXBMColor: (NSColor *)color
-{
- NSSize s = [self size];
- unsigned char *planes[5];
- EmacsCGFloat r, g, b, a;
- NSColor *rgbColor;
-
- if (bmRep == nil || color == nil)
- return self;
-
- if ([color colorSpace] != [NSColorSpace genericRGBColorSpace])
- rgbColor = [color colorUsingColorSpace:[NSColorSpace
genericRGBColorSpace]];
- else
- rgbColor = color;
-
- [rgbColor getRed: &r green: &g blue: &b alpha: &a];
-
- [bmRep getBitmapDataPlanes: planes];
-
- {
- int i, len = s.width*s.height;
- int rr = r * 0xff, gg = g * 0xff, bb = b * 0xff;
- unsigned char fgr = (xbm_fg >> 16) & 0xff;
- unsigned char fgg = (xbm_fg >> 8) & 0xff;
- unsigned char fgb = xbm_fg & 0xff;
-
- for (i = 0; i < len; ++i)
- if (planes[0][i] == fgr && planes[1][i] == fgg && planes[2][i] == fgb)
- {
- planes[0][i] = rr;
- planes[1][i] = gg;
- planes[2][i] = bb;
- }
- xbm_fg = ((rr << 16) & 0xff0000) + ((gg << 8) & 0xff00) + (bb & 0xff);
- }
-
- return self;
-}
-
- (instancetype)initForXPMWithDepth: (int)depth width: (int)width height:
(int)height
{
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 1b03fe9..bb0dd26 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -991,12 +991,11 @@ free_frame_tool_bar (struct frame *f)
NSTRACE ("free_frame_tool_bar");
block_input ();
- view->wait_for_tool_bar = NO;
/* Note: This triggers an animation, which calls windowDidResize
repeatedly. */
f->output_data.ns->in_animation = 1;
- [[view toolbar] setVisible: NO];
+ [[[view window] toolbar] setVisible: NO];
f->output_data.ns->in_animation = 0;
unblock_input ();
@@ -1009,12 +1008,12 @@ update_frame_tool_bar (struct frame *f)
--------------------------------------------------------------------------
*/
{
int i, k = 0;
- EmacsView *view = FRAME_NS_VIEW (f);
- EmacsToolbar *toolbar = [view toolbar];
+ NSWindow *window = [FRAME_NS_VIEW (f) window];
+ EmacsToolbar *toolbar = (EmacsToolbar *)[window toolbar];
NSTRACE ("update_frame_tool_bar");
- if (view == nil || toolbar == nil) return;
+ if (window == nil || toolbar == nil) return;
block_input ();
#ifdef NS_IMPL_COCOA
@@ -1090,10 +1089,10 @@ update_frame_tool_bar (struct frame *f)
#undef TOOLPROP
}
- if (![toolbar isVisible])
+ if ([toolbar isVisible] != FRAME_EXTERNAL_TOOL_BAR (f))
{
f->output_data.ns->in_animation = 1;
- [toolbar setVisible: YES];
+ [toolbar setVisible: FRAME_EXTERNAL_TOOL_BAR (f)];
f->output_data.ns->in_animation = 0;
}
@@ -1120,13 +1119,6 @@ update_frame_tool_bar (struct frame *f)
[newDict release];
}
#endif
-
- if (view->wait_for_tool_bar && FRAME_TOOLBAR_HEIGHT (f) > 0)
- {
- view->wait_for_tool_bar = NO;
- [view setNeedsDisplay: YES];
- }
-
unblock_input ();
}
diff --git a/src/nsterm.h b/src/nsterm.h
index b29e76c..404c714 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -348,16 +348,6 @@ typedef id instancetype;
#endif
-/* macOS 10.14 and above cannot draw directly "to the glass" and
- therefore we draw to an offscreen buffer and swap it in when the
- toolkit wants to draw the frame. GNUstep and macOS 10.7 and below
- do not support this method, so we revert to drawing directly to the
- glass. */
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101400
-#define NS_DRAW_TO_BUFFER 1
-#endif
-
-
/* ==========================================================================
NSColor, EmacsColor category.
@@ -416,6 +406,25 @@ typedef id instancetype;
@end
#endif
+/* EmacsWindow */
+@interface EmacsWindow : NSWindow
+{
+ NSPoint grabOffset;
+}
+
+#ifdef NS_IMPL_GNUSTEP
+- (NSInteger) orderedIndex;
+#endif
+
+- (instancetype)initWithEmacsFrame:(struct frame *)f;
+- (instancetype)initWithEmacsFrame:(struct frame *)f
fullscreen:(BOOL)fullscreen screen:(NSScreen *)screen;
+- (void)setParentChildRelationships;
+- (NSInteger)borderWidth;
+- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above;
+- (void)setAppearance;
+@end
+
+
/* ==========================================================================
The main Emacs view
@@ -423,7 +432,7 @@ typedef id instancetype;
==========================================================================
*/
@class EmacsToolbar;
-@class EmacsSurface;
+@class EmacsLayer;
#ifdef NS_IMPL_COCOA
@interface EmacsView : NSView <NSTextInput, NSWindowDelegate>
@@ -439,19 +448,13 @@ typedef id instancetype;
NSString *workingText;
BOOL processingCompose;
int fs_state, fs_before_fs, next_maximized;
- int bwidth;
int maximized_width, maximized_height;
- NSWindow *nonfs_window;
+ EmacsWindow *nonfs_window;
BOOL fs_is_native;
-#ifdef NS_DRAW_TO_BUFFER
- EmacsSurface *surface;
-#endif
@public
struct frame *emacsframe;
int scrollbarsNeedingUpdate;
- EmacsToolbar *toolbar;
NSRect ns_userRect;
- BOOL wait_for_tool_bar;
}
/* AppKit-side interface */
@@ -465,9 +468,7 @@ typedef id instancetype;
/* Emacs-side interface */
- (instancetype) initFrameFromEmacs: (struct frame *) f;
-- (void) createToolbar: (struct frame *)f;
- (void) setWindowClosing: (BOOL)closing;
-- (EmacsToolbar *) toolbar;
- (void) deleteWorkingText;
- (void) handleFS;
- (void) setFSValue: (int)value;
@@ -483,9 +484,9 @@ typedef id instancetype;
#endif
- (int)fullscreenState;
-#ifdef NS_DRAW_TO_BUFFER
-- (void)focusOnDrawingBuffer;
-- (void)unfocusDrawingBuffer;
+#ifdef NS_IMPL_COCOA
+- (void)lockFocus;
+- (void)unlockFocus;
#endif
- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect;
@@ -498,27 +499,6 @@ typedef id instancetype;
@end
-/* Small utility used for processing resize events under Cocoa. */
-@interface EmacsWindow : NSWindow
-{
- NSPoint grabOffset;
-}
-
-#ifdef NS_IMPL_GNUSTEP
-- (NSInteger) orderedIndex;
-#endif
-
-- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above;
-- (void)setAppearance;
-@end
-
-
-/* Fullscreen version of the above. */
-@interface EmacsFSWindow : EmacsWindow
-{
-}
-@end
-
/* ==========================================================================
The main menu implementation
@@ -647,7 +627,6 @@ typedef id instancetype;
NSBitmapImageRep *bmRep; /* used for accessing pixel data */
unsigned char *pixmapData[5]; /* shortcut to access pixel data */
NSColor *stippleMask;
- unsigned long xbm_fg;
@public
NSAffineTransform *transform;
BOOL smoothing;
@@ -657,7 +636,6 @@ typedef id instancetype;
- (instancetype)initFromXBM: (unsigned char *)bits width: (int)w height: (int)h
fg: (unsigned long)fg bg: (unsigned long)bg
reverseBytes: (BOOL)reverse;
-- (instancetype)setXBMColor: (NSColor *)color;
- (instancetype)initForXPMWithDepth: (int)depth width: (int)width height:
(int)height;
- (void)setPixmapData;
- (unsigned long)getPixelAtX: (int)x Y: (int)y;
@@ -716,23 +694,17 @@ typedef id instancetype;
+ (CGFloat)scrollerWidth;
@end
-#ifdef NS_DRAW_TO_BUFFER
-@interface EmacsSurface : NSObject
+#ifdef NS_IMPL_COCOA
+@interface EmacsLayer : CALayer
{
NSMutableArray *cache;
- NSSize size;
CGColorSpaceRef colorSpace;
IOSurfaceRef currentSurface;
- IOSurfaceRef lastSurface;
CGContextRef context;
- CGFloat scale;
}
-- (id) initWithSize: (NSSize)s ColorSpace: (CGColorSpaceRef)cs Scale:
(CGFloat)scale;
-- (void) dealloc;
-- (NSSize) getSize;
+- (id) initWithColorSpace: (CGColorSpaceRef)cs;
+- (void) setColorSpace: (CGColorSpaceRef)cs;
- (CGContextRef) getContext;
-- (void) releaseContext;
-- (IOSurfaceRef) getSurface;
@end
#endif
diff --git a/src/nsterm.m b/src/nsterm.m
index dc5ecc4..3676418 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -70,9 +70,6 @@ GNUstep port and post-20 update by Adrian Robert
(arobert@cogsci.ucsd.edu)
#ifdef NS_IMPL_COCOA
#include "macfont.h"
#include <Carbon/Carbon.h>
-#endif
-
-#ifdef NS_DRAW_TO_BUFFER
#include <IOSurface/IOSurface.h>
#endif
@@ -272,16 +269,11 @@ long context_menu_value = 0;
/* display update */
static struct frame *ns_updating_frame;
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
-static NSView *focus_view = NULL;
-#endif
static int ns_window_num = 0;
static BOOL gsaved = NO;
-static BOOL ns_fake_keydown = NO;
#ifdef NS_IMPL_COCOA
static BOOL ns_menu_bar_is_hidden = NO;
#endif
-/* static int debug_lock = 0; */
/* event loop */
static BOOL send_appdefined = YES;
@@ -1034,33 +1026,14 @@ ns_update_begin (struct frame *f)
{
// Fix reappearing tool bar in fullscreen for Mac OS X 10.7
BOOL tbar_visible = FRAME_EXTERNAL_TOOL_BAR (f) ? YES : NO;
- NSToolbar *toolbar = [FRAME_NS_VIEW (f) toolbar];
+ NSToolbar *toolbar = [[FRAME_NS_VIEW (f) window] toolbar];
if (! tbar_visible != ! [toolbar isVisible])
[toolbar setVisible: tbar_visible];
}
#endif
ns_updating_frame = f;
-#ifdef NS_DRAW_TO_BUFFER
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
- {
-#endif
- [view focusOnDrawingBuffer];
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
- else
- {
-#endif
-#endif /* NS_DRAW_TO_BUFFER */
-
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- [view lockFocus];
-#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
-#endif
-
+ [view lockFocus];
}
@@ -1071,39 +1044,21 @@ ns_update_end (struct frame *f)
external (RIF) call; for whole frame, called after gui_update_window_end
--------------------------------------------------------------------------
*/
{
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
EmacsView *view = FRAME_NS_VIEW (f);
-#endif
NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end");
/* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */
MOUSE_HL_INFO (f)->mouse_face_defer = 0;
-#ifdef NS_DRAW_TO_BUFFER
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
- {
-#endif
- [FRAME_NS_VIEW (f) unfocusDrawingBuffer];
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
- else
- {
-#endif
-#endif /* NS_DRAW_TO_BUFFER */
-
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- block_input ();
-
- [view unlockFocus];
- [[view window] flushWindow];
+ block_input ();
- unblock_input ();
-#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
+ [view unlockFocus];
+#if defined (NS_IMPL_GNUSTEP)
+ [[view window] flushWindow];
#endif
+
+ unblock_input ();
ns_updating_frame = NULL;
}
@@ -1118,8 +1073,6 @@ ns_focus (struct frame *f, NSRect *r, int n)
the entire window.
--------------------------------------------------------------------------
*/
{
- EmacsView *view = FRAME_NS_VIEW (f);
-
NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_focus");
if (r != NULL)
{
@@ -1128,39 +1081,10 @@ ns_focus (struct frame *f, NSRect *r, int n)
if (f != ns_updating_frame)
{
-#ifdef NS_DRAW_TO_BUFFER
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
- {
-#endif
- [view focusOnDrawingBuffer];
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
- else
- {
-#endif
-#endif /* NS_DRAW_TO_BUFFER */
-
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if (view != focus_view)
- {
- if (focus_view != NULL)
- {
- [focus_view unlockFocus];
- [[focus_view window] flushWindow];
- }
-
- if (view)
- [view lockFocus];
- focus_view = view;
- }
-#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
-#endif
+ EmacsView *view = FRAME_NS_VIEW (f);
+ [view lockFocus];
}
-
/* clipping */
if (r)
{
@@ -1188,35 +1112,14 @@ ns_unfocus (struct frame *f)
gsaved = NO;
}
-#ifdef NS_DRAW_TO_BUFFER
- #if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
- {
-#endif
- if (! ns_updating_frame)
- [FRAME_NS_VIEW (f) unfocusDrawingBuffer];
- [FRAME_NS_VIEW (f) setNeedsDisplay:YES];
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
- else
+ if (f != ns_updating_frame)
{
+ EmacsView *view = FRAME_NS_VIEW (f);
+ [view unlockFocus];
+#if defined (NS_IMPL_GNUSTEP)
+ [[view window] flushWindow];
#endif
-#endif /* NS_DRAW_TO_BUFFER */
-
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if (f != ns_updating_frame)
- {
- if (focus_view != NULL)
- {
- [focus_view unlockFocus];
- [[focus_view window] flushWindow];
- focus_view = NULL;
- }
- }
-#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
-#endif
}
@@ -1383,7 +1286,7 @@ ns_ring_bell (struct frame *f)
}
}
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
static void
hide_bell (void)
/* --------------------------------------------------------------------------
@@ -1550,7 +1453,7 @@ ns_make_frame_visible (struct frame *f)
if (!FRAME_VISIBLE_P (f))
{
EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
- NSWindow *window = [view window];
+ EmacsWindow *window = (EmacsWindow *)[view window];
SET_FRAME_VISIBLE (f, 1);
ns_raise_frame (f, ! FRAME_NO_FOCUS_ON_MAP (f));
@@ -1573,11 +1476,8 @@ ns_make_frame_visible (struct frame *f)
relationship, so reinstate it. */
if ([window parentWindow] == nil && FRAME_PARENT_FRAME (f) != NULL)
{
- NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window];
-
block_input ();
- [parent addChildWindow: window
- ordered: NSWindowAbove];
+ [window setParentChildRelationships];
unblock_input ();
/* If the parent frame moved while the child frame was
@@ -1734,52 +1634,35 @@ ns_set_offset (struct frame *f, int xoff, int yoff, int
change_grav)
block_input ();
- if (FRAME_PARENT_FRAME (f))
- {
- /* Convert the parent frame's view rectangle into screen
- coords. */
- EmacsView *parentView = FRAME_NS_VIEW (FRAME_PARENT_FRAME (f));
- NSRect parentRect = [parentView convertRect:[parentView frame]
- toView:nil];
- parentRect = [[parentView window] convertRectToScreen:parentRect];
+ /* If there is no parent frame then just convert to screen
+ coordinates, UNLESS we have negative values, in which case I
+ think it's best to position from the bottom and right of the
+ current screen rather than the main screen or whole display. */
- if (f->size_hint_flags & XNegative)
- topLeft.x = NSMaxX (parentRect) - NSWidth (windowFrame) + xoff;
- else
- topLeft.x = NSMinX (parentRect) + xoff;
+ NSRect parentRect = ns_parent_window_rect (f);
- if (f->size_hint_flags & YNegative)
- topLeft.y = NSMinY (parentRect) + NSHeight (windowFrame) - yoff;
- else
- topLeft.y = NSMaxY (parentRect) - yoff;
- }
+ if (f->size_hint_flags & XNegative)
+ topLeft.x = NSMaxX (parentRect) - NSWidth (windowFrame) + xoff;
+ else if (FRAME_PARENT_FRAME (f))
+ topLeft.x = NSMinX (parentRect) + xoff;
else
- {
- /* If there is no parent frame then just convert to screen
- coordinates, UNLESS we have negative values, in which case I
- think it's best to position from the bottom and right of the
- current screen rather than the main screen or whole
- display. */
- NSRect screenFrame = [[[view window] screen] frame];
-
- if (f->size_hint_flags & XNegative)
- topLeft.x = NSMaxX (screenFrame) - NSWidth (windowFrame) + xoff;
- else
- topLeft.x = xoff;
+ topLeft.x = xoff;
- if (f->size_hint_flags & YNegative)
- topLeft.y = NSMinY (screenFrame) + NSHeight (windowFrame) - yoff;
- else
- topLeft.y = NSMaxY ([[[NSScreen screens] objectAtIndex:0] frame]) -
yoff;
+ if (f->size_hint_flags & YNegative)
+ topLeft.y = NSMinY (parentRect) + NSHeight (windowFrame) - yoff;
+ else if (FRAME_PARENT_FRAME (f))
+ topLeft.y = NSMaxY (parentRect) - yoff;
+ else
+ topLeft.y = NSMaxY ([[[NSScreen screens] objectAtIndex:0] frame]) - yoff;
#ifdef NS_IMPL_GNUSTEP
- /* Don't overlap the menu.
+ /* Don't overlap the menu.
- FIXME: Surely there's a better way than just hardcoding 100
- in here? */
- topLeft.x = 100;
+ FIXME: Surely there's a better way than just hardcoding 100 in
+ here? */
+ if (topLeft.x < 100)
+ topLeft.x = 100;
#endif
- }
NSTRACE_POINT ("setFrameTopLeftPoint", topLeft);
[[view window] setFrameTopLeftPoint:topLeft];
@@ -1802,45 +1685,38 @@ ns_set_window_size (struct frame *f,
{
EmacsView *view = FRAME_NS_VIEW (f);
NSWindow *window = [view window];
- NSRect wr = [window frame];
- int orig_height = wr.size.height;
+ NSRect frameRect;
NSTRACE ("ns_set_window_size");
if (view == nil)
return;
- NSTRACE_RECT ("current", wr);
+ NSTRACE_RECT ("current", [window frame]);
NSTRACE_MSG ("Width:%d Height:%d", width, height);
NSTRACE_MSG ("Font %d x %d", FRAME_COLUMN_WIDTH (f), FRAME_LINE_HEIGHT (f));
block_input ();
- wr.size.width = width + f->border_width;
- wr.size.height = height;
- if (! [view isFullscreen])
- wr.size.height += FRAME_NS_TITLEBAR_HEIGHT (f)
- + FRAME_TOOLBAR_HEIGHT (f);
+ frameRect = [window frameRectForContentRect:NSMakeRect (0, 0, width,
height)];
- /* Do not try to constrain to this screen. We may have multiple
- screens, and want Emacs to span those. Constraining to screen
- prevents that, and that is not nice to the user. */
- if (f->output_data.ns->zooming)
- f->output_data.ns->zooming = 0;
- else
- wr.origin.y += orig_height - wr.size.height;
+ /* Set the origin so the top left of the frame doesn't move. */
+ frameRect.origin = [window frame].origin;
+ frameRect.origin.y += NSHeight ([view frame]) - height;
- /* Usually it seems safe to delay changing the frame size, but when a
- series of actions are taken with no redisplay between them then we
- can end up using old values so don't delay here. */
- change_frame_size (f, width, height, false, NO, false);
+ if (f->output_data.ns->zooming)
+ f->output_data.ns->zooming = 0;
- [window setFrame:wr display:NO];
+ /* Usually it seems safe to delay changing the frame size, but when a
+ series of actions are taken with no redisplay between them then we
+ can end up using old values so don't delay here. */
+ change_frame_size (f, width, height, false, NO, false);
+
+ [window setFrame:frameRect display:NO];
unblock_input ();
}
-#ifdef NS_IMPL_COCOA
void
ns_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object
old_value)
/* --------------------------------------------------------------------------
@@ -1850,45 +1726,34 @@ ns_set_undecorated (struct frame *f, Lisp_Object
new_value, Lisp_Object old_valu
dragged, resized, iconified, maximized or deleted with the mouse. If
nil, draw the frame with all the elements listed above unless these
have been suspended via window manager settings.
-
- GNUStep cannot change an existing window's style.
--------------------------------------------------------------------------
*/
{
- EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
- NSWindow *window = [view window];
-
NSTRACE ("ns_set_undecorated");
if (!EQ (new_value, old_value))
{
+ EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
+ NSWindow *oldWindow = [view window];
+ NSWindow *newWindow;
+
block_input ();
- if (NILP (new_value))
- {
- FRAME_UNDECORATED (f) = false;
- [window setStyleMask: ((window.styleMask | FRAME_DECORATED_FLAGS)
- ^ FRAME_UNDECORATED_FLAGS)];
+ FRAME_UNDECORATED (f) = !NILP (new_value);
- [view createToolbar: f];
- }
- else
- {
- [window setToolbar: nil];
- /* Do I need to release the toolbar here? */
+ newWindow = [[EmacsWindow alloc] initWithEmacsFrame:f];
- FRAME_UNDECORATED (f) = true;
- [window setStyleMask: ((window.styleMask | FRAME_UNDECORATED_FLAGS)
- ^ FRAME_DECORATED_FLAGS)];
- }
+ if ([oldWindow isKeyWindow])
+ [newWindow makeKeyAndOrderFront:NSApp];
+
+ [newWindow setIsVisible:[oldWindow isVisible]];
+ if ([oldWindow isMiniaturized])
+ [newWindow miniaturize:NSApp];
- /* At this point it seems we don't have an active NSResponder,
- so some key presses (TAB) are swallowed by the system. */
- [window makeFirstResponder: view];
+ [oldWindow close];
unblock_input ();
}
}
-#endif /* NS_IMPL_COCOA */
void
ns_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object
old_value)
@@ -1915,7 +1780,6 @@ ns_set_parent_frame (struct frame *f, Lisp_Object
new_value, Lisp_Object old_val
--------------------------------------------------------------------------
*/
{
struct frame *p = NULL;
- NSWindow *parent, *child;
NSTRACE ("ns_set_parent_frame");
@@ -1928,72 +1792,11 @@ ns_set_parent_frame (struct frame *f, Lisp_Object
new_value, Lisp_Object old_val
error ("Invalid specification of `parent-frame'");
}
- if (p != FRAME_PARENT_FRAME (f))
- {
- block_input ();
- child = [FRAME_NS_VIEW (f) window];
-
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
-#endif
-
- if ([child parentWindow] != nil)
- {
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- parent = [child parentWindow];
-#endif
-
- [[child parentWindow] removeChildWindow:child];
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000
- if ([child respondsToSelector:@selector(setAccessibilitySubrole:)])
-#endif
- [child
setAccessibilitySubrole:NSAccessibilityStandardWindowSubrole];
-#endif
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- if (NILP (new_value))
- {
- NSTRACE ("child
setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary");
- [child
setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary];
- // if current parent in fullscreen and no new parent make child
fullscreen
- while (parent) {
- if (([parent styleMask] & NSWindowStyleMaskFullScreen) != 0)
- {
- [view toggleFullScreen:child];
- break;
- }
- // check all parents
- parent = [parent parentWindow];
- }
- }
-#endif
- }
-
- if (!NILP (new_value))
- {
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- // child frame must not be in fullscreen
- if ([view fsIsNative] && [view isFullscreen])
- [view toggleFullScreen:child];
- NSTRACE ("child
setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary");
- [child
setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary];
-#endif
- parent = [FRAME_NS_VIEW (p) window];
-
- [parent addChildWindow: child
- ordered: NSWindowAbove];
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000
- if ([child respondsToSelector:@selector(setAccessibilitySubrole:)])
-#endif
- [child
setAccessibilitySubrole:NSAccessibilityFloatingWindowSubrole];
-#endif
- }
-
- unblock_input ();
+ fset_parent_frame (f, new_value);
- fset_parent_frame (f, new_value);
- }
+ block_input ();
+ [(EmacsWindow *)[FRAME_NS_VIEW (f) window] setParentChildRelationships];
+ unblock_input ();
}
void
@@ -2435,12 +2238,10 @@ ns_set_frame_alpha (struct frame *f)
else if (0.0 <= alpha && alpha < alpha_min && alpha_min <= 1.0)
alpha = alpha_min;
-#ifdef NS_IMPL_COCOA
{
EmacsView *view = FRAME_NS_VIEW (f);
- [[view window] setAlphaValue: alpha];
+ [[view window] setAlphaValue: alpha];
}
-#endif
}
@@ -3094,6 +2895,39 @@ ns_compute_glyph_string_overhangs (struct glyph_string
*s)
==========================================================================
*/
+static NSMutableDictionary *fringe_bmp;
+
+static void
+ns_define_fringe_bitmap (int which, unsigned short *bits, int h, int w)
+{
+ NSBezierPath *p = [NSBezierPath bezierPath];
+
+ if (!fringe_bmp)
+ fringe_bmp = [[NSMutableDictionary alloc] initWithCapacity:25];
+
+ [p moveToPoint:NSMakePoint (0, 0)];
+
+ for (int y = 0 ; y < h ; y++)
+ for (int x = 0 ; x < w ; x++)
+ {
+ /* XBM rows are always round numbers of bytes, with any unused
+ bits ignored. */
+ int byte = y * (w/8 + (w%8 ? 1 : 0)) + x/8;
+ bool bit = bits[byte] & (0x80 >> x%8);
+ if (bit)
+ [p appendBezierPathWithRect:NSMakeRect (x, y, 1, 1)];
+ }
+
+ [fringe_bmp setObject:p forKey:[NSNumber numberWithInt:which]];
+}
+
+
+static void
+ns_destroy_fringe_bitmap (int which)
+{
+ [fringe_bmp removeObjectForKey:[NSNumber numberWithInt:which]];
+}
+
extern int max_used_fringe_bitmap;
static void
@@ -3121,41 +2955,18 @@ ns_draw_fringe_bitmap (struct window *w, struct
glyph_row *row,
struct frame *f = XFRAME (WINDOW_FRAME (w));
struct face *face = p->face;
- static EmacsImage **bimgs = NULL;
- static int nBimgs = 0;
NSRect clearRect = NSZeroRect;
- NSRect imageRect = NSZeroRect;
NSRect rowRect = ns_row_rect (w, row, ANY_AREA);
NSTRACE_WHEN (NSTRACE_GROUP_FRINGE, "ns_draw_fringe_bitmap");
NSTRACE_MSG ("which:%d cursor:%d overlay:%d width:%d height:%d period:%d",
p->which, p->cursor_p, p->overlay_p, p->wd, p->h, p->dh);
- /* grow bimgs if needed */
- if (nBimgs < max_used_fringe_bitmap)
- {
- bimgs = xrealloc (bimgs, max_used_fringe_bitmap * sizeof *bimgs);
- memset (bimgs + nBimgs, 0,
- (max_used_fringe_bitmap - nBimgs) * sizeof *bimgs);
- nBimgs = max_used_fringe_bitmap;
- }
-
- /* Work out the rectangle we will composite into. */
- if (p->which)
- imageRect = NSMakeRect (p->x, p->y, p->wd, p->h);
+ /* Work out the rectangle we will need to clear. */
+ clearRect = NSMakeRect (p->x, p->y, p->wd, p->h);
- /* Work out the rectangle we will need to clear. Because we're
- compositing rather than blitting, we need to clear the area under
- the image regardless of anything else. */
if (p->bx >= 0 && !p->overlay_p)
- {
- clearRect = NSMakeRect (p->bx, p->by, p->nx, p->ny);
- clearRect = NSUnionRect (clearRect, imageRect);
- }
- else
- {
- clearRect = imageRect;
- }
+ clearRect = NSUnionRect (clearRect, NSMakeRect (p->bx, p->by, p->nx,
p->ny));
/* Handle partially visible rows. */
clearRect = NSIntersectionRect (clearRect, rowRect);
@@ -3171,53 +2982,29 @@ ns_draw_fringe_bitmap (struct window *w, struct
glyph_row *row,
NSRectFill (clearRect);
}
- if (p->which)
+ NSBezierPath *bmp = [fringe_bmp objectForKey:[NSNumber
numberWithInt:p->which]];
+ if (bmp)
{
- EmacsImage *img = bimgs[p->which - 1];
-
- if (!img)
- {
- // Note: For "periodic" images, allocate one EmacsImage for
- // the base image, and use it for all dh:s.
- unsigned short *bits = p->bits;
- int full_height = p->h + p->dh;
- int i;
- unsigned char *cbits = xmalloc (full_height);
-
- for (i = 0; i < full_height; i++)
- cbits[i] = bits[i];
- img = [[EmacsImage alloc] initFromXBM: cbits width: 8
- height: full_height
- fg: 0 bg: 0
- reverseBytes: NO];
- bimgs[p->which - 1] = img;
- xfree (cbits);
- }
-
+ NSAffineTransform *transform = [NSAffineTransform transform];
+ NSColor *bm_color;
- {
- NSColor *bm_color;
- if (!p->cursor_p)
- bm_color = ns_lookup_indexed_color(face->foreground, f);
- else if (p->overlay_p)
- bm_color = ns_lookup_indexed_color(face->background, f);
- else
- bm_color = f->output_data.ns->cursor_color;
- [img setXBMColor: bm_color];
- }
+ /* Because the image is defined at (0, 0) we need to take a copy
+ and then transform that copy to the new origin. */
+ bmp = [bmp copy];
+ [transform translateXBy:p->x yBy:p->y - p->dh];
+ [bmp transformUsingAffineTransform:transform];
- // Note: For periodic images, the full image height is "h + hd".
- // By using the height h, a suitable part of the image is used.
- NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h);
+ if (!p->cursor_p)
+ bm_color = ns_lookup_indexed_color(face->foreground, f);
+ else if (p->overlay_p)
+ bm_color = ns_lookup_indexed_color(face->background, f);
+ else
+ bm_color = f->output_data.ns->cursor_color;
- NSTRACE_RECT ("fromRect", fromRect);
+ [bm_color set];
+ [bmp fill];
- [img drawInRect: imageRect
- fromRect: fromRect
- operation: NSCompositingOperationSourceOver
- fraction: 1.0
- respectFlipped: YES
- hints: nil];
+ [bmp release];
}
ns_unfocus (f);
}
@@ -3692,7 +3479,7 @@ ns_draw_box (NSRect r, CGFloat hthickness, CGFloat
vthickness,
static void
-ns_draw_relief (NSRect r, int hthickness, int vthickness, char raised_p,
+ns_draw_relief (NSRect outer, int hthickness, int vthickness, char raised_p,
char top_p, char bottom_p, char left_p, char right_p,
struct glyph_string *s)
/* --------------------------------------------------------------------------
@@ -3703,7 +3490,7 @@ ns_draw_relief (NSRect r, int hthickness, int vthickness,
char raised_p,
{
static NSColor *baseCol = nil, *lightCol = nil, *darkCol = nil;
NSColor *newBaseCol = nil;
- NSRect sr = r;
+ NSRect inner;
NSTRACE ("ns_draw_relief");
@@ -3737,33 +3524,50 @@ ns_draw_relief (NSRect r, int hthickness, int
vthickness, char raised_p,
darkCol = [[baseCol shadowWithLevel: 0.3] retain];
}
- [(raised_p ? lightCol : darkCol) set];
-
- /* TODO: mitering. Using NSBezierPath doesn't work because of color switch.
*/
+ /* Calculate the inner rectangle. */
+ inner = NSInsetRect (outer, hthickness, vthickness);
- /* top */
- sr.size.height = hthickness;
- if (top_p) NSRectFill (sr);
+ [(raised_p ? lightCol : darkCol) set];
- /* left */
- sr.size.height = r.size.height;
- sr.size.width = vthickness;
- if (left_p) NSRectFill (sr);
+ if (top_p || left_p)
+ {
+ NSBezierPath *p = [NSBezierPath bezierPath];
+ [p moveToPoint:NSMakePoint (NSMinX (outer), NSMinY (outer))];
+ if (top_p)
+ {
+ [p lineToPoint:NSMakePoint (NSMaxX (outer), NSMinY (outer))];
+ [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMinY (inner))];
+ }
+ [p lineToPoint:NSMakePoint (NSMinX (inner), NSMinY (inner))];
+ if (left_p)
+ {
+ [p lineToPoint:NSMakePoint (NSMinX (inner), NSMaxY (inner))];
+ [p lineToPoint:NSMakePoint (NSMinX (outer), NSMaxY (outer))];
+ }
+ [p closePath];
+ [p fill];
+ }
[(raised_p ? darkCol : lightCol) set];
- /* bottom */
- sr.size.width = r.size.width;
- sr.size.height = hthickness;
- sr.origin.y += r.size.height - hthickness;
- if (bottom_p) NSRectFill (sr);
-
- /* right */
- sr.size.height = r.size.height;
- sr.origin.y = r.origin.y;
- sr.size.width = vthickness;
- sr.origin.x += r.size.width - vthickness;
- if (right_p) NSRectFill (sr);
+ if (bottom_p || right_p)
+ {
+ NSBezierPath *p = [NSBezierPath bezierPath];
+ [p moveToPoint:NSMakePoint (NSMaxX (outer), NSMaxY (outer))];
+ if (right_p)
+ {
+ [p lineToPoint:NSMakePoint (NSMaxX (outer), NSMinY (outer))];
+ [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMinY (inner))];
+ }
+ [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMaxY (inner))];
+ if (bottom_p)
+ {
+ [p lineToPoint:NSMakePoint (NSMinX (inner), NSMaxY (inner))];
+ [p lineToPoint:NSMakePoint (NSMinX (outer), NSMaxY (outer))];
+ }
+ [p closePath];
+ [p fill];
+ }
}
@@ -5172,8 +4976,8 @@ static struct redisplay_interface ns_redisplay_interface =
gui_get_glyph_overhangs,
gui_fix_overlapping_area,
ns_draw_fringe_bitmap,
- 0, /* define_fringe_bitmap */ /* FIXME: simplify ns_draw_fringe_bitmap */
- 0, /* destroy_fringe_bitmap */
+ ns_define_fringe_bitmap,
+ ns_destroy_fringe_bitmap,
ns_compute_glyph_string_overhangs,
ns_draw_glyph_string,
ns_define_frame_cursor,
@@ -5359,6 +5163,8 @@ ns_term_init (Lisp_Object display_name)
terminal->name = xlispstrdup (display_name);
+ gui_init_fringe (terminal->rif);
+
unblock_input ();
if (!inhibit_x_resources)
@@ -6200,11 +6006,6 @@ not_in_argv (NSString *arg)
name:NSViewFrameDidChangeNotification
object:nil];
-#ifdef NS_DRAW_TO_BUFFER
- [surface release];
-#endif
-
- [toolbar release];
if (fs_state == FULLSCREEN_BOTH)
[nonfs_window release];
[super dealloc];
@@ -6293,9 +6094,7 @@ not_in_argv (NSString *arg)
NSTRACE ("[EmacsView keyDown:]");
/* Rhapsody and macOS give up and down events for the arrow keys. */
- if (ns_fake_keydown == YES)
- ns_fake_keydown = NO;
- else if ([theEvent type] != NSEventTypeKeyDown)
+ if ([theEvent type] != NSEventTypeKeyDown)
return;
if (!emacs_event)
@@ -7152,43 +6951,6 @@ not_in_argv (NSString *arg)
}
-- (void)windowDidResize: (NSNotification *)notification
-{
- NSTRACE ("[EmacsView windowDidResize:]");
- if (!FRAME_LIVE_P (emacsframe))
- {
- NSTRACE_MSG ("Ignored (frame dead)");
- return;
- }
- if (emacsframe->output_data.ns->in_animation)
- {
- NSTRACE_MSG ("Ignored (in animation)");
- return;
- }
-
- if (! [self fsIsNative])
- {
- NSWindow *theWindow = [notification object];
- /* We can get notification on the non-FS window when in
- fullscreen mode. */
- if ([self window] != theWindow) return;
- }
-
- NSTRACE_RECT ("frame", [[notification object] frame]);
-
-#ifdef NS_IMPL_GNUSTEP
- NSWindow *theWindow = [notification object];
-
- /* In GNUstep, at least currently, it's possible to get a didResize
- without getting a willResize, therefore we need to act as if we got
- the willResize now. */
- NSSize sz = [theWindow frame].size;
- sz = [self windowWillResize: theWindow toSize: sz];
-#endif /* NS_IMPL_GNUSTEP */
-
- ns_send_appdefined (-1);
-}
-
#ifdef NS_IMPL_COCOA
- (void)viewDidEndLiveResize
{
@@ -7206,56 +6968,30 @@ not_in_argv (NSString *arg)
#endif /* NS_IMPL_COCOA */
-- (void)viewDidResize:(NSNotification *)notification
+- (void)resizeWithOldSuperviewSize: (NSSize)oldSize
{
- NSRect frame = [self frame];
- int neww, newh, oldw, oldh;
-
- if (! FRAME_LIVE_P (emacsframe))
- return;
-
- NSTRACE ("[EmacsView viewDidResize]");
-
-#ifdef NS_DRAW_TO_BUFFER
- /* If the buffer size doesn't match the view's backing size, destroy
- the buffer and let it be recreated at the correct size later. */
- if ([self wantsUpdateLayer] && surface)
- {
- NSRect surfaceRect = {{0, 0}, [surface getSize]};
- NSRect frameRect = [[self window] convertRectToBacking:frame];
+ NSRect frame;
+ int width, height;
- if (!NSEqualRects (frameRect, surfaceRect))
- {
- [surface release];
- surface = nil;
+ NSTRACE ("[EmacsView resizeWithOldSuperviewSize:]");
- [self setNeedsDisplay:YES];
- }
- }
-#endif
+ [super resizeWithOldSuperviewSize:oldSize];
- neww = (int)NSWidth (frame);
- newh = (int)NSHeight (frame);
- oldw = FRAME_PIXEL_WIDTH (emacsframe);
- oldh = FRAME_PIXEL_HEIGHT (emacsframe);
+ if (! FRAME_LIVE_P (emacsframe))
+ return;
- /* Don't want to do anything when the view size hasn't changed. */
- if (emacsframe->new_size_p
- ? (newh == emacsframe->new_height
- && neww == emacsframe->new_width)
- : (oldh == newh && oldw == neww))
- {
- NSTRACE_MSG ("No change");
- return;
- }
+ frame = [self frame];
+ width = (int)NSWidth (frame);
+ height = (int)NSHeight (frame);
- NSTRACE_SIZE ("New size", NSMakeSize (neww, newh));
- NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh));
+ NSTRACE_SIZE ("New size", NSMakeSize (width, height));
+ NSTRACE_SIZE ("Original size", size);
- change_frame_size (emacsframe, neww, newh, false, YES, false);
+ change_frame_size (emacsframe, width, height, false, YES, false);
SET_FRAME_GARBAGED (emacsframe);
cancel_mouse_face (emacsframe);
+ ns_send_appdefined (-1);
}
@@ -7350,42 +7086,8 @@ not_in_argv (NSString *arg)
}
-- (void)createToolbar: (struct frame *)f
-{
- EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
- NSWindow *window = [view window];
-
- toolbar = [[EmacsToolbar alloc] initForView: self withIdentifier:
- [NSString stringWithFormat: @"Emacs Frame %d",
- ns_window_num]];
- [toolbar setVisible: NO];
- [window setToolbar: toolbar];
-
- /* Don't set frame garbaged until tool bar is up to date?
- This avoids an extra clear and redraw (flicker) at frame creation. */
- if (FRAME_EXTERNAL_TOOL_BAR (f)) wait_for_tool_bar = YES;
- else wait_for_tool_bar = NO;
-
-
-#ifdef NS_IMPL_COCOA
- {
- NSButton *toggleButton;
- toggleButton = [window standardWindowButton: NSWindowToolbarButton];
- [toggleButton setTarget: self];
- [toggleButton setAction: @selector (toggleToolbar: )];
- }
-#endif
-}
-
-
- (instancetype) initFrameFromEmacs: (struct frame *)f
{
- NSRect r, wr;
- Lisp_Object tem;
- EmacsWindow *win;
- NSColor *col;
- NSString *name;
-
NSTRACE ("[EmacsView initFrameFromEmacs:]");
NSTRACE_MSG ("cols:%d lines:%d", f->text_cols, f->text_lines);
@@ -7407,21 +7109,11 @@ not_in_argv (NSString *arg)
nonfs_window = nil;
ns_userRect = NSMakeRect (0, 0, 0, 0);
- r = NSMakeRect (0, 0, FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols),
- FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines));
- [self initWithFrame: r];
+ [self initWithFrame:
+ NSMakeRect (0, 0, FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols),
+ FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines))];
[self setAutoresizingMask: NSViewWidthSizable | NSViewHeightSizable];
-#ifdef NS_DRAW_TO_BUFFER
- /* These settings mean AppKit will retain the contents of the frame
- on resize. Unfortunately it also means the frame will not be
- automatically marked for display, but we can do that ourselves in
- viewDidResize. */
- [self setLayerContentsRedrawPolicy:
- NSViewLayerContentsRedrawOnSetNeedsDisplay];
- [self setLayerContentsPlacement:NSViewLayerContentsPlacementTopLeft];
-#endif
-
FRAME_NS_VIEW (f) = self;
emacsframe = f;
#ifdef NS_IMPL_COCOA
@@ -7429,100 +7121,22 @@ not_in_argv (NSString *arg)
maximizing_resize = NO;
#endif
- win = [[EmacsWindow alloc]
- initWithContentRect: r
- styleMask: (FRAME_UNDECORATED (f)
- ? FRAME_UNDECORATED_FLAGS
- : FRAME_DECORATED_FLAGS)
- backing: NSBackingStoreBuffered
- defer: YES];
-
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
- if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_7)
-#endif
- if (FRAME_PARENT_FRAME (f))
- [win
setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary];
- else
- [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary];
-#endif
-
- wr = [win frame];
- bwidth = f->border_width = wr.size.width - r.size.width;
+ [[EmacsWindow alloc] initWithEmacsFrame:f];
- [win setAcceptsMouseMovedEvents: YES];
- [win setDelegate: self];
-#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090
-#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
- if ([win respondsToSelector: @selector(useOptimizedDrawing:)])
-#endif
- [win useOptimizedDrawing: YES];
+#ifdef NS_IMPL_COCOA
+ /* These settings mean AppKit will retain the contents of the frame
+ on resize. Unfortunately it also means the frame will not be
+ automatically marked for display, but we can do that ourselves in
+ resizeWithOldSuperviewSize. */
+ [self setWantsLayer:YES];
+ [self setLayerContentsRedrawPolicy:
+ NSViewLayerContentsRedrawOnSetNeedsDisplay];
+ [self setLayerContentsPlacement:NSViewLayerContentsPlacementTopLeft];
#endif
- [[win contentView] addSubview: self];
-
if (ns_drag_types)
[self registerForDraggedTypes: ns_drag_types];
- tem = f->name;
- name = NILP (tem) ? @"Emacs" : [NSString stringWithLispString:tem];
- [win setTitle: name];
-
- /* toolbar support */
- if (! FRAME_UNDECORATED (f))
- [self createToolbar: f];
-
-
- [win setAppearance];
-
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
- if ([win respondsToSelector: @selector(titlebarAppearsTransparent)])
- win.titlebarAppearsTransparent = FRAME_NS_TRANSPARENT_TITLEBAR (f);
-#endif
-
- tem = f->icon_name;
- if (!NILP (tem))
- [win setMiniwindowTitle:
- [NSString stringWithLispString:tem]];
-
- if (FRAME_PARENT_FRAME (f) != NULL)
- {
- NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window];
- [parent addChildWindow: win
- ordered: NSWindowAbove];
- }
-
- if (FRAME_Z_GROUP (f) != z_group_none)
- win.level = NSNormalWindowLevel
- + (FRAME_Z_GROUP_BELOW (f) ? -1 : 1);
-
- {
- NSScreen *screen = [win screen];
-
- if (screen != 0)
- {
- NSPoint pt = NSMakePoint
- (IN_BOUND (-SCREENMAX, f->left_pos
- + NS_PARENT_WINDOW_LEFT_POS (f), SCREENMAX),
- IN_BOUND (-SCREENMAX,
- NS_PARENT_WINDOW_TOP_POS (f) - f->top_pos,
- SCREENMAX));
-
- [win setFrameTopLeftPoint: pt];
-
- NSTRACE_RECT ("new frame", [win frame]);
- }
- }
-
- [win makeFirstResponder: self];
-
- col = ns_lookup_indexed_color (NS_FACE_BACKGROUND
- (FACE_FROM_ID (emacsframe, DEFAULT_FACE_ID)),
- emacsframe);
- [win setBackgroundColor: col];
- if ([col alphaComponent] != (EmacsCGFloat) 1.0)
- [win setOpaque: NO];
-
#if !defined (NS_IMPL_COCOA) \
|| MAC_OS_X_VERSION_MIN_REQUIRED <= 1090
#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
@@ -7533,21 +7147,6 @@ not_in_argv (NSString *arg)
[NSApp registerServicesMenuSendTypes: ns_send_types
returnTypes: [NSArray array]];
- /* Set up view resize notifications. */
- [self setPostsFrameChangedNotifications:YES];
- [[NSNotificationCenter defaultCenter]
- addObserver:self
- selector:@selector (viewDidResize:)
- name:NSViewFrameDidChangeNotification object:nil];
-
- /* macOS Sierra automatically enables tabbed windows. We can't
- allow this to be enabled until it's available on a Free system.
- Currently it only happens by accident and is buggy anyway. */
-#ifdef NS_IMPL_COCOA
- if ([win respondsToSelector: @selector(setTabbingMode:)])
- [win setTabbingMode: NSWindowTabbingModeDisallowed];
-#endif
-
ns_window_num++;
return self;
}
@@ -7817,7 +7416,7 @@ not_in_argv (NSString *arg)
[NSApp setPresentationOptions: options];
}
#endif
- [toolbar setVisible:tbar_visible];
+ [[[self window]toolbar] setVisible:tbar_visible];
}
}
@@ -7860,12 +7459,12 @@ not_in_argv (NSString *arg)
#endif
if (FRAME_EXTERNAL_TOOL_BAR (emacsframe))
{
- [toolbar setVisible:YES];
+ [[[self window] toolbar] setVisible:YES];
update_frame_tool_bar (emacsframe);
[[self window] display];
}
else
- [toolbar setVisible:NO];
+ [[[self window] toolbar] setVisible:NO];
if (next_maximized != -1)
[[self window] performZoom:self];
@@ -7910,7 +7509,7 @@ not_in_argv (NSString *arg)
NSWindowCollectionBehavior b = [win collectionBehavior];
if (ns_use_native_fullscreen)
{
- if ([win parentWindow])
+ if (FRAME_PARENT_FRAME (emacsframe))
{
b &= ~NSWindowCollectionBehaviorFullScreenPrimary;
b |= NSWindowCollectionBehaviorFullScreenAuxiliary;
@@ -7937,7 +7536,7 @@ not_in_argv (NSString *arg)
- (void)toggleFullScreen: (id)sender
{
- NSWindow *w, *fw;
+ EmacsWindow *w, *fw;
BOOL onFirstScreen;
struct frame *f;
NSRect r, wr;
@@ -7956,7 +7555,7 @@ not_in_argv (NSString *arg)
return;
}
- w = [self window];
+ w = (EmacsWindow *)[self window];
onFirstScreen = [[w screen] isEqual:[[NSScreen screens] objectAtIndex:0]];
f = emacsframe;
wr = [w frame];
@@ -7991,27 +7590,9 @@ not_in_argv (NSString *arg)
#endif
}
- fw = [[EmacsFSWindow alloc]
- initWithContentRect:[w contentRectForFrameRect:wr]
- styleMask:NSWindowStyleMaskBorderless
- backing:NSBackingStoreBuffered
- defer:YES
- screen:screen];
-
- [fw setContentView:[w contentView]];
- [fw setTitle:[w title]];
- [fw setDelegate:self];
- [fw setAcceptsMouseMovedEvents: YES];
-#if !defined (NS_IMPL_COCOA) \
- || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090
-#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
- if ([fw respondsToSelector: @selector(useOptimizedDrawing:)])
-#endif
- [fw useOptimizedDrawing: YES];
-#endif
- [fw setBackgroundColor: col];
- if ([col alphaComponent] != (EmacsCGFloat) 1.0)
- [fw setOpaque: NO];
+ fw = [[EmacsWindow alloc] initWithEmacsFrame:emacsframe
+ fullscreen:YES
+ screen:screen];
f->border_width = 0;
@@ -8019,7 +7600,6 @@ not_in_argv (NSString *arg)
[self windowWillEnterFullScreen];
[fw makeKeyAndOrderFront:NSApp];
- [fw makeFirstResponder:self];
[w orderOut:self];
r = [fw frameRectForContentRect:[screen frame]];
[fw setFrame: r display:YES animate:ns_use_fullscreen_animation];
@@ -8046,7 +7626,7 @@ not_in_argv (NSString *arg)
if ([col alphaComponent] != (EmacsCGFloat) 1.0)
[w setOpaque: NO];
- f->border_width = bwidth;
+ f->border_width = [w borderWidth];
// To do: consider using [NSNotificationCenter postNotificationName:] to
// send notifications.
@@ -8183,12 +7763,6 @@ not_in_argv (NSString *arg)
}
-- (EmacsToolbar *)toolbar
-{
- return toolbar;
-}
-
-
/* This gets called on toolbar button click. */
- (instancetype)toolbarClicked: (id)item
{
@@ -8225,44 +7799,54 @@ not_in_argv (NSString *arg)
}
-#ifdef NS_DRAW_TO_BUFFER
-- (void)focusOnDrawingBuffer
+#ifdef NS_IMPL_COCOA
+- (CALayer *)makeBackingLayer;
{
- CGFloat scale = [[self window] backingScaleFactor];
-
- NSTRACE ("[EmacsView focusOnDrawingBuffer]");
+ EmacsLayer *l = [[EmacsLayer alloc]
+ initWithColorSpace:[[[self window] colorSpace]
CGColorSpace]];
+ [l setDelegate:(id)self];
+ [l setContentsScale:[[self window] backingScaleFactor]];
- if (! surface)
- {
- NSRect frame = [self frame];
- NSSize s = NSMakeSize (NSWidth (frame) * scale, NSHeight (frame) *
scale);
+ return l;
+}
- surface = [[EmacsSurface alloc] initWithSize:s
- ColorSpace:[[[self window] colorSpace]
- CGColorSpace]
- Scale:scale];
- /* Since we're using NSViewLayerContentsRedrawOnSetNeedsDisplay
- the layer's scale factor is not set automatically, so do it
- now. */
- [[self layer] setContentsScale:scale];
- }
+- (void)lockFocus
+{
+ NSTRACE ("[EmacsView lockFocus]");
- CGContextRef context = [surface getContext];
+ if ([self wantsLayer])
+ {
+ CGContextRef context = [(EmacsLayer*)[self layer] getContext];
- [NSGraphicsContext
- setCurrentContext:[NSGraphicsContext
- graphicsContextWithCGContext:context
- flipped:YES]];
+ [NSGraphicsContext
+ setCurrentContext:[NSGraphicsContext
+ graphicsContextWithCGContext:context
+ flipped:YES]];
+ }
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ else
+ [super lockFocus];
+#endif
}
-- (void)unfocusDrawingBuffer
+- (void)unlockFocus
{
- NSTRACE ("[EmacsView unfocusDrawingBuffer]");
+ NSTRACE ("[EmacsView unlockFocus]");
- [NSGraphicsContext setCurrentContext:nil];
- [self setNeedsDisplay:YES];
+ if ([self wantsLayer])
+ {
+ [NSGraphicsContext setCurrentContext:nil];
+ [self setNeedsDisplay:YES];
+ }
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ else
+ {
+ [super unlockFocus];
+ [super flushWindow];
+ }
+#endif
}
@@ -8271,18 +7855,19 @@ not_in_argv (NSString *arg)
{
NSTRACE ("EmacsView windowDidChangeBackingProperties:]");
- if ([self wantsUpdateLayer])
+ if ([self wantsLayer])
{
NSRect frame = [self frame];
+ EmacsLayer *layer = (EmacsLayer *)[self layer];
- [surface release];
- surface = nil;
+ [layer setContentsScale:[[notification object] backingScaleFactor]];
+ [layer setColorSpace:[[[notification object] colorSpace] CGColorSpace]];
ns_clear_frame (emacsframe);
expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
}
}
-#endif /* NS_DRAW_TO_BUFFER */
+#endif /* NS_IMPL_COCOA */
- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect
@@ -8291,11 +7876,9 @@ not_in_argv (NSString *arg)
NSTRACE_RECT ("Source", srcRect);
NSTRACE_RECT ("Destination", dstRect);
-#ifdef NS_DRAW_TO_BUFFER
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([self wantsUpdateLayer])
+#ifdef NS_IMPL_COCOA
+ if ([self wantsLayer])
{
-#endif
double scale = [[self window] backingScaleFactor];
CGContextRef context = [[NSGraphicsContext currentContext] CGContext];
int bpp = CGBitmapContextGetBitsPerPixel (context) / 8;
@@ -8321,14 +7904,14 @@ not_in_argv (NSString *arg)
(char *) srcPixels + y * rowSize,
srcRowSize);
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
else
{
#endif
-#endif /* NS_DRAW_TO_BUFFER */
+#endif /* NS_IMPL_COCOA */
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
hide_bell(); // Ensure the bell image isn't scrolled.
ns_focus (emacsframe, &dstRect, 1);
@@ -8337,22 +7920,26 @@ not_in_argv (NSString *arg)
dstRect.origin.y - srcRect.origin.y)];
ns_unfocus (emacsframe);
#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
#endif
}
-#ifdef NS_DRAW_TO_BUFFER
+#ifdef NS_IMPL_COCOA
/* If the frame has been garbaged but the toolkit wants to draw, for
example when resizing the frame, we end up with a blank screen.
Sometimes this results in an unpleasant flicker, so try to
- redisplay before drawing. */
-- (void)viewWillDraw
+ redisplay before drawing.
+
+ This used to be done in viewWillDraw, but with the custom layer
+ that method is not called. We cannot call redisplay directly from
+ [NSView layout], because it may trigger another round of layout by
+ changing the frame size and recursive layout calls are banned. It
+ appears to be safe to call redisplay here. */
+- (void)layoutSublayersOfLayer:(CALayer *)layer
{
- if (FRAME_GARBAGED_P (emacsframe)
- && !redisplaying_p
- && [self wantsUpdateLayer])
+ if (!redisplaying_p && FRAME_GARBAGED_P (emacsframe))
{
/* If there is IO going on when redisplay is run here Emacs
crashes. I think it's because this code will always be run
@@ -8369,45 +7956,8 @@ not_in_argv (NSString *arg)
waiting_for_input = owfi;
}
}
-
-
-- (BOOL)wantsUpdateLayer
-{
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if (NSAppKitVersionNumber < 1671)
- return NO;
#endif
- /* Running on macOS 10.14 or above. */
- return YES;
-}
-
-
-- (void)updateLayer
-{
- NSTRACE ("[EmacsView updateLayer]");
-
- /* We run redisplay on frames that are garbaged, but marked for
- display, before updateLayer is called so if the frame is still
- garbaged that means the last redisplay must have refused to
- update the frame. */
- if (FRAME_GARBAGED_P (emacsframe))
- return;
-
- /* This can fail to update the screen if the same surface is
- provided twice in a row, even if its contents have changed.
- There's a private method, -[CALayer setContentsChanged], that we
- could use to force it, but we shouldn't often get the same
- surface twice in a row. */
- [surface releaseContext];
- [[self layer] setContents:(id)[surface getSurface]];
- [surface performSelectorOnMainThread:@selector (getContext)
- withObject:nil
- waitUntilDone:NO];
-}
-#endif
-
-
- (void)drawRect: (NSRect)rect
{
NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]",
@@ -8651,6 +8201,242 @@ not_in_argv (NSString *arg)
@implementation EmacsWindow
+
+- (instancetype) initWithEmacsFrame:(struct frame *)f
+{
+ return [self initWithEmacsFrame:f fullscreen:NO screen:nil];
+}
+
+
+- (instancetype) initWithEmacsFrame:(struct frame *)f
+ fullscreen:(BOOL)fullscreen
+ screen:(NSScreen *)screen
+{
+ NSWindowStyleMask styleMask;
+
+ NSTRACE ("[EmacsWindow initWithEmacsFrame:fullscreen:screen:]");
+
+ if (fullscreen)
+ styleMask = NSWindowStyleMaskBorderless;
+ else if (FRAME_UNDECORATED (f))
+ styleMask = FRAME_UNDECORATED_FLAGS;
+ else
+ styleMask = FRAME_DECORATED_FLAGS;
+
+
+ self = [super initWithContentRect:
+ NSMakeRect (0, 0,
+ FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols),
+ FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f,
f->text_lines))
+ styleMask:styleMask
+ backing:NSBackingStoreBuffered
+ defer:YES
+ screen:screen];
+ if (self)
+ {
+ NSString *name;
+ NSColor *col;
+ NSScreen *screen = [self screen];
+ EmacsView *view = FRAME_NS_VIEW (f);
+
+ [self setDelegate:view];
+ [[self contentView] addSubview:view];
+ [self makeFirstResponder:view];
+
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090
+#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
+ if ([self respondsToSelector: @selector(useOptimizedDrawing:)])
+#endif
+ [self useOptimizedDrawing:YES];
+#endif
+
+ [self setAcceptsMouseMovedEvents:YES];
+
+ name = NILP (f->name) ? @"Emacs" : [NSString
stringWithLispString:f->name];
+ [self setTitle:name];
+
+ if (!NILP (f->icon_name))
+ [self setMiniwindowTitle:
+ [NSString stringWithLispString:f->icon_name]];
+
+ [self setAppearance];
+
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
+ if ([self respondsToSelector:@selector(titlebarAppearsTransparent)])
+ [self setTitlebarAppearsTransparent:FRAME_NS_TRANSPARENT_TITLEBAR (f)];
+#endif
+
+ [self setParentChildRelationships];
+
+ if (FRAME_Z_GROUP (f) != z_group_none)
+ [self setLevel:NSNormalWindowLevel + (FRAME_Z_GROUP_BELOW (f) ? -1 :
1)];
+
+ if (screen != 0)
+ {
+ NSPoint pt = NSMakePoint
+ (IN_BOUND (-SCREENMAX, f->left_pos
+ + NS_PARENT_WINDOW_LEFT_POS (f), SCREENMAX),
+ IN_BOUND (-SCREENMAX,
+ NS_PARENT_WINDOW_TOP_POS (f) - f->top_pos,
+ SCREENMAX));
+
+ [self setFrameTopLeftPoint:pt];
+
+ NSTRACE_RECT ("new frame", [self frame]);
+ }
+
+ f->border_width = [self borderWidth];
+
+ col = ns_lookup_indexed_color (NS_FACE_BACKGROUND
+ (FACE_FROM_ID (f, DEFAULT_FACE_ID)),
+ f);
+ [self setBackgroundColor:col];
+ if ([col alphaComponent] != (EmacsCGFloat) 1.0)
+ [self setOpaque:NO];
+
+ /* toolbar support */
+ if (! FRAME_UNDECORATED (f))
+ [self createToolbar:f];
+
+ /* macOS Sierra automatically enables tabbed windows. We can't
+ allow this to be enabled until it's available on a Free system.
+ Currently it only happens by accident and is buggy anyway. */
+#ifdef NS_IMPL_COCOA
+ if ([self respondsToSelector:@selector(setTabbingMode:)])
+ [self setTabbingMode:NSWindowTabbingModeDisallowed];
+#endif
+ }
+
+ return self;
+}
+
+
+- (void)createToolbar: (struct frame *)f
+{
+ EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
+
+ EmacsToolbar *toolbar = [[EmacsToolbar alloc]
+ initForView:view
+ withIdentifier:[NSString
stringWithLispString:f->name]];
+ [self setToolbar:toolbar];
+
+ update_frame_tool_bar (f);
+
+#ifdef NS_IMPL_COCOA
+ {
+ NSButton *toggleButton;
+ toggleButton = [self standardWindowButton:NSWindowToolbarButton];
+ [toggleButton setTarget:view];
+ [toggleButton setAction:@selector (toggleToolbar:)];
+ }
+#endif
+}
+
+- (void)dealloc
+{
+ NSTRACE ("[EmacsWindow dealloc]");
+
+ /* We need to release the toolbar ourselves. */
+ [[self toolbar] release];
+ [super dealloc];
+}
+
+- (NSInteger) borderWidth
+{
+ return NSWidth ([self frame]) - NSWidth ([[self contentView] frame]);
+}
+
+
+- (void)setParentChildRelationships
+ /* After certain operations, for example making a frame visible or
+ resetting the NSWindow through modifying the undecorated status,
+ the parent/child relationship may be broken. We can also use
+ this method to set them, as long as the frame struct already has
+ the correct relationship set. */
+{
+ NSTRACE ("[EmacsWindow setParentChildRelationships]");
+
+ Lisp_Object frame, tail;
+ EmacsView *ourView = (EmacsView *)[self delegate];
+ struct frame *ourFrame = ourView->emacsframe;
+ struct frame *parentFrame = FRAME_PARENT_FRAME (ourFrame);
+ EmacsWindow *oldParentWindow = (EmacsWindow *)[self parentWindow];
+
+
+#ifdef NS_IMPL_COCOA
+ /* We have to set the accesibility subroles and/or the collection
+ behaviors early otherwise child windows may not go fullscreen as
+ expected later. */
+
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000
+ if ([child respondsToSelector:@selector(setAccessibilitySubrole:)])
+#endif
+ /* Set the accessibilty subroles. */
+ if (parentFrame)
+ [self setAccessibilitySubrole:NSAccessibilityFloatingWindowSubrole];
+ else
+ [self setAccessibilitySubrole:NSAccessibilityStandardWindowSubrole];
+
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+ [ourView updateCollectionBehavior];
+#endif
+#endif
+
+
+ /* Check if we have an incorrectly set parent. */
+ if ((! parentFrame && oldParentWindow)
+ || (parentFrame && oldParentWindow
+ && ((EmacsView *)[oldParentWindow delegate])->emacsframe !=
parentFrame))
+ {
+ [[self parentWindow] removeChildWindow:self];
+
+#ifdef NS_IMPL_COCOA
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if ([ourView respondsToSelector:@selector (toggleFullScreen)]
+#endif
+ /* If we are the descendent of a fullscreen window and we
+ have no new parent, go fullscreen. */
+ {
+ NSWindow *parent = (NSWindow *)oldParentWindow;
+ while (parent)
+ {
+ if (([parent styleMask] & NSWindowStyleMaskFullScreen) != 0)
+ {
+ [ourView toggleFullScreen:self];
+ break;
+ }
+ parent = [parent parentWindow];
+ }
+ }
+#endif
+ }
+
+ if (parentFrame)
+ {
+ NSWindow *parentWindow = [FRAME_NS_VIEW (parentFrame) window];
+
+#ifdef NS_IMPL_COCOA
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if ([ourView respondsToSelector:@selector (toggleFullScreen)]
+#endif
+ /* Child frames must not be fullscreen. */
+ if ([ourView fsIsNative] && [ourView isFullscreen])
+ [ourView toggleFullScreen:self];
+#endif
+
+ [parentWindow addChildWindow:self
+ ordered:NSWindowAbove];
+ }
+
+ /* Check our child windows are configured correctly. */
+ FOR_EACH_FRAME (tail, frame)
+ {
+ if (FRAME_PARENT_FRAME (XFRAME (frame)) == ourFrame)
+ [(EmacsWindow *)[FRAME_NS_VIEW (XFRAME (frame)) window]
setParentChildRelationships];
+ }
+}
+
+
/* It seems the only way to reorder child frames is by removing them
from the parent and then reattaching them in the correct order. */
@@ -9060,22 +8846,15 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
{
return !FRAME_NO_ACCEPT_FOCUS (((EmacsView *)[self delegate])->emacsframe);
}
-@end /* EmacsWindow */
-
-
-@implementation EmacsFSWindow
-
-- (BOOL)canBecomeKeyWindow
-{
- return YES;
-}
- (BOOL)canBecomeMainWindow
+ /* Required for fullscreen and undecorated windows. */
{
return YES;
}
-@end
+@end /* EmacsWindow */
+
/* ==========================================================================
@@ -9574,7 +9353,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
@end /* EmacsScroller */
-#ifdef NS_DRAW_TO_BUFFER
+#ifdef NS_IMPL_COCOA
/* ==========================================================================
@@ -9582,7 +9361,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
==========================================================================
*/
-@implementation EmacsSurface
+@implementation EmacsLayer
/* An IOSurface is a pixel buffer that is efficiently copied to VRAM
@@ -9595,80 +9374,106 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
ability to draw to the screen at any time, we need to keep a cache
of multiple surfaces that we can use at will.
- The EmacsSurface class maintains this cache of surfaces, and
+ The EmacsLayer class maintains this cache of surfaces, and
handles the conversion to a CGGraphicsContext that AppKit can use
to draw on.
The cache is simple: if a free surface is found it is removed from
- the cache and set as the "current" surface. Once Emacs is done
- with drawing to the current surface, the previous surface that was
- drawn to is added to the cache for reuse, and the current one is
- set as the last surface. If no free surfaces are found in the
- cache then a new one is created.
-
- When AppKit wants to update the screen, we provide it with the last
- surface, as that has the most recent data.
-
- FIXME: It is possible for the cache to grow if Emacs draws faster
- than the surfaces can be drawn to the screen, so there should
- probably be some sort of pruning job that removes excess
- surfaces. */
+ the cache and set as the "current" surface. Emacs draws to the
+ surface and when the layer wants to update the screen we set it's
+ contents to the surface and then add it back on to the end of the
+ cache. If no free surfaces are found in the cache then a new one
+ is created. */
#define CACHE_MAX_SIZE 2
-- (id) initWithSize: (NSSize)s
- ColorSpace: (CGColorSpaceRef)cs
- Scale: (CGFloat)scl
+- (id) initWithColorSpace: (CGColorSpaceRef)cs
{
- NSTRACE ("[EmacsSurface initWithSize:ColorSpace:]");
+ NSTRACE ("[EmacsLayer initWithColorSpace:]");
- [super init];
-
- cache = [[NSMutableArray arrayWithCapacity:CACHE_MAX_SIZE] retain];
- size = s;
- colorSpace = cs;
- scale = scl;
+ self = [super init];
+ if (self)
+ {
+ cache = [[NSMutableArray arrayWithCapacity:CACHE_MAX_SIZE] retain];
+ colorSpace = cs;
+ }
+ else
+ {
+ return nil;
+ }
return self;
}
-- (void) dealloc
+- (void) setColorSpace: (CGColorSpaceRef)cs
{
- if (context)
- CGContextRelease (context);
-
- if (currentSurface)
- CFRelease (currentSurface);
+ /* We don't need to clear the cache because the new colorspace will
+ be used next time we create a new context. */
+ colorSpace = cs;
+}
- for (id object in cache)
- CFRelease ((IOSurfaceRef)object);
+- (void) dealloc
+{
+ [self releaseSurfaces];
[cache release];
[super dealloc];
}
-/* Return the size values our cached data is using. */
-- (NSSize) getSize
+- (void) releaseSurfaces
{
- return size;
+ [self setContents:nil];
+ [self releaseContext];
+
+ if (currentSurface)
+ {
+ CFRelease (currentSurface);
+ currentSurface = nil;
+ }
+
+ if (cache)
+ {
+ for (id object in cache)
+ CFRelease ((IOSurfaceRef)object);
+
+ [cache removeAllObjects];
+ }
}
-/* Return a CGContextRef that can be used for drawing to the screen.
- This must ALWAYS be paired with a call to releaseContext, and the
- calls cannot be nested. */
+/* Check whether the current bounds match the IOSurfaces we are using.
+ If they do return YES, otherwise NO. */
+- (BOOL) checkDimensions
+{
+ int width = NSWidth ([self bounds]) * [self contentsScale];
+ int height = NSHeight ([self bounds]) * [self contentsScale];
+ IOSurfaceRef s = currentSurface ? currentSurface
+ : (IOSurfaceRef)[cache firstObject];
+
+ return !s || (IOSurfaceGetWidth (s) == width
+ && IOSurfaceGetHeight (s) == height);
+}
+
+
+/* Return a CGContextRef that can be used for drawing to the screen. */
- (CGContextRef) getContext
{
- NSTRACE ("[EmacsSurface getContext]");
+ CGFloat scale = [self contentsScale];
+
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer getContext]");
+ NSTRACE_MSG ("IOSurface count: %lu", [cache count] + (currentSurface ? 1 :
0));
+
+ if (![self checkDimensions])
+ [self releaseSurfaces];
if (!context)
{
IOSurfaceRef surface = NULL;
-
- NSTRACE_MSG ("IOSurface count: %lu", [cache count] + (lastSurface ? 1 :
0));
+ int width = NSWidth ([self bounds]) * scale;
+ int height = NSHeight ([self bounds]) * scale;
for (id object in cache)
{
@@ -9691,11 +9496,11 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
else if (!surface)
{
int bytesPerRow = IOSurfaceAlignProperty (kIOSurfaceBytesPerRow,
- size.width * 4);
+ width * 4);
surface = IOSurfaceCreate
- ((CFDictionaryRef)@{(id)kIOSurfaceWidth:[NSNumber
numberWithInt:size.width],
- (id)kIOSurfaceHeight:[NSNumber numberWithInt:size.height],
+ ((CFDictionaryRef)@{(id)kIOSurfaceWidth:[NSNumber
numberWithInt:width],
+ (id)kIOSurfaceHeight:[NSNumber numberWithInt:height],
(id)kIOSurfaceBytesPerRow:[NSNumber numberWithInt:bytesPerRow],
(id)kIOSurfaceBytesPerElement:[NSNumber numberWithInt:4],
(id)kIOSurfacePixelFormat:[NSNumber
numberWithUnsignedInt:'BGRA']});
@@ -9718,7 +9523,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
(kCGImageAlphaPremultipliedFirst
| kCGBitmapByteOrder32Host));
- CGContextTranslateCTM(context, 0, size.height);
+ CGContextTranslateCTM(context, 0, IOSurfaceGetHeight (currentSurface));
CGContextScaleCTM(context, scale, -scale);
}
@@ -9730,7 +9535,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
IOSurface, so it will be sent to VRAM. */
- (void) releaseContext
{
- NSTRACE ("[EmacsSurface releaseContextAndGetSurface]");
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer releaseContext]");
if (!context)
return;
@@ -9741,19 +9546,34 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
IOReturn lockStatus = IOSurfaceUnlock (currentSurface, 0, nil);
if (lockStatus != kIOReturnSuccess)
NSLog (@"Failed to unlock surface: %x", lockStatus);
-
- /* Put currentSurface back on the end of the cache. */
- [cache addObject:(id)currentSurface];
- lastSurface = currentSurface;
- currentSurface = NULL;
}
-/* Get the IOSurface that we want to draw to the screen. */
-- (IOSurfaceRef) getSurface
+- (void) display
{
- /* lastSurface always contains the most up-to-date and complete data. */
- return lastSurface;
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer display]");
+
+ if (context)
+ {
+ [self releaseContext];
+
+#if CACHE_MAX_SIZE == 1
+ /* This forces the layer to see the surface as updated. */
+ [self setContents:nil];
+#endif
+
+ [self setContents:(id)currentSurface];
+
+ /* Put currentSurface back on the end of the cache. */
+ [cache addObject:(id)currentSurface];
+ currentSurface = NULL;
+
+ /* Schedule a run of getContext so that if Emacs is idle it will
+ perform the buffer copy, etc. */
+ [self performSelectorOnMainThread:@selector (getContext)
+ withObject:nil
+ waitUntilDone:NO];
+ }
}
@@ -9763,19 +9583,20 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
- (void) copyContentsTo: (IOSurfaceRef) destination
{
IOReturn lockStatus;
+ IOSurfaceRef source = (IOSurfaceRef)[self contents];
void *sourceData, *destinationData;
int numBytes = IOSurfaceGetAllocSize (destination);
- NSTRACE ("[EmacsSurface copyContentsTo:]");
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer copyContentsTo:]");
- if (!lastSurface || lastSurface == destination)
+ if (!source || source == destination)
return;
- lockStatus = IOSurfaceLock (lastSurface, kIOSurfaceLockReadOnly, nil);
+ lockStatus = IOSurfaceLock (source, kIOSurfaceLockReadOnly, nil);
if (lockStatus != kIOReturnSuccess)
NSLog (@"Failed to lock source surface: %x", lockStatus);
- sourceData = IOSurfaceGetBaseAddress (lastSurface);
+ sourceData = IOSurfaceGetBaseAddress (source);
destinationData = IOSurfaceGetBaseAddress (destination);
/* Since every IOSurface should have the exact same settings, a
@@ -9783,17 +9604,17 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
the other. */
memcpy (destinationData, sourceData, numBytes);
- lockStatus = IOSurfaceUnlock (lastSurface, kIOSurfaceLockReadOnly, nil);
+ lockStatus = IOSurfaceUnlock (source, kIOSurfaceLockReadOnly, nil);
if (lockStatus != kIOReturnSuccess)
NSLog (@"Failed to unlock source surface: %x", lockStatus);
}
#undef CACHE_MAX_SIZE
-@end /* EmacsSurface */
+@end /* EmacsLayer */
-#endif
+#endif /* NS_IMPL_COCOA */
#ifdef NS_IMPL_GNUSTEP
diff --git a/src/process.c b/src/process.c
index c354f3a..c3186ee 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1755,7 +1755,7 @@ usage: (make-process &rest ARGS) */)
buffer's current directory, or its unhandled equivalent. We
can't just have the child check for an error when it does the
chdir, since it's in a vfork. */
- current_dir = encode_current_directory ();
+ current_dir = get_current_directory (true);
name = Fplist_get (contact, QCname);
CHECK_STRING (name);
@@ -5232,7 +5232,10 @@ wait_reading_process_output (intmax_t time_limit, int
nsecs, int read_kbd,
#ifdef HAVE_GNUTLS
/* Continue TLS negotiation. */
if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED
- && p->is_non_blocking_client)
+ && p->is_non_blocking_client
+ /* Don't proceed until we have established a connection. */
+ && !(fd_callback_info[p->outfd].flags
+ & NON_BLOCKING_CONNECT_FD))
{
gnutls_try_handshake (p);
p->gnutls_handshakes_tried++;
diff --git a/src/process.h b/src/process.h
index 0890f25..4a25d13 100644
--- a/src/process.h
+++ b/src/process.h
@@ -264,7 +264,7 @@ enum
/* Defined in callproc.c. */
-extern Lisp_Object encode_current_directory (void);
+extern Lisp_Object get_current_directory (bool);
extern void record_kill_process (struct Lisp_Process *, Lisp_Object);
/* Defined in sysdep.c. */
diff --git a/src/search.c b/src/search.c
index df384e1..14adeb5 100644
--- a/src/search.c
+++ b/src/search.c
@@ -30,6 +30,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "blockinput.h"
#include "intervals.h"
#include "pdumper.h"
+#include "composite.h"
#include "regex-emacs.h"
@@ -2725,7 +2726,7 @@ since only regular expressions have distinguished
subexpressions. */)
newpoint = sub_start + SCHARS (newtext);
/* Replace the old text with the new in the cleanest possible way. */
- replace_range (sub_start, sub_end, newtext, 1, 0, 1, true);
+ replace_range (sub_start, sub_end, newtext, 1, 0, 1, true, true);
if (case_action == all_caps)
Fupcase_region (make_fixnum (search_regs.start[sub]),
@@ -2750,6 +2751,9 @@ since only regular expressions have distinguished
subexpressions. */)
/* Now move point "officially" to the end of the inserted replacement. */
move_if_not_intangible (newpoint);
+ signal_after_change (sub_start, sub_end - sub_start, SCHARS (newtext));
+ update_compositions (sub_start, newpoint, CHECK_BORDER);
+
return Qnil;
}
diff --git a/src/sysdep.c b/src/sysdep.c
index 51d8b5e..8eaee22 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -657,7 +657,7 @@ sys_subshell (void)
#endif
pid_t pid;
struct save_signal saved_handlers[5];
- char *str = SSDATA (encode_current_directory ());
+ char *str = SSDATA (get_current_directory (true));
#ifdef DOS_NT
pid = 0;
@@ -2744,6 +2744,138 @@ cfsetspeed (struct termios *termios_p, speed_t vitesse)
}
#endif
+/* The following is based on the glibc implementation of cfsetspeed. */
+
+struct speed_struct
+{
+ speed_t value;
+ speed_t internal;
+};
+
+static const struct speed_struct speeds[] =
+ {
+#ifdef B0
+ { 0, B0 },
+#endif
+#ifdef B50
+ { 50, B50 },
+#endif
+#ifdef B75
+ { 75, B75 },
+#endif
+#ifdef B110
+ { 110, B110 },
+#endif
+#ifdef B134
+ { 134, B134 },
+#endif
+#ifdef B150
+ { 150, B150 },
+#endif
+#ifdef B200
+ { 200, B200 },
+#endif
+#ifdef B300
+ { 300, B300 },
+#endif
+#ifdef B600
+ { 600, B600 },
+#endif
+#ifdef B1200
+ { 1200, B1200 },
+#endif
+#ifdef B1200
+ { 1200, B1200 },
+#endif
+#ifdef B1800
+ { 1800, B1800 },
+#endif
+#ifdef B2400
+ { 2400, B2400 },
+#endif
+#ifdef B4800
+ { 4800, B4800 },
+#endif
+#ifdef B9600
+ { 9600, B9600 },
+#endif
+#ifdef B19200
+ { 19200, B19200 },
+#endif
+#ifdef B38400
+ { 38400, B38400 },
+#endif
+#ifdef B57600
+ { 57600, B57600 },
+#endif
+#ifdef B76800
+ { 76800, B76800 },
+#endif
+#ifdef B115200
+ { 115200, B115200 },
+#endif
+#ifdef B153600
+ { 153600, B153600 },
+#endif
+#ifdef B230400
+ { 230400, B230400 },
+#endif
+#ifdef B307200
+ { 307200, B307200 },
+#endif
+#ifdef B460800
+ { 460800, B460800 },
+#endif
+#ifdef B500000
+ { 500000, B500000 },
+#endif
+#ifdef B576000
+ { 576000, B576000 },
+#endif
+#ifdef B921600
+ { 921600, B921600 },
+#endif
+#ifdef B1000000
+ { 1000000, B1000000 },
+#endif
+#ifdef B1152000
+ { 1152000, B1152000 },
+#endif
+#ifdef B1500000
+ { 1500000, B1500000 },
+#endif
+#ifdef B2000000
+ { 2000000, B2000000 },
+#endif
+#ifdef B2500000
+ { 2500000, B2500000 },
+#endif
+#ifdef B3000000
+ { 3000000, B3000000 },
+#endif
+#ifdef B3500000
+ { 3500000, B3500000 },
+#endif
+#ifdef B4000000
+ { 4000000, B4000000 },
+#endif
+ };
+
+/* Convert a numerical speed (e.g., 9600) to a Bnnn constant (e.g.,
+ B9600); see bug#49524. */
+static speed_t
+convert_speed (speed_t speed)
+{
+ for (size_t i = 0; i < sizeof speeds / sizeof speeds[0]; i++)
+ {
+ if (speed == speeds[i].internal)
+ return speed;
+ else if (speed == speeds[i].value)
+ return speeds[i].internal;
+ }
+ return speed;
+}
+
/* For serial-process-configure */
void
serial_configure (struct Lisp_Process *p,
@@ -2775,7 +2907,7 @@ serial_configure (struct Lisp_Process *p,
else
tem = Fplist_get (p->childp, QCspeed);
CHECK_FIXNUM (tem);
- err = cfsetspeed (&attr, XFIXNUM (tem));
+ err = cfsetspeed (&attr, convert_speed (XFIXNUM (tem)));
if (err != 0)
report_file_error ("Failed cfsetspeed", tem);
childp2 = Fplist_put (childp2, QCspeed, tem);
diff --git a/src/thread.c b/src/thread.c
index f74f611..714b1cd 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -28,6 +28,10 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "pdumper.h"
#include "keyboard.h"
+#ifdef HAVE_NS
+#include "nsterm.h"
+#endif
+
#if defined HAVE_GLIB && ! defined (HAVE_NS)
#include <xgselect.h>
#else
@@ -735,6 +739,15 @@ run_thread (void *state)
struct thread_state *self = state;
struct thread_state **iter;
+#ifdef HAVE_NS
+ /* Allocate an autorelease pool in case this thread calls any
+ Objective C code.
+
+ FIXME: In long running threads we may want to drain the pool
+ regularly instead of just at the end. */
+ void *pool = ns_alloc_autorelease_pool ();
+#endif
+
self->m_stack_bottom = self->stack_top = &stack_pos.c;
self->thread_id = sys_thread_self ();
@@ -777,6 +790,10 @@ run_thread (void *state)
current_thread = NULL;
sys_cond_broadcast (&self->thread_condvar);
+#ifdef HAVE_NS
+ ns_release_autorelease_pool (pool);
+#endif
+
/* Unlink this thread from the list of all threads. Note that we
have to do this very late, after broadcasting our death.
Otherwise the GC may decide to reap the thread_state object,
diff --git a/src/window.c b/src/window.c
index db324ef..a6e8ee0 100644
--- a/src/window.c
+++ b/src/window.c
@@ -1723,14 +1723,16 @@ have been if redisplay had finished, do this:
DEFUN ("window-end", Fwindow_end, Swindow_end, 0, 2, 0,
doc: /* Return position at which display currently ends in WINDOW.
-WINDOW must be a live window and defaults to the selected one.
-This is updated by redisplay, when it runs to completion.
-Simply changing the buffer text or setting `window-start'
-does not update this value.
+This is the position after the final character in WINDOW.
+
+WINDOW must be a live window and defaults to the selected one. This
+is updated by redisplay, when it runs to completion. Simply changing
+the buffer text or setting `window-start' does not update this value.
+
Return nil if there is no recorded value. (This can happen if the
-last redisplay of WINDOW was preempted, and did not finish.)
-If UPDATE is non-nil, compute the up-to-date position
-if it isn't already recorded. */)
+last redisplay of WINDOW was preempted, and did not finish.) If
+UPDATE is non-nil, compute the up-to-date position if it isn't already
+recorded. */)
(Lisp_Object window, Lisp_Object update)
{
Lisp_Object value;
diff --git a/src/xdisp.c b/src/xdisp.c
index c30084c..e62f7e3 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -4557,11 +4557,13 @@ face_before_or_after_it_pos (struct it *it, bool
before_p)
ptrdiff_t bufpos, charpos;
int base_face_id;
- /* No face change past the end of the string (for the case
- we are padding with spaces). No face change before the
- string start. */
+ /* No face change past the end of the string (for the case we
+ are padding with spaces). No face change before the string
+ start. Ignore face changes before the first visible
+ character on this display line. */
if (IT_STRING_CHARPOS (*it) >= SCHARS (it->string)
- || (IT_STRING_CHARPOS (*it) == 0 && before_p))
+ || (IT_STRING_CHARPOS (*it) == 0 && before_p)
+ || it->current_x <= it->first_visible_x)
return it->face_id;
if (!it->bidi_p)
@@ -4580,51 +4582,47 @@ face_before_or_after_it_pos (struct it *it, bool
before_p)
}
else
{
- if (before_p)
- {
- /* With bidi iteration, the character before the current
- in the visual order cannot be found by simple
- iteration, because "reverse" reordering is not
- supported. Instead, we need to start from the string
- beginning and go all the way to the current string
- position, remembering the previous position. */
- /* Ignore face changes before the first visible
- character on this display line. */
- if (it->current_x <= it->first_visible_x)
- return it->face_id;
- SAVE_IT (it_copy, *it, it_copy_data);
- IT_STRING_CHARPOS (it_copy) = 0;
- bidi_init_it (0, 0, FRAME_WINDOW_P (it_copy.f), &it_copy.bidi_it);
-
- do
- {
- charpos = IT_STRING_CHARPOS (it_copy);
- if (charpos >= SCHARS (it->string))
- break;
- bidi_move_to_visually_next (&it_copy.bidi_it);
- }
- while (IT_STRING_CHARPOS (it_copy) != IT_STRING_CHARPOS (*it));
+ /* With bidi iteration, the character before the current in
+ the visual order cannot be found by simple iteration,
+ because "reverse" reordering is not supported. Instead,
+ we need to start from the string beginning and go all the
+ way to the current string position, remembering the
+ visually-previous position. We need to start from the
+ string beginning for the character after the current as
+ well, since the iterator state in IT may have been
+ pushed, and the bidi cache is no longer coherent with the
+ string's text. */
+ SAVE_IT (it_copy, *it, it_copy_data);
+ IT_STRING_CHARPOS (it_copy) = 0;
+ bidi_init_it (0, 0, FRAME_WINDOW_P (it_copy.f), &it_copy.bidi_it);
- RESTORE_IT (it, it, it_copy_data);
+ do
+ {
+ charpos = it_copy.bidi_it.charpos;
+ if (charpos >= SCHARS (it->string))
+ break;
+ bidi_move_to_visually_next (&it_copy.bidi_it);
}
- else
+ while (it_copy.bidi_it.charpos != IT_STRING_CHARPOS (*it));
+
+ if (!before_p)
{
/* Set charpos to the string position of the character
that comes after IT's current position in the visual
order. */
int n = (it->what == IT_COMPOSITION ? it->cmp_it.nchars : 1);
-
- it_copy = *it;
- /* If this is the first display element,
+ /* If this is the first string character,
bidi_move_to_visually_next will deliver character at
current position without moving, so we need to enlarge N. */
- if (it->bidi_it.first_elt)
+ if (it_copy.bidi_it.first_elt)
n++;
while (n--)
bidi_move_to_visually_next (&it_copy.bidi_it);
charpos = it_copy.bidi_it.charpos;
}
+
+ RESTORE_IT (it, it, it_copy_data);
}
eassert (0 <= charpos && charpos <= SCHARS (it->string));
@@ -15084,11 +15082,12 @@ hscroll_window_tree (Lisp_Object window)
else
{
if (hscroll_relative_p)
- wanted_x = text_area_width * hscroll_step_rel
- + h_margin;
+ wanted_x =
+ text_area_width * hscroll_step_rel + h_margin + x_offset;
else
- wanted_x = hscroll_step_abs * FRAME_COLUMN_WIDTH (it.f)
- + h_margin;
+ wanted_x =
+ hscroll_step_abs * FRAME_COLUMN_WIDTH (it.f)
+ + h_margin + x_offset;
hscroll
= max (0, it.current_x - wanted_x) / FRAME_COLUMN_WIDTH
(it.f);
}
@@ -22765,6 +22764,22 @@ get_it_property (struct it *it, Lisp_Object prop)
return Fget_char_property (position, prop, object);
}
+/* Return the line-prefix/wrap-prefix property, checking both the
+ current IT->OBJECT and the underlying buffer text. */
+
+static Lisp_Object
+get_line_prefix_it_property (struct it *it, Lisp_Object prop)
+{
+ Lisp_Object prefix = get_it_property (it, prop);
+
+ /* If we are looking at a display or overlay string, check also the
+ underlying buffer text. */
+ if (NILP (prefix) && it->sp > 0 && STRINGP (it->object))
+ return Fget_char_property (make_fixnum (IT_CHARPOS (*it)), prop,
+ it->w->contents);
+ return prefix;
+}
+
/* See if there's a line- or wrap-prefix, and if so, push it on IT. */
static void
@@ -22774,13 +22789,13 @@ handle_line_prefix (struct it *it)
if (it->continuation_lines_width > 0)
{
- prefix = get_it_property (it, Qwrap_prefix);
+ prefix = get_line_prefix_it_property (it, Qwrap_prefix);
if (NILP (prefix))
prefix = Vwrap_prefix;
}
else
{
- prefix = get_it_property (it, Qline_prefix);
+ prefix = get_line_prefix_it_property (it, Qline_prefix);
if (NILP (prefix))
prefix = Vline_prefix;
}
@@ -33236,7 +33251,8 @@ note_mode_line_or_margin_highlight (Lisp_Object window,
int x, int y,
of the mode line without any text (e.g. past the right edge of
the mode line text), use that windows's mode line help echo if it
has been set. */
- if (STRINGP (string) || area == ON_MODE_LINE)
+ if (STRINGP (string) || area == ON_MODE_LINE || area == ON_HEADER_LINE
+ || area == ON_TAB_LINE)
{
/* Arrange to display the help by setting the global variables
help_echo_string, help_echo_object, and help_echo_pos. */
@@ -33293,6 +33309,19 @@ note_mode_line_or_margin_highlight (Lisp_Object
window, int x, int y,
}
else if (draggable && area == ON_MODE_LINE)
cursor = FRAME_OUTPUT_DATA (f)->vertical_drag_cursor;
+ else if ((area == ON_MODE_LINE
+ && WINDOW_BOTTOMMOST_P (w)
+ && !FRAME_HAS_MINIBUF_P (f)
+ && !NILP (Fframe_parameter
+ (w->frame, Qdrag_with_mode_line)))
+ || (((area == ON_HEADER_LINE
+ && !NILP (Fframe_parameter
+ (w->frame, Qdrag_with_header_line)))
+ || (area == ON_TAB_LINE
+ && !NILP (Fframe_parameter
+ (w->frame, Qdrag_with_tab_line))))
+ && WINDOW_TOPMOST_P (w)))
+ cursor = FRAME_OUTPUT_DATA (f)->hand_cursor;
else
cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor;
}
@@ -34882,6 +34911,10 @@ be let-bound around code that needs to disable
messages temporarily. */);
DEFSYM (Qdragging, "dragging");
DEFSYM (Qdropping, "dropping");
+ DEFSYM (Qdrag_with_mode_line, "drag-with-mode-line");
+ DEFSYM (Qdrag_with_header_line, "drag-with-header-line");
+ DEFSYM (Qdrag_with_tab_line, "drag-with-tab-line");
+
DEFSYM (Qinhibit_free_realized_faces, "inhibit-free-realized-faces");
list_of_error = list1 (list2 (Qerror, Qvoid_variable));
diff --git a/src/xfaces.c b/src/xfaces.c
index fed7b333..207f0d6 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -95,9 +95,10 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
with the symbol `face' in slot 0, and a slot for each of the face
attributes mentioned above.
- There is also a global face alist `Vface_new_frame_defaults'. Face
- definitions from this list are used to initialize faces of newly
- created frames.
+ There is also a global face map `Vface_new_frame_defaults',
+ containing conses of (FACE_ID . FACE_DEFINITION). Face definitions
+ from this table are used to initialize faces of newly created
+ frames.
A face doesn't have to specify all attributes. Those not specified
have a value of `unspecified'. Faces specifying all attributes but
@@ -1965,13 +1966,11 @@ lface_from_face_name_no_resolve (struct frame *f,
Lisp_Object face_name,
Lisp_Object lface;
if (f)
- lface = assq_no_quit (face_name, f->face_alist);
+ lface = Fgethash (face_name, f->face_hash_table, Qnil);
else
- lface = assq_no_quit (face_name, Vface_new_frame_defaults);
+ lface = CDR (Fgethash (face_name, Vface_new_frame_defaults, Qnil));
- if (CONSP (lface))
- lface = XCDR (lface);
- else if (signal_p)
+ if (signal_p && NILP (lface))
signal_error ("Invalid face", face_name);
check_lface (lface);
@@ -2870,11 +2869,6 @@ Value is a vector of face attributes. */)
/* Add a global definition if there is none. */
if (NILP (global_lface))
{
- global_lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
- ASET (global_lface, 0, Qface);
- Vface_new_frame_defaults = Fcons (Fcons (face, global_lface),
- Vface_new_frame_defaults);
-
/* Assign the new Lisp face a unique ID. The mapping from Lisp
face id to Lisp face is given by the vector lface_id_to_name.
The mapping from Lisp face to Lisp face id is given by the
@@ -2884,9 +2878,14 @@ Value is a vector of face attributes. */)
xpalloc (lface_id_to_name, &lface_id_to_name_size, 1, MAX_FACE_ID,
sizeof *lface_id_to_name);
+ Lisp_Object face_id = make_fixnum (next_lface_id);
lface_id_to_name[next_lface_id] = face;
- Fput (face, Qface, make_fixnum (next_lface_id));
+ Fput (face, Qface, face_id);
++next_lface_id;
+
+ global_lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
+ ASET (global_lface, 0, Qface);
+ Fputhash (face, Fcons (face_id, global_lface), Vface_new_frame_defaults);
}
else if (f == NULL)
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
@@ -2899,7 +2898,7 @@ Value is a vector of face attributes. */)
{
lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
ASET (lface, 0, Qface);
- fset_face_alist (f, Fcons (Fcons (face, lface), f->face_alist));
+ Fputhash (face, lface, f->face_hash_table);
}
else
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
@@ -3060,7 +3059,7 @@ FRAME 0 means change the face on all frames, and change
the default
f = NULL;
lface = lface_from_face_name (NULL, face, true);
- /* When updating face-new-frame-defaults, we put :ignore-defface
+ /* When updating face--new-frame-defaults, we put :ignore-defface
where the caller wants `unspecified'. This forces the frame
defaults to ignore the defface value. Otherwise, the defface
will take effect, which is generally not what is intended.
@@ -3645,7 +3644,7 @@ update_face_from_frame_parameter (struct frame *f,
Lisp_Object param,
/* If there are no faces yet, give up. This is the case when called
from Fx_create_frame, and we do the necessary things later in
face-set-after-frame-defaults. */
- if (NILP (f->face_alist))
+ if (XFIXNAT (Fhash_table_count (f->face_hash_table)) == 0)
return;
if (EQ (param, Qforeground_color))
@@ -4311,14 +4310,13 @@ If FRAME is omitted or nil, use the selected frame. */)
return i == LFACE_VECTOR_SIZE ? Qt : Qnil;
}
-
-DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist,
+DEFUN ("frame--face-hash-table", Fframe_face_hash_table,
Sframe_face_hash_table,
0, 1, 0,
- doc: /* Return an alist of frame-local faces defined on FRAME.
+ doc: /* Return a hash table of frame-local faces defined on FRAME.
For internal use only. */)
(Lisp_Object frame)
{
- return decode_live_frame (frame)->face_alist;
+ return decode_live_frame (frame)->face_hash_table;
}
@@ -6835,30 +6833,32 @@ DEFUN ("show-face-resources", Fshow_face_resources,
Sshow_face_resources,
#ifdef HAVE_PDUMPER
/* All the faces defined during loadup are recorded in
- face-new-frame-defaults, with the last face first in the list. We
- need to set next_lface_id to the next face ID number, so that any
- new faces defined in this session will have face IDs different from
- those defined during loadup. We also need to set up the
- lface_id_to_name[] array for the faces that were defined during
- loadup. */
+ face-new-frame-defaults. We need to set next_lface_id to the next
+ face ID number, so that any new faces defined in this session will
+ have face IDs different from those defined during loadup. We also
+ need to set up the lface_id_to_name[] array for the faces that were
+ defined during loadup. */
void
init_xfaces (void)
{
- if (CONSP (Vface_new_frame_defaults))
+ int nfaces = XFIXNAT (Fhash_table_count (Vface_new_frame_defaults));
+ if (nfaces > 0)
{
/* Allocate the lface_id_to_name[] array. */
- lface_id_to_name_size = next_lface_id =
- XFIXNAT (Flength (Vface_new_frame_defaults));
+ lface_id_to_name_size = next_lface_id = nfaces;
lface_id_to_name = xnmalloc (next_lface_id, sizeof *lface_id_to_name);
/* Store the faces. */
- Lisp_Object tail;
- int i = next_lface_id - 1;
- for (tail = Vface_new_frame_defaults; CONSP (tail); tail = XCDR (tail))
+ struct Lisp_Hash_Table* table = XHASH_TABLE (Vface_new_frame_defaults);
+ for (ptrdiff_t idx = 0; idx < nfaces; ++idx)
{
- Lisp_Object lface = XCAR (tail);
- eassert (i >= 0);
- lface_id_to_name[i--] = XCAR (lface);
+ Lisp_Object lface = HASH_KEY (table, idx);
+ Lisp_Object face_id = CAR (HASH_VALUE (table, idx));
+ if (FIXNATP (face_id)) {
+ int id = XFIXNAT (face_id);
+ eassert (id >= 0);
+ lface_id_to_name[id] = lface;
+ }
}
}
face_attr_sym[0] = Qface;
@@ -7014,7 +7014,7 @@ syms_of_xfaces (void)
defsubr (&Sinternal_copy_lisp_face);
defsubr (&Sinternal_merge_in_global_face);
defsubr (&Sface_font);
- defsubr (&Sframe_face_alist);
+ defsubr (&Sframe_face_hash_table);
defsubr (&Sdisplay_supports_face_attributes_p);
defsubr (&Scolor_distance);
defsubr (&Sinternal_set_font_selection_order);
@@ -7038,9 +7038,12 @@ This variable is intended for use only by code that
evaluates
the "specifity" of a face specification and should be let-bound
only for this purpose. */);
- DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults,
- doc: /* List of global face definitions (for internal use only.) */);
- Vface_new_frame_defaults = Qnil;
+ DEFVAR_LISP ("face--new-frame-defaults", Vface_new_frame_defaults,
+ doc: /* Hash table of global face definitions (for internal use only.)
*/);
+ Vface_new_frame_defaults =
+ /* 33 entries is enough to fit all basic faces */
+ make_hash_table (hashtest_eq, 33, DEFAULT_REHASH_SIZE,
+ DEFAULT_REHASH_THRESHOLD, Qnil, false);
DEFVAR_LISP ("face-default-stipple", Vface_default_stipple,
doc: /* Default stipple pattern used on monochrome displays.
diff --git a/src/xfns.c b/src/xfns.c
index e46616e..81349d0 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -3361,17 +3361,19 @@ x_icon (struct frame *f, Lisp_Object parms)
= gui_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0,
RES_TYPE_NUMBER);
int icon_xval, icon_yval;
- if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
+ bool xgiven = !EQ (icon_x, Qunbound);
+ bool ygiven = !EQ (icon_y, Qunbound);
+ if (xgiven != ygiven)
+ error ("Both left and top icon corners of icon must be specified");
+ if (xgiven)
{
icon_xval = check_integer_range (icon_x, INT_MIN, INT_MAX);
icon_yval = check_integer_range (icon_y, INT_MIN, INT_MAX);
}
- else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
- error ("Both left and top icon corners of icon must be specified");
block_input ();
- if (! EQ (icon_x, Qunbound))
+ if (xgiven)
x_wm_set_icon_position (f, icon_xval, icon_yval);
#if false /* gui_display_get_arg removes the visibility parameter as a
diff --git a/src/xfont.c b/src/xfont.c
index 0570ee9..81d3561 100644
--- a/src/xfont.c
+++ b/src/xfont.c
@@ -596,7 +596,10 @@ xfont_list_family (struct frame *f)
char **names;
int num_fonts, i;
Lisp_Object list;
- char *last_family UNINIT;
+ char const *last_family;
+#if defined GCC_LINT || defined lint
+ last_family = "";
+#endif
int last_len;
block_input ();
diff --git a/src/xftfont.c b/src/xftfont.c
index f734931..d8ad403 100644
--- a/src/xftfont.c
+++ b/src/xftfont.c
@@ -33,6 +33,12 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "ftfont.h"
#include "pdumper.h"
+#ifndef FC_LCD_FILTER
+/* Older fontconfig versions don't have FC_LCD_FILTER. */
+# define FC_LCD_FILTER "lcdfilter"
+#endif
+
+
/* Xft font driver. */
/* Structure pointed by (struct face *)->extra */
diff --git a/test/Makefile.in b/test/Makefile.in
index c1518d3..7047c24 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -49,6 +49,8 @@ SEPCHAR = @SEPCHAR@
HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@
+REPLACE_FREE = @REPLACE_FREE@
+
-include ${top_builddir}/src/verbose.mk
# Load any GNU ELPA dependencies that are present, for optional tests.
@@ -274,6 +276,9 @@ MODULE_CFLAGS = -I../src -I$(srcdir)/../src -I../lib
-I$(srcdir)/../lib \
test_module = $(test_module_dir)/mod-test${SO}
src/emacs-module-tests.log src/emacs-module-tests.elc: $(test_module)
+FREE_SOURCE_0 =
+FREE_SOURCE_1 = $(srcdir)/../lib/free.c
+
# In the compilation command, we can't use any object or archive file
# as source because those are not compiled with -fPIC. Therefore we
# use only source files.
@@ -282,7 +287,7 @@ $(test_module): $(test_module:${SO}=.c)
../src/emacs-module.h
$(AM_V_CCLD)$(CC) -shared $(CPPFLAGS) $(MODULE_CFLAGS) $(LDFLAGS) \
-o $@ $< $(LIBGMP) \
$(and $(GMP_H),$(srcdir)/../lib/mini-gmp-gnulib.c) \
- $(if $(OMIT_GNULIB_MODULE_free-posix),,$(srcdir)/../lib/free.c) \
+ $(FREE_SOURCE_$(REPLACE_FREE)) \
$(srcdir)/../lib/timespec.c $(srcdir)/../lib/gettime.c
endif
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index 3e97e9c..449dabf 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -671,6 +671,12 @@ This expects `auto-revert--messages' to be bound by
(auto-revert--deftest-remote auto-revert-test07-auto-revert-several-buffers
"Check autorevert for several buffers visiting the same remote file.")
+;; Mark all tests as unstable on Cygwin (bug#49665).
+(when (eq system-type 'cygwin)
+ (dolist (test (apropos-internal "^auto-revert" #'ert-test-boundp))
+ (setf (ert-test-tags (ert-get-test test))
+ (cons :unstable (ert-test-tags (ert-get-test test))))))
+
(defun auto-revert-test-all (&optional interactive)
"Run all tests for \\[auto-revert]."
(interactive "p")
diff --git a/test/lisp/calendar/cal-french-tests.el
b/test/lisp/calendar/cal-french-tests.el
new file mode 100644
index 0000000..ab62c1e
--- /dev/null
+++ b/test/lisp/calendar/cal-french-tests.el
@@ -0,0 +1,113 @@
+;;; cal-french-tests.el --- tests for cal-french.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'cal-french)
+
+(defconst cal-french-test-cases
+ '(
+ (1792 9 22 "Primidi 1 Vendémiaire an 1 de la Révolution, jour du Raisin")
+ (1793 10 23 "Duodi 2 Brumaire an 2 de la Révolution, jour du Céleri")
+ (1794 7 27 "Nonidi 9 Thermidor an 2 de la Révolution, jour de la Mûre")
+ (1794 11 23 "Tridi 3 Frimaire an 3 de la Révolution, jour de la Chicorée")
+ (1795 10 5 "Tridi 13 Vendémiaire an 4 de la Révolution, jour du Potiron")
+ (1795 12 25 "Quartidi 4 Nivôse an 4 de la Révolution, jour du Soufre")
+ (1797 1 24 "Quintidi 5 Pluviôse an 5 de la Révolution, jour du Taureau")
+ (1798 2 24 "Sextidi 6 Ventôse an 6 de la Révolution, jour de l'Asaret")
+ (1799 11 9 "Octidi 18 Brumaire an 8 de la Révolution, jour de la Dentelaire")
+ (1801 3 29 "Octidi 8 Germinal an 9 de la Révolution, jour de la Jonquille")
+ (1804 4 30 "Décadi 10 Floréal an 12 de la Révolution, jour du Rateau")
+ (1807 6 1 "Duodi 12 Prairial an 15 de la Révolution, jour de la Bétoine")
+ (1810 7 3 "Quartidi 14 Messidor an 18 de la Révolution, jour de la Lavande")
+ (1813 8 4 "Sextidi 16 Thermidor an 21 de la Révolution, jour de la
Guimauve")
+ (1816 9 4 "Octidi 18 Fructidor an 24 de la Révolution, jour du Nerprun")
+ (2000 1 1 "Duodi 12 Nivôse an 208 de la Révolution, jour de l'Argile")
+ (2021 7 11 "Tridi 23 Messidor an 229 de la Révolution, jour du Haricot")
+ (2001 5 11 "Duodi 22 Floréal an 209 de la Révolution, jour de la
Fritillaire")
+ (1792 9 22 "Primidi 1 Vendémiaire an 1 de la Révolution, jour du Raisin")
+ (1793 9 21 "Quintidi 5 jour complémentaire an 1 de la Révolution, jour des
Récompenses")
+ (1793 9 22 "Primidi 1 Vendémiaire an 2 de la Révolution, jour du Raisin")
+ (1794 9 21 "Quintidi 5 jour complémentaire an 2 de la Révolution, jour des
Récompenses")
+ (1794 9 22 "Primidi 1 Vendémiaire an 3 de la Révolution, jour du Raisin")
+ (1795 9 22 "Sextidi 6 jour complémentaire an 3 de la Révolution, jour de la
Révolution")
+ (1795 9 23 "Primidi 1 Vendémiaire an 4 de la Révolution, jour du Raisin")
+ (1796 9 21 "Quintidi 5 jour complémentaire an 4 de la Révolution, jour des
Récompenses")
+ (1796 9 22 "Primidi 1 Vendémiaire an 5 de la Révolution, jour du Raisin")
+ (1797 9 21 "Quintidi 5 jour complémentaire an 5 de la Révolution, jour des
Récompenses")
+ (1797 9 22 "Primidi 1 Vendémiaire an 6 de la Révolution, jour du Raisin")
+ (1799 9 22 "Sextidi 6 jour complémentaire an 7 de la Révolution, jour de la
Révolution")
+ (1799 9 23 "Primidi 1 Vendémiaire an 8 de la Révolution, jour du Raisin")
+ (1800 9 22 "Quintidi 5 jour complémentaire an 8 de la Révolution, jour des
Récompenses")
+ (1800 9 23 "Primidi 1 Vendémiaire an 9 de la Révolution, jour du Raisin")
+ (1801 9 22 "Quintidi 5 jour complémentaire an 9 de la Révolution, jour des
Récompenses")
+ (1801 9 23 "Primidi 1 Vendémiaire an 10 de la Révolution, jour du Raisin")
+ (1823 9 22 "Quintidi 5 jour complémentaire an 31 de la Révolution, jour des
Récompenses")
+ (1823 9 23 "Primidi 1 Vendémiaire an 32 de la Révolution, jour du Raisin")
+ (1824 9 22 "Sextidi 6 jour complémentaire an 32 de la Révolution, jour de la
Révolution")
+ (1824 9 23 "Primidi 1 Vendémiaire an 33 de la Révolution, jour du Raisin")
+ (1825 9 22 "Quintidi 5 jour complémentaire an 33 de la Révolution, jour des
Récompenses")
+ (1825 9 23 "Primidi 1 Vendémiaire an 34 de la Révolution, jour du Raisin")
+ (1892 9 21 "Quintidi 5 jour complémentaire an 100 de la Révolution, jour des
Récompenses")
+ (1892 9 22 "Primidi 1 Vendémiaire an 101 de la Révolution, jour du Raisin")
+ (1900 9 22 "Sextidi 6 jour complémentaire an 108 de la Révolution, jour de
la Révolution")
+ (1900 9 23 "Primidi 1 Vendémiaire an 109 de la Révolution, jour du Raisin")
+ (1992 9 21 "Quintidi 5 jour complémentaire an 200 de la Révolution, jour des
Récompenses")
+ (1992 9 22 "Primidi 1 Vendémiaire an 201 de la Révolution, jour du Raisin")
+ (2000 9 21 "Sextidi 6 jour complémentaire an 208 de la Révolution, jour de
la Révolution")
+ (2000 9 22 "Primidi 1 Vendémiaire an 209 de la Révolution, jour du Raisin")
+ (2092 9 20 "Quintidi 5 jour complémentaire an 300 de la Révolution, jour des
Récompenses")
+ (2092 9 21 "Primidi 1 Vendémiaire an 301 de la Révolution, jour du Raisin")
+ (2100 9 21 "Sextidi 6 jour complémentaire an 308 de la Révolution, jour de
la Révolution")
+ (2100 9 22 "Primidi 1 Vendémiaire an 309 de la Révolution, jour du Raisin")
+ (2192 9 21 "Sextidi 6 jour complémentaire an 400 de la Révolution, jour de
la Révolution")
+ (2192 9 22 "Primidi 1 Vendémiaire an 401 de la Révolution, jour du Raisin")
+ (2193 9 21 "Quintidi 5 jour complémentaire an 401 de la Révolution, jour des
Récompenses")
+ (2199 9 22 "Primidi 1 Vendémiaire an 408 de la Révolution, jour du Raisin")
+ (2200 9 22 "Sextidi 6 jour complémentaire an 408 de la Révolution, jour de
la Révolution")
+ (2791 9 23 "Primidi 1 Vendémiaire an 1000 de la Révolution, jour du Raisin")
+ (2792 9 22 "Primidi 1 Vendémiaire an 1001 de la Révolution, jour du Raisin")
+ (3000 1 1 "Duodi 12 Nivôse an 1208 de la Révolution, jour de l'Argile")
+ (3001 1 1 "Primidi 11 Nivôse an 1209 de la Révolution, jour du Granit")
+ (3791 9 22 "Primidi 1 Vendémiaire an 2000 de la Révolution, jour du Raisin")
+ (3792 9 22 "Primidi 1 Vendémiaire an 2001 de la Révolution, jour du Raisin")
+ (4000 1 1 "Duodi 12 Nivôse an 2208 de la Révolution, jour de l'Argile")
+ (4001 1 1 "Duodi 12 Nivôse an 2209 de la Révolution, jour de l'Argile")
+ (4320 9 10 "Quartidi 24 Fructidor an 2528 de la Révolution, jour du Sorgho")
+ (4320 9 11 "Quintidi 25 Fructidor an 2528 de la Révolution, jour de
l'Écrevisse")
+ (4791 9 23 "Primidi 1 Vendémiaire an 3000 de la Révolution, jour du Raisin")
+ (4792 9 22 "Primidi 1 Vendémiaire an 3001 de la Révolution, jour du Raisin")
+ (5000 1 1 "Duodi 12 Nivôse an 3208 de la Révolution, jour de l'Argile")
+ (5001 1 1 "Primidi 11 Nivôse an 3209 de la Révolution, jour du Granit")
+ (5791 9 22 "Primidi 1 Vendémiaire an 4000 de la Révolution, jour du Raisin")
+ (5792 9 21 "Primidi 1 Vendémiaire an 4001 de la Révolution, jour du Raisin")
+ (6000 1 1 "Tridi 13 Nivôse an 4208 de la Révolution, jour de l'Ardoise")
+ (6001 1 1 "Tridi 13 Nivôse an 4209 de la Révolution, jour de l'Ardoise")
+ (6791 9 22 "Primidi 1 Vendémiaire an 5000 de la Révolution, jour du Raisin")
+ (6792 9 21 "Primidi 1 Vendémiaire an 5001 de la Révolution, jour du Raisin")
+ (7791 9 21 "Primidi 1 Vendémiaire an 6000 de la Révolution, jour du Raisin")
+ (7792 9 21 "Primidi 1 Vendémiaire an 6001 de la Révolution, jour du Raisin")
+ ))
+
+(ert-deftest cal-french-tests ()
+ (pcase-dolist (`(,y ,m ,d ,str) cal-french-test-cases)
+ (should (equal (calendar-french-date-string (list m d y)) str))))
+
+(provide 'cal-french-tests)
diff --git a/test/lisp/dired-x-tests.el b/test/lisp/dired-x-tests.el
index 5b51c99..003923d 100644
--- a/test/lisp/dired-x-tests.el
+++ b/test/lisp/dired-x-tests.el
@@ -49,5 +49,18 @@
(sort (dired-get-marked-files 'local) #'string<))))
(delete-directory dir 'recursive))))
+(ert-deftest dired-guess-default ()
+ (let ((dired-guess-shell-alist-user nil)
+ (dired-guess-shell-alist-default
+ '(("\\.png\\'" "display")
+ ("\\.gif\\'" "display" "xloadimage")
+ ("\\.gif\\'" "feh")
+ ("\\.jpe?g\\'" "xloadimage"))))
+ (should (equal (dired-guess-default '("/tmp/foo.png")) "display"))
+ (should (equal (dired-guess-default '("/tmp/foo.gif"))
+ '("display" "xloadimage" "feh")))
+ (should (equal (dired-guess-default '("/tmp/foo.png" "/tmp/foo.txt"))
+ nil))))
+
(provide 'dired-x-tests)
;; dired-x-tests.el ends here
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el
b/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el
new file mode 100644
index 0000000..3a29128
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el
@@ -0,0 +1,5 @@
+;;; -*- lexical-binding: t -*-
+(defsubst warn-callargs-defsubst-f1 (_x)
+ nil)
+(defun warn-callargs-defsubst-f2 ()
+ (warn-callargs-defsubst-f1 1 2))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 33413f5..80003c2 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -432,6 +432,15 @@
(let ((x 2))
(list (or (bytecomp-test-identity 'a) (setq x 3)) x))
+ (mapcar (lambda (b)
+ (let ((a nil))
+ (+ 0
+ (progn
+ (setq a b)
+ (setq b 1)
+ a))))
+ '(10))
+
(let* ((x 1)
(y (condition-case x
(/ 1 0)
@@ -503,6 +512,30 @@
(:success 'good))
(1+ x))))
(funcall f 3))
+
+ ;; Check `not' in cond switch (bug#49746).
+ (mapcar (lambda (x) (cond ((equal x "a") 1)
+ ((member x '("b" "c")) 2)
+ ((not x) 3)))
+ '("a" "b" "c" "d" nil))
+
+ ;; `let' and `let*' optimisations with body being constant or variable
+ (let* (a
+ (b (progn (setq a (cons 1 a)) 2))
+ (c (1+ b))
+ (d (list a c)))
+ d)
+ (let ((a nil))
+ (let ((b (progn (setq a (cons 1 a)) 2))
+ (c (progn (setq a (cons 3 a))))
+ (d (list a)))
+ d))
+ (let* ((_a 1)
+ (_b 2))
+ 'z)
+ (let ((_a 1)
+ (_b 2))
+ 'z)
)
"List of expressions for cross-testing interpreted and compiled code.")
@@ -700,6 +733,9 @@ byte-compiled. Run with dynamic binding."
(bytecomp--define-warning-file-test "warn-callargs.el"
"with 2 arguments, but accepts only 1")
+(bytecomp--define-warning-file-test "warn-callargs-defsubst.el"
+ "with 2 arguments, but accepts only 1")
+
(bytecomp--define-warning-file-test "warn-defcustom-nogroup.el"
"fails to specify containing group")
diff --git a/test/lisp/emacs-lisp/checkdoc-tests.el
b/test/lisp/emacs-lisp/checkdoc-tests.el
index 7a7aa9f..2a1d8b2 100644
--- a/test/lisp/emacs-lisp/checkdoc-tests.el
+++ b/test/lisp/emacs-lisp/checkdoc-tests.el
@@ -49,27 +49,27 @@
(with-temp-buffer
(emacs-lisp-mode)
;; this method matches if A is the symbol `smthg' and if b is a list:
- (insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")")
+ (insert "(cl-defmethod foo ((a (eql 'smthg)) (b list)) \"Return A+B.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-qualified-ok ()
"Checkdoc should be happy with a `cl-defmethod' using qualifiers."
(with-temp-buffer
(emacs-lisp-mode)
- (insert "(cl-defmethod test :around ((a (eql smthg))) \"Return A.\")")
+ (insert "(cl-defmethod test :around ((a (eql 'smthg))) \"Return A.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-ok ()
"Checkdoc should be happy with a :extra qualified `cl-defmethod'."
(with-temp-buffer
(emacs-lisp-mode)
- (insert "(cl-defmethod foo :extra \"foo\" ((a (eql smthg))) \"Return
A.\")")
+ (insert "(cl-defmethod foo :extra \"foo\" ((a (eql 'smthg))) \"Return
A.\")")
(checkdoc-defun))
(with-temp-buffer
(emacs-lisp-mode)
(insert
- "(cl-defmethod foo :extra \"foo\" :after ((a (eql smthg))) \"Return
A.\")")
+ "(cl-defmethod foo :extra \"foo\" :after ((a (eql 'smthg))) \"Return
A.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-and-nil-args-ok ()
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el
b/test/lisp/emacs-lisp/cl-generic-tests.el
index 9312fb4..b48a48f 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -56,7 +56,11 @@
(should (equal (cl--generic-1 'a nil) '(a)))
(should (equal (cl--generic-1 4 nil) '("quatre" 4)))
(should (equal (cl--generic-1 5 nil) '("cinq" 5)))
- (should (equal (cl--generic-1 6 nil) '("six" a))))
+ (should (equal (cl--generic-1 6 nil) '("six" a)))
+ (defvar cl--generic-fooval 41)
+ (cl-defmethod cl--generic-1 ((_x (eql (+ cl--generic-fooval 1))) _y)
+ "forty-two")
+ (should (equal (cl--generic-1 42 nil) "forty-two")))
(cl-defstruct cl-generic-struct-parent a b)
(cl-defstruct (cl-generic-struct-child1 (:include cl-generic-struct-parent)) c)
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index 11ffc11..3ec4234 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -574,7 +574,21 @@ METHOD is the method that was attempting to be called."
(setf (get-slot-3 eitest-t1) 'setf-emu)
(should (eq (get-slot-3 eitest-t1) 'setf-emu))
;; Roll back
- (setf (get-slot-3 eitest-t1) 'emu))
+ (setf (get-slot-3 eitest-t1) 'emu)
+ (defvar eieio-tests-initform-was-evaluated)
+ (defclass eieio-tests-initform-not-evaluated-when-initarg-is-present ()
+ ((slot-with-initarg-and-initform
+ :initarg :slot-with-initarg-and-initform
+ :initform (setf eieio-tests-initform-was-evaluated t))))
+ (setq eieio-tests-initform-was-evaluated nil)
+ (make-instance
+ 'eieio-tests-initform-not-evaluated-when-initarg-is-present)
+ (should eieio-tests-initform-was-evaluated)
+ (setq eieio-tests-initform-was-evaluated nil)
+ (make-instance
+ 'eieio-tests-initform-not-evaluated-when-initarg-is-present
+ :slot-with-initarg-and-initform t)
+ (should-not eieio-tests-initform-was-evaluated))
(defvar eitest-t2 nil)
(ert-deftest eieio-test-26-default-inheritance ()
diff --git a/test/lisp/emacs-lisp/package-tests.el
b/test/lisp/emacs-lisp/package-tests.el
index 67d647d..2943579 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -263,6 +263,74 @@ Must called from within a `tar-mode' buffer."
(should (file-exists-p autoloads-file))
(should-not (get-file-buffer autoloads-file)))))
+(ert-deftest package-test-install-file ()
+ "Install files with `package-install-file'."
+ (with-package-test (:basedir (ert-resource-directory))
+ (package-initialize)
+ (let* ((pkg-el "simple-single-1.3.el")
+ (source-file (expand-file-name pkg-el (ert-resource-directory))))
+ (should-not (package-installed-p 'simple-single))
+ (package-install-file source-file)
+ (should (package-installed-p 'simple-single))
+ (package-delete (cadr (assq 'simple-single package-alist)))
+ (should-not (package-installed-p 'simple-single)))
+
+ (let* ((pkg-el "multi-file-0.2.3.tar")
+ (source-file (expand-file-name pkg-el (ert-resource-directory))))
+ (package-initialize)
+ (should-not (package-installed-p 'multie-file))
+ (package-install-file source-file)
+ (should (package-installed-p 'multi-file))
+ (package-delete (cadr (assq 'multi-file package-alist))))
+ ))
+
+(ert-deftest package-test-install-file-EOLs ()
+ "Install same file multiple time with `package-install-file'
+but with a different end of line convention (bug#48137)."
+ (with-package-test (:basedir (ert-resource-directory))
+ (package-initialize)
+ (let* ((pkg-el "simple-single-1.3.el")
+ (source-file (expand-file-name pkg-el (ert-resource-directory))))
+
+ (with-temp-buffer
+ (insert-file-contents source-file)
+
+ (let (hashes)
+ (dolist (coding '(unix dos mac) hashes)
+ (let* ((eol-file (expand-file-name pkg-el package-test-user-dir)))
+ ;; save package with this EOL convention.
+ (set-buffer-file-coding-system coding)
+ (write-region (point-min) (point-max) eol-file)
+
+ (should-not (package-installed-p 'simple-single))
+ (package-install-file eol-file)
+ (should (package-installed-p 'simple-single))
+
+ ;; check the package file has been installed unmodified.
+ (let ((eol-hash (with-temp-buffer
+ (insert-file-contents-literally eol-file)
+ (buffer-hash))))
+ ;; also perform an additional check that the package
+ ;; file created with this EOL convention is different
+ ;; than all the others created so far.
+ (should-not (member eol-hash hashes))
+ (setq hashes (cons eol-hash hashes))
+
+ (let* ((descr (cadr (assq 'simple-single package-alist)))
+ (pkg-dir (package-desc-dir descr))
+ (dest-file (expand-file-name "simple-single.el" pkg-dir
))
+ (dest-hash (with-temp-buffer
+ (insert-file-contents-literally dest-file)
+ (buffer-hash))))
+
+ (should (string= dest-hash eol-hash))))
+
+ (package-delete (cadr (assq 'simple-single package-alist)))
+ (should-not (package-installed-p 'simple-single))
+ (delete-file eol-file)
+ (should-not (file-exists-p eol-file))
+ )))))))
+
(ert-deftest package-test-install-dependency ()
"Install a package which includes a dependency."
(with-package-test ()
diff --git a/test/lisp/emacs-lisp/pcase-tests.el
b/test/lisp/emacs-lisp/pcase-tests.el
index 2120139..02d3878 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -100,4 +100,14 @@
(should (equal (funcall f 'b1) '(4 5 nil nil)))
(should (equal (funcall f 'b2) '(nil nil 8 9)))))
+(ert-deftest pcase-tests-cl-type ()
+ (should (equal (pcase 1
+ ((cl-type integer) 'integer))
+ 'integer))
+ (should (equal (pcase 1
+ ((cl-type (integer 0 2)) 'integer-0<=n<=2))
+ 'integer-0<=n<=2))
+ (should-error (pcase 1
+ ((cl-type notatype) 'integer))))
+
;;; pcase-tests.el ends here.
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index 3ceb392..f8113bf 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -123,6 +123,25 @@ left alone when opening a URL in an external browser."
(save-excursion (insert "type="))
(ffap-guess-file-name-at-point))))
+(ert-deftest ffap-ido-mode ()
+ (require 'ido)
+ (with-temp-buffer
+ (let ((ido-mode t)
+ (read-file-name-function read-file-name-function)
+ (read-buffer-function read-buffer-function))
+ ;; Says ert-deftest:
+ ;; Macros in BODY are expanded when the test is defined, not when it
+ ;; is run. If a macro (possibly with side effects) is to be tested,
+ ;; it has to be wrapped in `(eval (quote ...))'.
+ (eval (quote (ido-everywhere)))
+ (let ((read-file-name-function (lambda (&rest args)
+ (expand-file-name
+ (nth 4 args)
+ (nth 1 args)))))
+ (save-excursion (insert "ffap-tests.el"))
+ (let (kill-buffer-query-functions)
+ (kill-buffer (call-interactively #'find-file-at-point)))))))
+
(provide 'ffap-tests)
;;; ffap-tests.el ends here
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index e0fa66a..6125069 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -927,7 +927,7 @@ delivered."
(file-notify--test-cleanup)))
(file-notify--deftest-remote file-notify-test03-events
- "Check file creation/change/removal notifications for remote files.")
+ "Check file creation/change/removal notifications for remote files." t)
(require 'autorevert)
(setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded"
diff --git a/test/lisp/files-resources/.dir-locals.el
b/test/lisp/files-resources/.dir-locals.el
new file mode 100644
index 0000000..84393aa
--- /dev/null
+++ b/test/lisp/files-resources/.dir-locals.el
@@ -0,0 +1,5 @@
+;; This is used by files-tests.el.
+((auto-mode-alist . (("\\.quux\\'" . tcl-mode)
+ ("\\.zot1\\'" . foobar)
+ ("\\.zot2\\'" . (lambda ()))
+ ("\\.zot3\\'" . dired-mode))))
diff --git a/test/lisp/files-resources/auto-test.zot1
b/test/lisp/files-resources/auto-test.zot1
new file mode 100644
index 0000000..80acfcc
--- /dev/null
+++ b/test/lisp/files-resources/auto-test.zot1
@@ -0,0 +1 @@
+zot1
diff --git a/test/lisp/files-resources/auto-test.zot2
b/test/lisp/files-resources/auto-test.zot2
new file mode 100644
index 0000000..975fc76
--- /dev/null
+++ b/test/lisp/files-resources/auto-test.zot2
@@ -0,0 +1 @@
+zot2
diff --git a/test/lisp/files-resources/auto-test.zot3
b/test/lisp/files-resources/auto-test.zot3
new file mode 100644
index 0000000..faa0715
--- /dev/null
+++ b/test/lisp/files-resources/auto-test.zot3
@@ -0,0 +1 @@
+zot3
diff --git a/test/lisp/files-resources/whatever.quux
b/test/lisp/files-resources/whatever.quux
new file mode 100644
index 0000000..595583b
--- /dev/null
+++ b/test/lisp/files-resources/whatever.quux
@@ -0,0 +1,2 @@
+# Used by files-test.el.
+# Due to .dir-locals.el this should end up in Tcl mode.
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 257cbc2..a612c06 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -316,7 +316,9 @@ be $HOME."
(ert-deftest files-tests-file-name-non-special--subprocess ()
"Check that Bug#25949 and Bug#48177 are fixed."
- (skip-unless (and (executable-find "true") (file-exists-p null-device)))
+ (skip-unless (and (executable-find "true") (file-exists-p null-device)
+ ;; These systems cannot set date of the null device.
+ (not (memq system-type '(windows-nt ms-dos)))))
(let ((default-directory (file-name-quote temporary-file-directory))
(true (file-name-quote (executable-find "true")))
(null (file-name-quote null-device)))
@@ -949,6 +951,55 @@ unquoted file names."
(make-auto-save-file-name)
(kill-buffer)))))))
+(ert-deftest files-test-auto-save-name-default ()
+ (with-temp-buffer
+ (let ((auto-save-file-name-transforms nil)
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (setq buffer-file-name "/tmp/foo.txt")
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/tmp/#foo.txt#")))))
+
+(ert-deftest files-test-auto-save-name-transform ()
+ (with-temp-buffer
+ (setq buffer-file-name "/tmp/foo.txt")
+ (let ((auto-save-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" nil)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/var/tmp/#foo.txt#")))))
+
+(ert-deftest files-test-auto-save-name-unique ()
+ (with-temp-buffer
+ (setq buffer-file-name "/tmp/foo.txt")
+ (let ((auto-save-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/var/tmp/#!tmp!foo.txt#")))
+ (let ((auto-save-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/var/tmp/#b57c5a04f429a83305859d3350ecdab8315a9037#")))))
+
+(ert-deftest files-test-lock-name-default ()
+ (let ((lock-file-name-transforms nil)
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
+ "/tmp/.#foo.txt"))))
+
+(ert-deftest files-test-lock-name-unique ()
+ (let ((lock-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
+ "/var/tmp/.#!tmp!foo.txt")))
+ (let ((lock-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
+ "/var/tmp/.#b57c5a04f429a83305859d3350ecdab8315a9037"))))
+
(ert-deftest files-tests-file-name-non-special-make-directory ()
(files-tests--with-temp-non-special (tmpdir nospecial-dir t)
(let ((default-directory nospecial-dir))
@@ -1410,7 +1461,12 @@ See <https://debbugs.gnu.org/36401>."
(should (equal (parse-colon-path "x:/foo//bar/baz")
'("x:/foo/bar/baz/")))
(should (equal (parse-colon-path "/foo//bar/baz")
- '("/foo/bar/baz/")))))
+ '("/foo/bar/baz/"))))
+ (let* ((path (concat "." path-separator "/tmp"))
+ (parsed-path (parse-colon-path path))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2)))
+ (should (equal (car parsed-path) "./"))
+ (should (equal (substring (cadr parsed-path) name-start) "/tmp/"))))
(ert-deftest files-test-magic-mode-alist-doctype ()
"Test that DOCTYPE and variants put files in mhtml-mode."
@@ -1496,5 +1552,16 @@ The door of all subtleties!
(should-error (file-name-with-extension "Jack" "."))
(should-error (file-name-with-extension "/is/a/directory/" "css")))
+(ert-deftest files-test-dir-locals-auto-mode-alist ()
+ "Test an `auto-mode-alist' entry in `.dir-locals.el'"
+ (find-file (ert-resource-file "whatever.quux"))
+ (should (eq major-mode 'tcl-mode))
+ (find-file (ert-resource-file "auto-test.zot1"))
+ (should (eq major-mode 'fundamental-mode))
+ (find-file (ert-resource-file "auto-test.zot2"))
+ (should (eq major-mode 'fundamental-mode))
+ (find-file (ert-resource-file "auto-test.zot3"))
+ (should (eq major-mode 'fundamental-mode)))
+
(provide 'files-tests)
;;; files-tests.el ends here
diff --git a/test/lisp/gnus/gnus-search-tests.el
b/test/lisp/gnus/gnus-search-tests.el
index e30ed9a..6148da6 100644
--- a/test/lisp/gnus/gnus-search-tests.el
+++ b/test/lisp/gnus/gnus-search-tests.el
@@ -49,7 +49,9 @@
(default-value 'gnus-search-expandable-keys))
(pairs
'(("su" . "subject")
- ("sin" . "since"))))
+ ("sin" . "since")
+ ("body" . "body")
+ ("list-id" . "list-id"))))
(dolist (p pairs)
(should (equal (gnus-search-query-expand-key (car p))
(cdr p))))
diff --git a/test/lisp/net/tramp-archive-tests.el
b/test/lisp/net/tramp-archive-tests.el
index ca1163b..aac1b13 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -856,7 +856,7 @@ This tests also `file-executable-p', `file-writable-p' and
`set-file-modes'."
(tramp-archive-cleanup-hash))))
;; The functions were introduced in Emacs 26.1.
-(ert-deftest tramp-archive-test39-make-nearby-temp-file ()
+(ert-deftest tramp-archive-test40-make-nearby-temp-file ()
"Check `make-nearby-temp-file' and `temporary-file-directory'."
(skip-unless tramp-archive-enabled)
;; Since Emacs 26.1.
@@ -893,7 +893,7 @@ This tests also `file-executable-p', `file-writable-p' and
`set-file-modes'."
(delete-directory tmp-file)
(should-not (file-exists-p tmp-file))))
-(ert-deftest tramp-archive-test42-file-system-info ()
+(ert-deftest tramp-archive-test43-file-system-info ()
"Check that `file-system-info' returns proper values."
(skip-unless tramp-archive-enabled)
;; Since Emacs 27.1.
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 6aa8629..052c030 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -33,7 +33,7 @@
;; remote host, set this environment variable to "/dev/null" or
;; whatever is appropriate on your system.
-;; For slow remote connections, `tramp-test43-asynchronous-requests'
+;; For slow remote connections, `tramp-test44-asynchronous-requests'
;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper
;; value less than 10 could help.
@@ -63,6 +63,8 @@
(declare-function tramp-smb-get-localname "tramp-smb")
(defvar ange-ftp-make-backup-files)
(defvar auto-save-file-name-transforms)
+(defvar lock-file-name-transforms)
+(defvar remote-file-name-inhibit-locks)
(defvar tramp-connection-properties)
(defvar tramp-copy-size-limit)
(defvar tramp-display-escape-sequence-regexp)
@@ -122,6 +124,7 @@
(setq auth-source-save-behavior nil
password-cache-expiry nil
remote-file-name-inhibit-cache nil
+ tramp-allow-unsafe-temporary-files t
tramp-cache-read-persistent-data t ;; For auth-sources.
tramp-copy-size-limit nil
tramp-persistency-file-name nil
@@ -2463,6 +2466,9 @@ This checks also `file-name-as-directory',
`file-name-directory',
"^\\'")
tramp--test-messages))))))))
+ ;; We do not test lockname here. See
+ ;; `tramp-test39-make-lock-file-name'.
+
;; Do not overwrite if excluded.
(cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always)
;; Ange-FTP.
@@ -2833,8 +2839,7 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(delete-directory tmp-name1 nil 'trash)
;; tramp-rclone.el and tramp-sshfs.el call the local
;; `delete-directory'. This raises another error.
- :type (if (or (tramp--test-rclone-p) (tramp--test-sshfs-p))
- 'error 'file-error))
+ :type (if (tramp--test-fuse-p) 'error 'file-error))
(delete-directory tmp-name1 'recursive 'trash)
(should-not (file-directory-p tmp-name1))
(should
@@ -4091,7 +4096,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-selinux-context tmp-name1))
- (copy-file tmp-name1 tmp-name2)
+ (copy-file tmp-name1 tmp-name2 nil nil nil 'preserve-permissions)
(should (file-selinux-context tmp-name2))
(should
(equal
@@ -5480,7 +5485,8 @@ Use direct async.")
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
- (tmp-name2 (tramp--test-make-temp-name nil quoted)))
+ (tmp-name2 (tramp--test-make-temp-name nil quoted))
+ tramp-allow-unsafe-temporary-files)
(unwind-protect
(progn
@@ -5568,8 +5574,7 @@ Use direct async.")
;; Create temporary file. This shall check for sensible
;; files, owned by root.
- (let ((tramp-auto-save-directory temporary-file-directory)
- tramp-allow-unsafe-temporary-files)
+ (let ((tramp-auto-save-directory temporary-file-directory))
(write-region "foo" nil tmp-name1)
(when (zerop (or (tramp-compat-file-attribute-user-id
(file-attributes tmp-name1))
@@ -5605,6 +5610,7 @@ Use direct async.")
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(ange-ftp-make-backup-files t)
+ tramp-allow-unsafe-temporary-files
;; These settings are not used by Tramp, so we ignore them.
version-control delete-old-versions
(kept-old-versions (default-toplevel-value 'kept-old-versions))
@@ -5715,7 +5721,6 @@ Use direct async.")
;; Create temporary file. This shall check for sensible
;; files, owned by root.
(let ((backup-directory-alist `(("." . ,temporary-file-directory)))
- tramp-allow-unsafe-temporary-files
tramp-backup-directory-alist)
(write-region "foo" nil tmp-name1)
(when (zerop (or (tramp-compat-file-attribute-user-id
@@ -5741,8 +5746,144 @@ Use direct async.")
(ignore-errors (delete-file tmp-name1))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
+;; The functions were introduced in Emacs 28.1.
+(ert-deftest tramp-test39-make-lock-file-name ()
+ "Check `make-lock-file-name', `lock-file', `unlock-file' and
`file-locked-p'."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (not (tramp--test-ange-ftp-p)))
+ ;; Since Emacs 28.1.
+ (skip-unless (and (fboundp 'lock-file) (fboundp 'unlock-file)))
+ (skip-unless (and (fboundp 'file-locked-p) (fboundp 'make-lock-file-name)))
+
+ ;; `lock-file', `unlock-file', `file-locked-p' and
+ ;; `make-lock-file-name' exists since Emacs 28.1. We don't want to
+ ;; see compiler warnings for older Emacsen.
+ (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
+ (tmp-name2 (tramp--test-make-temp-name nil quoted))
+ (remote-file-name-inhibit-cache t)
+ (remote-file-name-inhibit-locks nil)
+ (create-lockfiles t)
+ tramp-allow-unsafe-temporary-files
+ (inhibit-message t)
+ ;; tramp-rclone.el and tramp-sshfs.el cache the mounted files.
+ (tramp-cleanup-connection-hook
+ (append
+ (and (tramp--test-fuse-p) '(tramp-fuse-unmount))
+ tramp-cleanup-connection-hook))
+ auto-save-default
+ noninteractive)
+
+ (unwind-protect
+ (progn
+ ;; A simple file lock.
+ (should-not (with-no-warnings (file-locked-p tmp-name1)))
+ (with-no-warnings (lock-file tmp-name1))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+
+ ;; If it is locked already, nothing changes.
+ (with-no-warnings (lock-file tmp-name1))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+
+ ;; `save-buffer' removes the lock.
+ (with-temp-buffer
+ (set-visited-file-name tmp-name1)
+ (insert "foo")
+ (save-buffer))
+ (should-not (with-no-warnings (file-locked-p tmp-name1)))
+ (with-no-warnings (lock-file tmp-name1))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+
+ ;; A new connection changes process id, and also the
+ ;; lockname contents.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (should (stringp (with-no-warnings (file-locked-p tmp-name1))))
+
+ ;; When `remote-file-name-inhibit-locks' is set, nothing happens.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (let ((remote-file-name-inhibit-locks t))
+ (with-no-warnings (lock-file tmp-name1))
+ (should-not (with-no-warnings (file-locked-p tmp-name1))))
+
+ ;; When `lock-file-name-transforms' is set, another lock
+ ;; file is used.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (let ((lock-file-name-transforms `((".*" ,tmp-name2))))
+ (should
+ (string-equal
+ (with-no-warnings (make-lock-file-name tmp-name1))
+ (with-no-warnings (make-lock-file-name tmp-name2))))
+ (with-no-warnings (lock-file tmp-name1))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+ (with-no-warnings (unlock-file tmp-name1))
+ (should-not (with-no-warnings (file-locked-p tmp-name1))))
+
+ ;; Steal the file lock.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s)))
+ (with-no-warnings (lock-file tmp-name1)))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+
+ ;; Ignore the file lock.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p)))
+ (with-no-warnings (lock-file tmp-name1)))
+ (should (stringp (with-no-warnings (file-locked-p tmp-name1))))
+
+ ;; Quit the file lock machinery.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q)))
+ (with-no-warnings
+ (should-error
+ (lock-file tmp-name1)
+ :type 'file-locked))
+ ;; The same for `write-region'.
+ (should-error
+ (write-region "foo" nil tmp-name1)
+ :type 'file-locked)
+ (should-error
+ (write-region "foo" nil tmp-name1 nil nil tmp-name1)
+ :type 'file-locked)
+ ;; The same for `set-visited-file-name'.
+ (with-temp-buffer
+ (should-error
+ (set-visited-file-name tmp-name1)
+ :type 'file-locked)))
+ (should (stringp (with-no-warnings (file-locked-p tmp-name1)))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name1))
+ (with-no-warnings (unlock-file tmp-name1))
+ (with-no-warnings (unlock-file tmp-name2))
+ (should-not (with-no-warnings (file-locked-p tmp-name1)))
+ (should-not (with-no-warnings (file-locked-p tmp-name2))))
+
+ (unwind-protect
+ ;; Create temporary file. This shall check for sensible
+ ;; files, owned by root.
+ (let ((lock-file-name-transforms auto-save-file-name-transforms))
+ (write-region "foo" nil tmp-name1)
+ (when (zerop (or (tramp-compat-file-attribute-user-id
+ (file-attributes tmp-name1))
+ tramp-unknown-id-integer))
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
+ (should-error
+ (write-region "foo" nil tmp-name1)
+ :type 'file-error))
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'yes-or-no-p)
+ #'tramp--test-always))
+ (write-region "foo" nil tmp-name1))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name1))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
+
;; The functions were introduced in Emacs 26.1.
-(ert-deftest tramp-test39-make-nearby-temp-file ()
+(ert-deftest tramp-test40-make-nearby-temp-file ()
"Check `make-nearby-temp-file' and `temporary-file-directory'."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-ange-ftp-p)))
@@ -5825,6 +5966,10 @@ This does not support globbing characters in file names
(yet)."
(string-match-p
"ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
+(defun tramp--test-fuse-p ()
+ "Check, whether an FUSE file system isused."
+ (or (tramp--test-rclone-p) (tramp--test-sshfs-p)))
+
(defun tramp--test-gdrive-p ()
"Check, whether the gdrive method is used."
(string-equal
@@ -5935,7 +6080,9 @@ This requires restrictions of file name syntax."
(file-truename tramp-test-temporary-file-directory))
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name 'local quoted))
- (files (delq nil files))
+ (files
+ (delq
+ nil (mapcar (lambda (x) (unless (string-empty-p x) x)) files)))
(process-environment process-environment)
(sorted-files (sort (copy-sequence files) #'string-lessp))
buffer)
@@ -5945,7 +6092,7 @@ This requires restrictions of file name syntax."
(make-directory tmp-name2)
(dolist (elt files)
- ;(tramp--test-message "%s" elt)
+ ;(tramp--test-message "'%s'" elt)
(let* ((file1 (expand-file-name elt tmp-name1))
(file2 (expand-file-name elt tmp-name2))
(file3 (expand-file-name (concat elt "foo") tmp-name1)))
@@ -6113,7 +6260,7 @@ This requires restrictions of file name syntax."
(ignore-errors (delete-directory tmp-name2 'recursive))))))
(defun tramp--test-special-characters ()
- "Perform the test in `tramp-test40-special-characters*'."
+ "Perform the test in `tramp-test41-special-characters*'."
;; Newlines, slashes and backslashes in file names are not
;; supported. So we don't test. And we don't test the tab
;; character on Windows or Cygwin, because the backslash is
@@ -6171,7 +6318,7 @@ This requires restrictions of file name syntax."
files (list (mapconcat #'identity files ""))))))
;; These tests are inspired by Bug#17238.
-(ert-deftest tramp-test40-special-characters ()
+(ert-deftest tramp-test41-special-characters ()
"Check special characters in file names."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
@@ -6179,7 +6326,7 @@ This requires restrictions of file name syntax."
(tramp--test-special-characters))
-(ert-deftest tramp-test40-special-characters-with-stat ()
+(ert-deftest tramp-test41-special-characters-with-stat ()
"Check special characters in file names.
Use the `stat' command."
:tags '(:expensive-test)
@@ -6197,7 +6344,7 @@ Use the `stat' command."
tramp-connection-properties)))
(tramp--test-special-characters)))
-(ert-deftest tramp-test40-special-characters-with-perl ()
+(ert-deftest tramp-test41-special-characters-with-perl ()
"Check special characters in file names.
Use the `perl' command."
:tags '(:expensive-test)
@@ -6218,7 +6365,7 @@ Use the `perl' command."
tramp-connection-properties)))
(tramp--test-special-characters)))
-(ert-deftest tramp-test40-special-characters-with-ls ()
+(ert-deftest tramp-test41-special-characters-with-ls ()
"Check special characters in file names.
Use the `ls' command."
:tags '(:expensive-test)
@@ -6239,7 +6386,7 @@ Use the `ls' command."
(tramp--test-special-characters)))
(defun tramp--test-utf8 ()
- "Perform the test in `tramp-test41-utf8*'."
+ "Perform the test in `tramp-test42-utf8*'."
(let* ((utf8 (if (and (eq system-type 'darwin)
(memq 'utf-8-hfs (coding-system-list)))
'utf-8-hfs 'utf-8))
@@ -6285,7 +6432,7 @@ Use the `ls' command."
(replace-regexp-in-string "[ \t\n/.?]" "" x)))
language-info-alist)))))))
-(ert-deftest tramp-test41-utf8 ()
+(ert-deftest tramp-test42-utf8 ()
"Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-docker-p)))
@@ -6298,7 +6445,7 @@ Use the `ls' command."
(tramp--test-utf8))
-(ert-deftest tramp-test41-utf8-with-stat ()
+(ert-deftest tramp-test42-utf8-with-stat ()
"Check UTF8 encoding in file names and file contents.
Use the `stat' command."
:tags '(:expensive-test)
@@ -6320,7 +6467,7 @@ Use the `stat' command."
tramp-connection-properties)))
(tramp--test-utf8)))
-(ert-deftest tramp-test41-utf8-with-perl ()
+(ert-deftest tramp-test42-utf8-with-perl ()
"Check UTF8 encoding in file names and file contents.
Use the `perl' command."
:tags '(:expensive-test)
@@ -6345,7 +6492,7 @@ Use the `perl' command."
tramp-connection-properties)))
(tramp--test-utf8)))
-(ert-deftest tramp-test41-utf8-with-ls ()
+(ert-deftest tramp-test42-utf8-with-ls ()
"Check UTF8 encoding in file names and file contents.
Use the `ls' command."
:tags '(:expensive-test)
@@ -6369,7 +6516,7 @@ Use the `ls' command."
tramp-connection-properties)))
(tramp--test-utf8)))
-(ert-deftest tramp-test42-file-system-info ()
+(ert-deftest tramp-test43-file-system-info ()
"Check that `file-system-info' returns proper values."
(skip-unless (tramp--test-enabled))
;; Since Emacs 27.1.
@@ -6386,11 +6533,11 @@ Use the `ls' command."
(numberp (nth 1 fsi))
(numberp (nth 2 fsi))))))
-;; `tramp-test43-asynchronous-requests' could be blocked. So we set a
+;; `tramp-test44-asynchronous-requests' could be blocked. So we set a
;; timeout of 300 seconds, and we send a SIGUSR1 signal after 300
;; seconds. Similar check is performed in the timer function.
(defconst tramp--test-asynchronous-requests-timeout 300
- "Timeout for `tramp-test43-asynchronous-requests'.")
+ "Timeout for `tramp-test44-asynchronous-requests'.")
(defmacro tramp--test-with-proper-process-name-and-buffer (proc &rest body)
"Set \"process-name\" and \"process-buffer\" connection properties.
@@ -6426,7 +6573,7 @@ This is needed in timer functions as well as process
filters and sentinels."
(tramp-flush-connection-property v "process-buffer")))))
;; This test is inspired by Bug#16928.
-(ert-deftest tramp-test43-asynchronous-requests ()
+(ert-deftest tramp-test44-asynchronous-requests ()
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
@@ -6626,11 +6773,11 @@ process sentinels. They shall not disturb each other."
(ignore-errors (cancel-timer timer))
(ignore-errors (delete-directory tmp-name 'recursive))))))
-;; (tramp--test--deftest-direct-async-process
tramp-test43-asynchronous-requests
+;; (tramp--test--deftest-direct-async-process
tramp-test44-asynchronous-requests
;; "Check parallel direct asynchronous requests." 'unstable)
;; This test is inspired by Bug#29163.
-(ert-deftest tramp-test44-auto-load ()
+(ert-deftest tramp-test45-auto-load ()
"Check that Tramp autoloads properly."
;; If we use another syntax but `default', Tramp is already loaded
;; due to the `tramp-change-syntax' call.
@@ -6655,7 +6802,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test44-delay-load ()
+(ert-deftest tramp-test45-delay-load ()
"Check that Tramp is loaded lazily, only when needed."
;; The autoloaded Tramp objects are different since Emacs 26.1. We
;; cannot test older Emacsen, therefore.
@@ -6688,7 +6835,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument (format code tm)))))))))
-(ert-deftest tramp-test44-recursive-load ()
+(ert-deftest tramp-test45-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
@@ -6712,7 +6859,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))))
-(ert-deftest tramp-test44-remote-load-path ()
+(ert-deftest tramp-test45-remote-load-path ()
"Check that Tramp autoloads its packages with remote `load-path'."
;; The autoloaded Tramp objects are different since Emacs 26.1. We
;; cannot test older Emacsen, therefore.
@@ -6741,7 +6888,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test45-unload ()
+(ert-deftest tramp-test46-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)
@@ -6824,7 +6971,7 @@ If INTERACTIVE is non-nil, the tests are run
interactively."
;; * Implement `tramp-test31-interrupt-process' for `adb', `sshfs' and
;; for direct async processes.
;; * Check, why direct async processes do not work for
-;; `tramp-test43-asynchronous-requests'.
+;; `tramp-test44-asynchronous-requests'.
(provide 'tramp-tests)
diff --git a/test/lisp/progmodes/compile-tests.el
b/test/lisp/progmodes/compile-tests.el
index da6a1e6..2a3bb3d 100644
--- a/test/lisp/progmodes/compile-tests.el
+++ b/test/lisp/progmodes/compile-tests.el
@@ -31,9 +31,6 @@
(require 'compile)
(defconst compile-tests--test-regexps-data
- ;; The computed column numbers are zero-indexed, so subtract 1 from
- ;; what's reported in the string. The end column numbers are for
- ;; the character after, so it matches what's reported in the string.
'(;; absoft
(absoft
"Error on line 3 of t.f: Execution error unclassifiable statement"
@@ -61,7 +58,7 @@
(ant "[javac] /src/DataBaseTestCase.java:49: warning: finally clause
cannot complete normally"
13 nil 49 "/src/DataBaseTestCase.java" 1)
(ant "[jikes] foo.java:3:5:7:9: blah blah"
- 14 (5 . 10) (3 . 7) "foo.java" 2)
+ 14 (5 . 9) (3 . 7) "foo.java" 2)
(ant "[javac] c:/cygwin/Test.java:12: error: foo: bar"
9 nil 12 "c:/cygwin/Test.java" 2)
(ant "[javac] c:\\cygwin\\Test.java:87: error: foo: bar"
@@ -86,10 +83,10 @@
;; caml
(python-tracebacks-and-caml
"File \"foobar.ml\", lines 5-8, characters 20-155: blah blah"
- 1 (20 . 156) (5 . 8) "foobar.ml")
+ 1 (20 . 155) (5 . 8) "foobar.ml")
(python-tracebacks-and-caml
"File \"F:\\ocaml\\sorting.ml\", line 65, characters 2-145:\nWarning 26:
unused variable equ."
- 1 (2 . 146) 65 "F:\\ocaml\\sorting.ml")
+ 1 (2 . 145) 65 "F:\\ocaml\\sorting.ml")
(python-tracebacks-and-caml
"File \"/usr/share/gdesklets/display/TargetGauge.py\", line 41, in
add_children"
1 nil 41 "/usr/share/gdesklets/display/TargetGauge.py")
@@ -231,12 +228,12 @@
(gnu "foo.c:8.23: note: message" 1 23 8 "foo.c")
(gnu "foo.c:8.23: info: message" 1 23 8 "foo.c")
(gnu "foo.c:8:23:information: message" 1 23 8 "foo.c")
- (gnu "foo.c:8.23-45: Informational: message" 1 (23 . 46) (8 . nil) "foo.c")
+ (gnu "foo.c:8.23-45: Informational: message" 1 (23 . 45) (8 . nil) "foo.c")
(gnu "foo.c:8-23: message" 1 nil (8 . 23) "foo.c")
;; The next one is not in the GNU standards AFAICS.
;; Here we seem to interpret it as LINE1-LINE2.COL2.
- (gnu "foo.c:8-45.3: message" 1 (nil . 4) (8 . 45) "foo.c")
- (gnu "foo.c:8.23-9.1: message" 1 (23 . 2) (8 . 9) "foo.c")
+ (gnu "foo.c:8-45.3: message" 1 (nil . 3) (8 . 45) "foo.c")
+ (gnu "foo.c:8.23-9.1: message" 1 (23 . 1) (8 . 9) "foo.c")
(gnu "jade:dbcommon.dsl:133:17:E: missing argument for function call"
1 17 133 "dbcommon.dsl")
(gnu "G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be
found."
@@ -472,8 +469,11 @@ can only work with the NUL byte to disambiguate colons.")
(when file
(should (equal (caar (compilation--loc->file-struct loc)) file)))
(when end-col
+ ;; The computed END-COL is exclusive; subtract one to get the
+ ;; number in the error message.
(should (equal
- (car (cadr (nth 2 (compilation--loc->file-struct loc))))
+ (1- (car (cadr
+ (nth 2 (compilation--loc->file-struct loc)))))
end-col)))
(should (equal (car (nth 2 (compilation--loc->file-struct loc)))
(or end-line line)))
@@ -515,4 +515,31 @@ The test data is in
`compile-tests--grep-regexp-testcases'."
(compile--test-error-line testcase))
(should (eq compilation-num-errors-found 8))))
+(ert-deftest compile-test-functions ()
+ "Test rules using functions instead of regexp group numbers."
+ (let* ((file-fun (lambda () '("my-file")))
+ (line-start-fun (lambda () 123))
+ (line-end-fun (lambda () 134))
+ (col-start-fun (lambda () 39))
+ (col-end-fun (lambda () 24))
+ (compilation-error-regexp-alist-alist
+ `((my-rule
+ ,(rx bol "My error message")
+ ,file-fun
+ (,line-start-fun . ,line-end-fun)
+ (,col-start-fun . ,col-end-fun))))
+ (compilation-error-regexp-alist '(my-rule)))
+ (with-temp-buffer
+ (font-lock-mode -1)
+ (let ((compilation-num-errors-found 0)
+ (compilation-num-warnings-found 0)
+ (compilation-num-infos-found 0))
+ (compile--test-error-line
+ '(my-rule
+ "My error message"
+ 1 (39 . 24) (123 . 134) "my-file" 2))
+ (should (eq compilation-num-errors-found 1))
+ (should (eq compilation-num-warnings-found 0))
+ (should (eq compilation-num-infos-found 0))))))
+
;;; compile-tests.el ends here
diff --git a/test/lisp/progmodes/perl-mode-tests.el
b/test/lisp/progmodes/perl-mode-tests.el
index f63f8ad..3f4af5e 100644
--- a/test/lisp/progmodes/perl-mode-tests.el
+++ b/test/lisp/progmodes/perl-mode-tests.el
@@ -21,6 +21,13 @@
(require 'perl-mode)
+(ert-deftest perl-test-lock ()
+ (with-temp-buffer
+ (perl-mode)
+ (insert "$package = foo;")
+ (font-lock-ensure (point-min) (point-max))
+ (should (equal (get-text-property 4 'face)
'font-lock-variable-name-face))))
+
;;;; Re-use cperl-mode tests
(defvar cperl-test-mode)
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index 2db570c..7f62a41 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -465,7 +465,12 @@ Return the last evalled form in BODY."
;; isearch-lazy-highlight-new-loop and sit-for (bug#36328)
((symbol-function 'replace-highlight)
(lambda (&rest _args)
- (string-match "[A-Z ]" "ForestGreen"))))
+ (string-match "[A-Z ]" "ForestGreen")))
+ ;; Override `sit-for' and `ding' so that we don't have
+ ;; to wait and listen to bells when running the test.
+ ((symbol-function 'sit-for)
+ (lambda (&rest _args) (redisplay)))
+ ((symbol-function 'ding) 'ignore))
(perform-replace ,from ,to t
replace-tests-perform-replace-regexp-flag nil))
,@body))))
@@ -584,7 +589,7 @@ bound to HIGHLIGHT-LOCUS."
(replace-tests-with-highlighted-occurrence highlight-locus
(occur-mode-display-occurrence)
(with-current-buffer (marker-buffer
- (get-text-property (point) 'occur-target))
+ (caar (get-text-property (point) 'occur-target)))
(should (funcall check-overlays has-overlay)))))))
(ert-deftest replace-regexp-bug45973 ()
@@ -601,4 +606,15 @@ bound to HIGHLIGHT-LOCUS."
(if (match-string 2) "R" "L")))
(should (equal (buffer-string) after)))))
+(ert-deftest test-count-matches ()
+ (with-temp-buffer
+ (insert "oooooooooo")
+ (goto-char (point-min))
+ (should (= (count-matches "oo") 5))
+ (should (= (count-matches "o+") 1)))
+ (with-temp-buffer
+ (insert "o\n\n\n\no\n\n")
+ (goto-char (point-min))
+ (should (= (count-matches "^$") 4))))
+
;;; replace-tests.el ends here
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index 7c9d05a..c571dc3 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -69,12 +69,15 @@
(format "/mock::%s" temporary-file-directory)))
"Temporary directory for Tramp tests.")
-(setq password-cache-expiry nil
- shadow-debug (getenv "EMACS_HYDRA_CI")
- tramp-verbose 0
+(setq auth-source-save-behavior nil
+ password-cache-expiry nil
+ shadow-debug (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
;; When the remote user id is 0, Tramp refuses unsafe temporary files.
tramp-allow-unsafe-temporary-files
(or tramp-allow-unsafe-temporary-files noninteractive)
+ tramp-cache-read-persistent-data t ;; For auth-sources.
+ tramp-persistency-file-name nil
+ tramp-verbose 0
;; On macOS, `temporary-file-directory' is a symlinked directory.
temporary-file-directory (file-truename temporary-file-directory)
shadow-test-remote-temporary-file-directory
@@ -643,7 +646,9 @@ guaranteed by the originator of a cluster definition."
(expand-file-name
"shadowfile-tests"
shadow-test-remote-temporary-file-directory))
- mocked-input `(,cluster1 ,file1 ,cluster2 ,file2 ,(kbd "RET")))
+ mocked-input
+ `(,cluster1 ,file1 ,cluster2 ,file2
+ ,primary ,file1 ,(kbd "RET")))
(with-temp-buffer
(set-visited-file-name file1)
(call-interactively #'shadow-define-literal-group)
@@ -657,7 +662,9 @@ guaranteed by the originator of a cluster definition."
(should (member (format "/%s:%s" cluster1 (file-local-name file1))
(car shadow-literal-groups)))
(should (member (format "/%s:%s" cluster2 (file-local-name file2))
- (car shadow-literal-groups))))
+ (car shadow-literal-groups)))
+ ;; Bug#49596.
+ (should (member (concat primary file1) (car shadow-literal-groups))))
;; Cleanup.
(shadow--tests-cleanup))))
@@ -732,6 +739,7 @@ guaranteed by the originator of a cluster definition."
(skip-unless (file-writable-p shadow-test-remote-temporary-file-directory))
(let ((backup-inhibited t)
+ create-lockfiles
(shadow-info-file shadow-test-info-file)
(shadow-todo-file shadow-test-todo-file)
(shadow-inhibit-message t)
@@ -877,6 +885,7 @@ guaranteed by the originator of a cluster definition."
(skip-unless (file-writable-p shadow-test-remote-temporary-file-directory))
(let ((backup-inhibited t)
+ create-lockfiles
(shadow-info-file shadow-test-info-file)
(shadow-todo-file shadow-test-todo-file)
(shadow-inhibit-message t)
diff --git a/test/lisp/shell-tests.el b/test/lisp/shell-tests.el
index d918de7..223a185 100644
--- a/test/lisp/shell-tests.el
+++ b/test/lisp/shell-tests.el
@@ -45,4 +45,23 @@
(should (equal (shell--parse-pcomplete-arguments)
'(("cd" "ba" "") 1 4 7)))))
+(ert-deftest shell-tests-split-string ()
+ (should (equal (split-string-shell-command "ls /tmp")
+ '("ls" "/tmp")))
+ (should (equal (split-string-shell-command "ls '/tmp/foo bar'")
+ '("ls" "/tmp/foo bar")))
+ (should (equal (split-string-shell-command "ls \"/tmp/foo bar\"")
+ '("ls" "/tmp/foo bar")))
+ (should (equal (split-string-shell-command "ls /tmp/'foo bar'")
+ '("ls" "/tmp/foo bar")))
+ (should (equal (split-string-shell-command "ls /tmp/'foo\"bar'")
+ '("ls" "/tmp/foo\"bar")))
+ (should (equal (split-string-shell-command "ls /tmp/\"foo''bar\"")
+ '("ls" "/tmp/foo''bar")))
+ (should (equal (split-string-shell-command "ls /tmp/'foo\\ bar'")
+ '("ls" "/tmp/foo\\ bar")))
+ (unless (memq system-type '(windows-nt ms-dos))
+ (should (equal (split-string-shell-command "ls /tmp/foo\\ bar")
+ '("ls" "/tmp/foo bar")))))
+
;;; shell-tests.el ends here
diff --git a/test/lisp/so-long-tests/so-long-tests-helpers.el
b/test/lisp/so-long-tests/so-long-tests-helpers.el
index ab4d9c6..dd2331e 100644
--- a/test/lisp/so-long-tests/so-long-tests-helpers.el
+++ b/test/lisp/so-long-tests/so-long-tests-helpers.el
@@ -43,7 +43,8 @@
(cl-case action
('so-long-mode
(should (eq major-mode 'so-long-mode))
- (so-long-tests-assert-overrides))
+ (so-long-tests-assert-overrides)
+ (so-long-tests-assert-preserved))
('so-long-minor-mode
(should (eq so-long-minor-mode t))
(so-long-tests-assert-overrides))
@@ -62,7 +63,8 @@
(cl-case action
('so-long-mode
(should-not (eq major-mode 'so-long-mode))
- (so-long-tests-assert-overrides-reverted))
+ (so-long-tests-assert-overrides-reverted)
+ (so-long-tests-assert-preserved))
('so-long-minor-mode
(should-not (eq so-long-minor-mode t))
(so-long-tests-assert-overrides-reverted))
@@ -90,6 +92,17 @@
(when (boundp (car ovar))
(should (equal (symbol-value (car ovar)) (cdr ovar))))))
+(defun so-long-tests-assert-preserved ()
+ "Assert that preserved modes and variables have their expected values."
+ (dolist (var so-long-mode-preserved-variables)
+ (when (boundp var)
+ (should (equal (symbol-value var)
+ (alist-get var so-long-tests-memory)))))
+ (dolist (mode so-long-mode-preserved-minor-modes)
+ (when (boundp mode)
+ (should (equal (symbol-value mode)
+ (alist-get mode so-long-tests-memory))))))
+
(defun so-long-tests-remember ()
"Remember the original states of modes and variables.
@@ -107,7 +120,22 @@ state against this remembered state."
(dolist (mode so-long-minor-modes)
(when (boundp mode)
(push (cons mode (symbol-value mode))
+ so-long-tests-memory)))
+ (dolist (var so-long-mode-preserved-variables)
+ (when (boundp var)
+ (push (cons var (symbol-value var))
+ so-long-tests-memory)))
+ (dolist (mode so-long-mode-preserved-minor-modes)
+ (when (boundp mode)
+ (push (cons mode (symbol-value mode))
so-long-tests-memory))))
+(defun so-long-tests-predicates ()
+ "Return the list of testable predicate functions."
+ (if (fboundp 'buffer-line-statistics)
+ '(so-long-statistics-excessive-p
+ so-long-detected-long-line-p)
+ '(so-long-detected-long-line-p)))
+
(provide 'so-long-tests-helpers)
;;; so-long-tests-helpers.el ends here
diff --git a/test/lisp/so-long-tests/so-long-tests.el
b/test/lisp/so-long-tests/so-long-tests.el
index a6d8721..8e4597c 100644
--- a/test/lisp/so-long-tests/so-long-tests.el
+++ b/test/lisp/so-long-tests/so-long-tests.el
@@ -57,101 +57,131 @@
(declare-function so-long-tests-assert-active "so-long-tests-helpers")
(declare-function so-long-tests-assert-reverted "so-long-tests-helpers")
(declare-function so-long-tests-assert-and-revert "so-long-tests-helpers")
+(declare-function so-long-tests-predicates "so-long-tests-helpers")
-;; Enable the automated behavior for all tests.
+;; Enable the automated behaviour for all tests.
(global-so-long-mode 1)
(ert-deftest so-long-tests-threshold-under ()
"Under line length threshold."
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1- so-long-threshold) ?x))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode))))
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1- so-long-threshold) ?x))
+ (normal-mode)
+ (should (eq major-mode 'emacs-lisp-mode)))))
(ert-deftest so-long-tests-threshold-at ()
"At line length threshold."
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1- so-long-threshold) ?x))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode))))
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1- so-long-threshold) ?x))
+ (normal-mode)
+ (should (eq major-mode 'emacs-lisp-mode)))))
(ert-deftest so-long-tests-threshold-over ()
"Over line length threshold."
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (normal-mode)
- (so-long-tests-remember)
- (insert (make-string (1+ so-long-threshold) ?x))
- (normal-mode)
- (so-long-tests-assert-and-revert 'so-long-mode)))
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (normal-mode)
+ (so-long-tests-remember)
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (normal-mode)
+ (so-long-tests-assert-and-revert 'so-long-mode))))
(ert-deftest so-long-tests-skip-comments ()
"Skip leading shebang, whitespace, and comments."
- ;; Long comment, no newline.
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1+ so-long-threshold) ?\;))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode)))
- ;; Long comment, with newline.
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1+ so-long-threshold) ?\;))
- (insert "\n")
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode)))
- ;; Long comment, with short text following.
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1+ so-long-threshold) ?\;))
- (insert "\n")
- (insert (make-string so-long-threshold ?x))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode)))
- ;; Long comment, with long text following.
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1+ so-long-threshold) ?\;))
- (insert "\n")
- (insert (make-string (1+ so-long-threshold) ?x))
- (normal-mode)
- (should (eq major-mode 'so-long-mode))))
+ ;; Only for `so-long-detected-long-line-p' -- comments are not
+ ;; treated differently when using `so-long-statistics-excessive-p'.
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ ;; Long comment, no newline.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?\;))
+ (normal-mode)
+ (should (eq major-mode
+ (cond ((eq so-long-predicate #'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate
#'so-long-statistics-excessive-p)
+ 'so-long-mode)))))
+ ;; Long comment, with newline.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?\;))
+ (insert "\n")
+ (normal-mode)
+ (should (eq major-mode
+ (cond ((eq so-long-predicate #'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate
#'so-long-statistics-excessive-p)
+ 'so-long-mode)))))
+ ;; Long comment, with short text following.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?\;))
+ (insert "\n")
+ (insert (make-string so-long-threshold ?x))
+ (normal-mode)
+ (should (eq major-mode
+ (cond ((eq so-long-predicate #'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate
#'so-long-statistics-excessive-p)
+ 'so-long-mode)))))
+ ;; Long comment, with long text following.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?\;))
+ (insert "\n")
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (normal-mode)
+ (should (eq major-mode 'so-long-mode)))))
(ert-deftest so-long-tests-max-lines ()
"Give up after `so-long-max-lines'."
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- ;; Insert exactly `so-long-max-lines' non-comment lines, followed
- ;; by a long line.
- (dotimes (_ so-long-max-lines)
- (insert "x\n"))
- (insert (make-string (1+ so-long-threshold) ?x))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode))
- ;; If `so-long-max-lines' is nil, don't give up the search.
- (let ((so-long-max-lines nil))
- (normal-mode)
- (should (eq major-mode 'so-long-mode)))
- ;; If `so-long-skip-leading-comments' is nil, all lines are
- ;; counted, and so the shebang line counts, which makes the
- ;; long line one line further away.
- (let ((so-long-skip-leading-comments nil)
- (so-long-max-lines (1+ so-long-max-lines)))
+ ;; Only for `so-long-detected-long-line-p' -- the whole buffer is
+ ;; 'seen' when using `so-long-statistics-excessive-p'.
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ ;; Insert exactly `so-long-max-lines' non-comment lines, followed
+ ;; by a long line.
+ (dotimes (_ so-long-max-lines)
+ (insert "x\n"))
+ (insert (make-string (1+ so-long-threshold) ?x))
(normal-mode)
- (should (eq major-mode 'emacs-lisp-mode))
- (let ((so-long-max-lines (1+ so-long-max-lines)))
+ (should (eq major-mode
+ (cond ((eq so-long-predicate #'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate
#'so-long-statistics-excessive-p)
+ 'so-long-mode))))
+ ;; If `so-long-max-lines' is nil, don't give up the search.
+ (let ((so-long-max-lines nil))
(normal-mode)
- (should (eq major-mode 'so-long-mode))))))
+ (should (eq major-mode 'so-long-mode)))
+ ;; If `so-long-skip-leading-comments' is nil, all lines are
+ ;; counted, and so the shebang line counts, which makes the
+ ;; long line one line further away.
+ (let ((so-long-skip-leading-comments nil)
+ (so-long-max-lines (1+ so-long-max-lines)))
+ (normal-mode)
+ (should (eq major-mode
+ (cond ((eq so-long-predicate
#'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate
#'so-long-statistics-excessive-p)
+ 'so-long-mode))))
+ (let ((so-long-max-lines (1+ so-long-max-lines)))
+ (normal-mode)
+ (should (eq major-mode 'so-long-mode)))))))
(ert-deftest so-long-tests-invisible-buffer-function ()
"Call `so-long-invisible-buffer-function' in invisible buffers."
@@ -180,7 +210,7 @@
;; From Emacs 27 the `display-buffer' call is insufficient.
;; The various 'window change functions' are now invoked by the
;; redisplay, and redisplay does nothing at all in batch mode,
- ;; so we cannot test under this revised behavior. Refer to:
+ ;; so we cannot test under this revised behaviour. Refer to:
;; https://lists.gnu.org/r/emacs-devel/2019-10/msg00971.html
;; For interactive (non-batch) test runs, calling `redisplay'
;; does do the trick; so do that first.
@@ -195,7 +225,9 @@
;; Emacs adds the framework necessary to make `redisplay' work
;; in batch mode.
(unless (eq so-long--active t)
- (run-window-configuration-change-hook))))
+ (with-suppressed-warnings
+ ((obsolete run-window-configuration-change-hook))
+ (run-window-configuration-change-hook)))))
(so-long-tests-assert-and-revert 'so-long-mode))
;; `so-long-invisible-buffer-function' is `nil'.
(with-temp-buffer
@@ -230,7 +262,9 @@
(redisplay)
(when noninteractive
(unless (eq so-long--active t)
- (run-window-configuration-change-hook))))
+ (with-suppressed-warnings
+ ((obsolete run-window-configuration-change-hook))
+ (run-window-configuration-change-hook)))))
(should (eq major-mode 'emacs-lisp-mode))))
(ert-deftest so-long-tests-actions ()
@@ -323,20 +357,76 @@
(normal-mode)
(should (eq major-mode 'so-long-mode)))))
+(ert-deftest so-long-tests-preserved-variables-and-modes ()
+ "Preserved variables and minor modes when using `so-long-mode'."
+ ;; Test the user options `so-long-mode-preserved-variables' and
+ ;; `so-long-mode-preserved-minor-modes'. The minor mode `view-mode'
+ ;; is 'preserved' by default (using both options).
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (normal-mode)
+ ;; We enable `view-mode' before triggering `so-long'.
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (view-mode 1)
+ (should (eq view-mode t))
+ (should (eq buffer-read-only t))
+ (so-long-tests-remember)
+ (let ((so-long-action 'so-long-mode)
+ (menu (so-long-menu)))
+ (so-long)
+ (so-long-tests-assert-active 'so-long-mode)
+ (should (eq view-mode t))
+ (should (eq buffer-read-only t))
+ ;; Revert.
+ (funcall (lookup-key menu [so-long-revert]))
+ (so-long-tests-assert-reverted 'so-long-mode)
+ (should (eq view-mode t))
+ (should (eq buffer-read-only t))
+ ;; Disable `view-mode'. Note that without the preserved
+ ;; variables, the conflict between how `view-mode' and `so-long'
+ ;; each deal with the buffer's original `buffer-read-only' value
+ ;; would lead to a situation whereby the buffer would still be
+ ;; read-only after `view-mode' had been disabled.
+ (view-mode 0)
+ (should (eq view-mode nil))
+ (should (eq buffer-read-only nil))))
+ ;; Without `view-mode'.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (normal-mode)
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (should (eq view-mode nil))
+ (so-long-tests-remember)
+ (let ((so-long-action 'so-long-mode)
+ (menu (so-long-menu)))
+ (so-long)
+ (so-long-tests-assert-active 'so-long-mode)
+ (should (eq view-mode nil))
+ ;; Revert.
+ (funcall (lookup-key menu [so-long-revert]))
+ (so-long-tests-assert-reverted 'so-long-mode)
+ (should (eq view-mode nil)))))
+
(ert-deftest so-long-tests-predicate ()
"Custom predicate function."
;; Test the `so-long-predicate' user option.
+ ;; Always true. Trigger when we normally wouldn't.
(with-temp-buffer
(display-buffer (current-buffer))
(insert "#!emacs\n")
- ;; Always false.
- (let ((so-long-predicate #'ignore))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode)))
- ;; Always true.
(let ((so-long-predicate (lambda () t)))
(normal-mode)
- (should (eq major-mode 'so-long-mode)))))
+ (should (eq major-mode 'so-long-mode))))
+ ;; Always false. Don't trigger when we normally would.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (let ((so-long-predicate #'ignore))
+ (normal-mode)
+ (should (eq major-mode 'emacs-lisp-mode)))))
(ert-deftest so-long-tests-file-local-action ()
"File-local action."
@@ -405,7 +495,10 @@
(insert ,local-vars)
(normal-mode)
;; Remember the `emacs-lisp-mode' state. The other cases
- ;; will validate the 'reverted' state against this.
+ ;; will validate the 'reverted' state against this. (Note
+ ;; that we haven't displayed the buffer, and therefore only
+ ;; `so-long-invisible-buffer-function' has acted, so we are
+ ;; still remembering the 'before' state.)
(so-long-tests-remember)
(should (eq major-mode 'emacs-lisp-mode)))
;; Downgrade the action from major mode to minor mode.
diff --git a/test/lisp/so-long-tests/spelling-tests.el
b/test/lisp/so-long-tests/spelling-tests.el
index 0be8555..f778b64 100644
--- a/test/lisp/so-long-tests/spelling-tests.el
+++ b/test/lisp/so-long-tests/spelling-tests.el
@@ -57,7 +57,7 @@
(unwind-protect
(cl-letf (((symbol-function 'ispell-command-loop)
(lambda (_miss _guess word _start _end)
- (message "Unrecognized word: %s." word)
+ (message "Unrecognised word: %s." word)
(throw 'mistake t))))
(catch 'mistake
(find-library "so-long")
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 375251c..b57982a 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -477,7 +477,7 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350.";
(add-hook 'subr-tests--hook 'f7 90)
(add-hook 'subr-tests--hook 'f8 t)
(should (equal subr-tests--hook '(f5 f6 f2 f1 f4 f3 f7 f8)))
- ;; Make sue `nil' is equivalent to 0.
+ ;; Make sure `nil' is equivalent to 0.
(add-hook 'subr-tests--hook 'f9 0)
(add-hook 'subr-tests--hook 'f10)
(should (equal subr-tests--hook '(f5 f10 f9 f6 f2 f1 f4 f3 f7 f8)))
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index 07eb8bb..fba6f21 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -190,4 +190,37 @@ position to retrieve THING.")
(goto-char 2)
(should (eq (symbol-at-point) nil))))
+(defun test--number (number pos)
+ (with-temp-buffer
+ (insert (format "%s\n" number))
+ (goto-char (point-min))
+ (forward-char pos)
+ (number-at-point)))
+
+(ert-deftest test-numbers-none ()
+ (should (equal (test--number "foo" 0) nil)))
+
+(ert-deftest test-numbers-decimal ()
+ (should (equal (test--number "42" 0) 42))
+ (should (equal (test--number "42" 1) 42))
+ (should (equal (test--number "42" 2) 42)))
+
+(ert-deftest test-numbers-hex-lisp ()
+ (should (equal (test--number "#x42" 0) 66))
+ (should (equal (test--number "#x42" 1) 66))
+ (should (equal (test--number "#x42" 2) 66))
+ (should (equal (test--number "#xf00" 0) 3840))
+ (should (equal (test--number "#xf00" 1) 3840))
+ (should (equal (test--number "#xf00" 2) 3840))
+ (should (equal (test--number "#xf00" 3) 3840)))
+
+(ert-deftest test-numbers-hex-c ()
+ (should (equal (test--number "0x42" 0) 66))
+ (should (equal (test--number "0x42" 1) 66))
+ (should (equal (test--number "0x42" 2) 66))
+ (should (equal (test--number "0xf00" 0) 3840))
+ (should (equal (test--number "0xf00" 1) 3840))
+ (should (equal (test--number "0xf00" 2) 3840))
+ (should (equal (test--number "0xf00" 3) 3840)))
+
;;; thingatpt.el ends here
diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el
index e42a58a..0d64320 100644
--- a/test/lisp/time-stamp-tests.el
+++ b/test/lisp/time-stamp-tests.el
@@ -904,17 +904,23 @@ the other expected results for hours greater than 99 with
non-zero seconds."
ert-test-list
(list
`(ert-deftest ,(intern (concat "formatz-" form-string "-hhmm")) ()
+ ,(concat "Tests time-stamp format " form-string
+ " with whole hours or minutes.")
(should (equal (formatz ,form-string (fz-make+zone 0))
,(car hour-mod)))
(formatz-hours-exact-helper ,form-string ',(cdr hour-mod))
(should (equal (formatz ,form-string (fz-make+zone 0 30))
,(car mins-mod)))
(formatz-nonzero-minutes-helper ,form-string ',(cdr mins-mod)))
- `(ert-deftest ,(intern (concat "formatz-" form-string "-secs")) ()
+ `(ert-deftest ,(intern (concat "formatz-" form-string "-seconds")) ()
+ ,(concat "Tests time-stamp format " form-string
+ " with offsets that have non-zero seconds.")
(should (equal (formatz ,form-string (fz-make+zone 0 0 30))
,(car secs-mod)))
(formatz-nonzero-seconds-helper ,form-string ',(cdr secs-mod)))
- `(ert-deftest ,(intern (concat "formatz-" form-string "-big")) ()
+ `(ert-deftest ,(intern (concat "formatz-" form-string "-threedigit"))
()
+ ,(concat "Tests time-stamp format " form-string
+ " with offsets that are 100 hours or greater.")
(should (equal (formatz ,form-string (fz-make+zone 100))
,(car big-mod)))
(formatz-hours-big-helper ,form-string ',(cdr big-mod))
@@ -954,6 +960,7 @@ the other expected results for hours greater than 99 with
non-zero seconds."
;; The legacy exception for %z in time-stamp will need to remain
;; through at least 2024 and Emacs 28.
(ert-deftest formatz-%z-spotcheck ()
+ "Spot-checks internal implementation of time-stamp format %z."
(should (equal (format-time-offset "%z" (fz-make+zone 0)) "+0000"))
(should (equal (format-time-offset "%z" (fz-make+zone 0 30)) "+0030"))
(should (equal (format-time-offset "%z" (fz-make+zone 0 0 30)) "+000030"))
diff --git a/test/lisp/time-tests.el b/test/lisp/time-tests.el
index 3cf8b54..88b7638 100644
--- a/test/lisp/time-tests.el
+++ b/test/lisp/time-tests.el
@@ -50,6 +50,7 @@
(? (| "AM" "PM"))
" " (+ (| digit "."))
(? " Mail")
+ " "
string-end)
display-time-string))))
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 123f2e8..11f842e 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -1345,8 +1345,8 @@ with parameters from the *Messages* buffer modification."
(add-hook 'kill-buffer-hook kbh nil t)
(add-hook 'kill-buffer-query-functions kbqf nil t)
(kill-buffer))
- (with-temp-buffer)
- (with-output-to-string)
+ (with-temp-buffer (ignore))
+ (with-output-to-string (ignore))
(should-not run-bluh)
(should-not run-kbh)
(should-not run-kbqf)
@@ -1361,4 +1361,42 @@ with parameters from the *Messages* buffer modification."
(should run-kbqf))
(remove-hook 'buffer-list-update-hook bluh))))
+(ert-deftest buffer-tests-inhibit-buffer-hooks-indirect ()
+ "Indirect buffers do not call `get-buffer-create'."
+ (dolist (inhibit '(nil t))
+ (let ((base (get-buffer-create "foo" inhibit)))
+ (unwind-protect
+ (dotimes (_i 11)
+ (let* (flag*
+ (flag (lambda () (prog1 t (setq flag* t))))
+ (indirect (make-indirect-buffer base "foo[indirect]" nil
+ inhibit)))
+ (unwind-protect
+ (progn
+ (with-current-buffer indirect
+ (add-hook 'kill-buffer-query-functions flag nil t))
+ (kill-buffer indirect)
+ (if inhibit
+ (should-not flag*)
+ (should flag*)))
+ (let (kill-buffer-query-functions)
+ (when (buffer-live-p indirect)
+ (kill-buffer indirect))))))
+ (let (kill-buffer-query-functions)
+ (when (buffer-live-p base)
+ (kill-buffer base)))))))
+
+(ert-deftest zero-length-overlays-and-not ()
+ (with-temp-buffer
+ (insert "hello")
+ (let ((long-overlay (make-overlay 2 4))
+ (zero-overlay (make-overlay 3 3)))
+ ;; Exclude.
+ (should (= (length (overlays-at 3)) 1))
+ (should (eq (car (overlays-at 3)) long-overlay))
+ ;; Include.
+ (should (= (length (overlays-in 3 3)) 2))
+ (should (memq long-overlay (overlays-in 3 3)))
+ (should (memq zero-overlay (overlays-in 3 3))))))
+
;;; buffer-tests.el ends here
diff --git a/test/src/emacs-module-resources/mod-test.c
b/test/src/emacs-module-resources/mod-test.c
index ad59cfc..5720af8 100644
--- a/test/src/emacs-module-resources/mod-test.c
+++ b/test/src/emacs-module-resources/mod-test.c
@@ -288,6 +288,8 @@ struct super_struct
char large_unused_buffer[512];
};
+static void signal_errno (emacs_env *, char const *);
+
/* Return a new user-pointer to a super_struct, with amazing_int set
to the passed parameter. */
static emacs_value
@@ -295,6 +297,8 @@ Fmod_test_userptr_make (emacs_env *env, ptrdiff_t nargs,
emacs_value args[],
void *data)
{
struct super_struct *p = calloc (1, sizeof *p);
+ if (!p)
+ signal_errno (env, "calloc");
p->amazing_int = env->extract_integer (env, args[0]);
return env->make_user_ptr (env, free, p);
}
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index b989c97..f4d123b 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -160,4 +160,26 @@ Also check that an encoding error can appear in a symlink."
(should-error (file-exists-p "/foo\0bar")
:type 'wrong-type-argument))
+(ert-deftest fileio-tests/file-name-concat ()
+ (should (equal (file-name-concat "foo" "bar") "foo/bar"))
+ (should (equal (file-name-concat "foo" "bar") "foo/bar"))
+ (should (equal (file-name-concat "foo" "bar" "zot") "foo/bar/zot"))
+ (should (equal (file-name-concat "foo/" "bar") "foo/bar"))
+ (should (equal (file-name-concat "foo//" "bar") "foo//bar"))
+ (should (equal (file-name-concat "foo/" "bar/" "zot") "foo/bar/zot"))
+ (should (equal (file-name-concat "fóo" "bar") "fóo/bar"))
+ (should (equal (file-name-concat "foo" "bár") "foo/bár"))
+ (should (equal (file-name-concat "fóo" "bár") "fóo/bár"))
+ (let ((string (make-string 5 ?a)))
+ (should (not (multibyte-string-p string)))
+ (aset string 2 255)
+ (should (not (multibyte-string-p string)))
+ (should (equal (file-name-concat "fóo" string) "fóo/aa\377aa")))
+ (should (equal (file-name-concat "foo") "foo"))
+ (should (equal (file-name-concat "foo/") "foo/"))
+ (should (equal (file-name-concat "foo" "") "foo"))
+ (should (equal (file-name-concat "foo" "" "" "" nil) "foo"))
+ (should (equal (file-name-concat "" "bar") "bar"))
+ (should (equal (file-name-concat "" "") "")))
+
;;; fileio-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index b64c82c..9bab523 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -28,6 +28,7 @@
(require 'puny)
(require 'subr-x)
(require 'dns)
+(require 'url-http)
;; Timeout in seconds; the test fails if the timeout is reached.
(defvar process-test-sentinel-wait-timeout 2.0)
@@ -626,6 +627,8 @@ FD_SETSIZE file descriptors (Bug#24325)."
FD_SETSIZE file descriptors (Bug#24325)."
(skip-unless (featurep 'make-network-process '(:server t)))
(skip-unless (featurep 'make-network-process '(:family local)))
+ ;; Avoid hang due to connect/accept handshake on Cygwin (bug#49496).
+ (skip-unless (not (eq system-type 'cygwin)))
(with-timeout (60 (ert-fail "Test timed out"))
(process-tests--with-temp-directory directory
(process-tests--with-processes processes
@@ -914,5 +917,34 @@ Return nil if FILENAME doesn't exist."
;; ...and the change description should be "interrupt".
(should (equal '("interrupt\n") events)))))
+(ert-deftest process-async-https-with-delay ()
+ "Bug#49449: asynchronous TLS connection with delayed completion."
+ (skip-unless (and internet-is-working (gnutls-available-p)))
+ (let* ((status nil)
+ (buf (url-http
+ #s(url "https" nil nil "elpa.gnu.org" nil
+ "/packages/archive-contents" nil nil t silent t t)
+ (lambda (s) (setq status s))
+ '(nil) nil 'tls)))
+ (unwind-protect
+ (progn
+ ;; Busy-wait for 1 s to allow for the TCP connection to complete.
+ (let ((delay 1.0)
+ (t0 (float-time)))
+ (while (< (float-time) (+ t0 delay))))
+ ;; Wait for the entire operation to finish.
+ (let ((limit 4.0)
+ (t0 (float-time)))
+ (while (and (null status)
+ (< (float-time) (+ t0 limit)))
+ (sit-for 0.1)))
+ (should status)
+ (should-not (assq :error status))
+ (should buf)
+ (should (> (buffer-size buf) 0))
+ )
+ (when buf
+ (kill-buffer buf)))))
+
(provide 'process-tests)
;;; process-tests.el ends here
diff --git a/test/src/search-tests.el b/test/src/search-tests.el
new file mode 100644
index 0000000..b7b4ab9
--- /dev/null
+++ b/test/src/search-tests.el
@@ -0,0 +1,42 @@
+;;; search-tests.el --- tests for search.c functions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015-2016, 2018-2021 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)
+
+(ert-deftest test-replace-match-modification-hooks ()
+ (let ((ov-set nil))
+ (with-temp-buffer
+ (insert "1 abc")
+ (setq ov-set (make-overlay 3 5))
+ (overlay-put
+ ov-set 'modification-hooks
+ (list (lambda (o after &rest _args)
+ (when after
+ (let ((inhibit-modification-hooks t))
+ (save-excursion
+ (goto-char 2)
+ (insert "234")))))))
+ (goto-char 3)
+ (if (search-forward "bc")
+ (replace-match "bcd"))
+ (should (= (point) 10)))))
+
+;;; search-tests.el ends here