Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-14 12:31:25 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'master' into feature/positioned-lambdas

Browse source
This commit is contained in:
Alan Mackenzie 2024-03-24 15:50:26 +00:00
commit ab7e5f9fac
215 changed files with 6206 additions and 3175 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
CONTRIBUTE
View file

@ -237,6 +237,8 @@ formatting them:
particular, gnu.org and fsf.org URLs should start with "https:".
- Commit messages should contain only printable UTF-8 characters.
However, we ask that non-ASCII characters be used only if strictly
necessary, not just for aesthetic purposes.
- Commit messages should not contain the "Signed-off-by:" lines that
are used in some other projects.

7
admin/MAINTAINERS
View file

@ -360,6 +360,9 @@ Po Lu
X11 and GTK xwidget support in src/xwidget.c
Precision pixel scrolling in lisp/pixel-scroll.el
Daniel Pettersson
lisp/jsonrpc.el
==============================================================================
3. Externally maintained packages.
==============================================================================
@ -378,9 +381,7 @@ Tramp
Modus themes
Maintainer: Protesilaos Stavrou
Repository: https://git.sr.ht/~protesilaos
Mailing list: https://lists.sr.ht/~protesilaos/modus-themes
Bug Reports: M-x modus-themes-report-bug
Repository: https://github.com/protesilaos/modus-themes
doc/misc/modus-themes.org
etc/themes/modus*.el

4
admin/notes/bugtracker
View file

@ -430,8 +430,8 @@ reassign 123 spam
*** To change the title of a bug:
retitle 123 Some New Title
*** To change the submitter address:
submitter 123 none@example.com
*** To change the submitter name and address:
submitter 123 J. Hacker <none@example.com>
Note that it does not seem to work to specify "Submitter:" in the
pseudo-header when first reporting a bug.

2
build-aux/ndk-build-helper-1.mk
View file

@ -94,7 +94,7 @@ endef
# dependencies can be ignored while building a shared library, as they
# will be linked in to the resulting shared object file later.
SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ log liblog android libandroid
SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ stlport libstlport gnustl libgnustl c++ libc++ log liblog android libandroid
$(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_SHARED_LIBRARIES)),$(eval $(call add-so-name,$(module))))
$(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_SHARED_LIBRARIES) $(LOCAL_STATIC_LIBRARIES) $(LOCAL_WHOLE_STATIC_LIBRARIES)),$(eval $(call add-includes,$(module))))

2
build-aux/ndk-build-helper-2.mk
View file

@ -87,7 +87,7 @@ endef
# Resolve additional dependencies based on LOCAL_STATIC_LIBRARIES and
# LOCAL_SHARED_LIBRARIES.
SYSTEM_LIBRARIES = z libz libc c libdl dl libstdc++ stdc++ log liblog android libandroid
SYSTEM_LIBRARIES = z libz libc c libdl dl libstdc++ stdc++ stlport libstlport gnustl libgnustl c++ libc++ log liblog android libandroid
$(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_STATIC_LIBRARIES) $(LOCAL_WHOLE_STATIC_LIBRARIES)),$(eval $(call add-a-name,$(module))))
$(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_SHARED_LIBRARIES)),$(eval $(call add-so-name,$(module))))

12
configure.ac
View file

@ -171,7 +171,6 @@ AS_IF([test "$XCONFIGURE" = "android"],[
# Make sure to pass through the CFLAGS, as older versions of the
# NDK require them to be able to find system includes.
with_ndk_path="$android_ndk_path"
with_ndk_cxx_shared="$android_ndk_cxx_shared"
with_ndk_cxx="$android_ndk_cxx"
ndk_INIT([$android_abi], [$ANDROID_SDK], [cross/ndk-build],
[$ANDROID_CFLAGS])
@ -1233,7 +1232,7 @@ package will likely install on older systems but crash on startup.])
passthrough="$passthrough --with-harfbuzz=$with_harfbuzz"
passthrough="$passthrough --with-threads=$with_threads"
# Now pass through some checking options.
# Now pass through some checking-related options.
emacs_val="--enable-check-lisp-object-type=$enable_check_lisp_object_type"
passthrough="$passthrough $emacs_val"
@ -1243,7 +1242,6 @@ package will likely install on older systems but crash on startup.])
AS_IF([XCONFIGURE=android ANDROID_CC="$ANDROID_CC" \
ANDROID_SDK="$android_sdk" android_abi=$android_abi \
android_ndk_path="$with_ndk_path" \
android_ndk_cxx_shared="$with_ndk_cxx_shared" \
android_ndk_cxx="$android_ndk_cxx" \
$CONFIG_SHELL $0 $passthrough], [],
[AC_MSG_ERROR([Failed to cross-configure Emacs for android.])])
@ -1570,7 +1568,13 @@ AC_DEFUN_ONCE([gl_STDLIB_H],
# Initialize gnulib right after choosing the compiler.
dnl Amongst other things, this sets AR and ARFLAGS.
gl_EARLY
ndk_LATE
# ndk_LATE must be enclosed in this conditional to prevent the
# AC_PROG_CXX it indirectly requires from being expanded at top level.
if test "$ndk_INITIALIZED" = "yes"; then
ndk_LATE_EARLY
ndk_LATE
fi
if test "$ac_test_CFLAGS" != set; then
# It's helpful to have C macros available to GDB, so prefer -g3 to -g

26
cross/ndk-build/Makefile.in
View file

@ -24,15 +24,17 @@
srcdir = @srcdir@
# This is a list of Android.mk files which provide targets.
NDK_BUILD_ANDROID_MK = @NDK_BUILD_ANDROID_MK@
NDK_BUILD_ARCH = @NDK_BUILD_ARCH@
NDK_BUILD_ABI = @NDK_BUILD_ABI@
NDK_BUILD_SDK = @NDK_BUILD_SDK@
NDK_BUILD_CC = @NDK_BUILD_CC@
NDK_BUILD_CXX = @NDK_BUILD_CXX@
NDK_BUILD_AR = @NDK_BUILD_AR@
NDK_BUILD_NASM = @NDK_BUILD_NASM@
NDK_BUILD_CFLAGS = @NDK_BUILD_CFLAGS@
NDK_BUILD_ANDROID_MK = @NDK_BUILD_ANDROID_MK@
NDK_BUILD_ARCH = @NDK_BUILD_ARCH@
NDK_BUILD_ABI = @NDK_BUILD_ABI@
NDK_BUILD_SDK = @NDK_BUILD_SDK@
NDK_BUILD_CC = @NDK_BUILD_CC@
NDK_BUILD_CXX = @NDK_BUILD_CXX@
NDK_BUILD_CXX_STL = @NDK_BUILD_CXX_STL@
NDK_BUILD_CXX_LDFLAGS = @NDK_BUILD_CXX_LDFLAGS@
NDK_BUILD_AR = @NDK_BUILD_AR@
NDK_BUILD_NASM = @NDK_BUILD_NASM@
NDK_BUILD_CFLAGS = @NDK_BUILD_CFLAGS@
# This is a list of targets to build.
NDK_BUILD_MODULES = @NDK_BUILD_MODULES@
@ -58,8 +60,10 @@ NDK_BUILD_ANDROID_MK := $(call uniqify,$(NDK_BUILD_ANDROID_MK))
NDK_BUILD_MODULES := $(call uniqify,$(NDK_BUILD_MODULES))
# Define CFLAGS for compiling C++ code; this involves removing all
# -std=NNN options.
NDK_BUILD_CFLAGS_CXX := $(filter-out -std=%,$(NDK_BUILD_CFLAGS))
# -std=NNN options and inserting compilation options for the C++
# library.
NDK_BUILD_CFLAGS_CXX := $(filter-out -std=%,$(NDK_BUILD_CFLAGS)) \
$(NDK_BUILD_CXX_STL)
define subr-1

2
cross/ndk-build/ndk-build.mk.in
View file

@ -22,6 +22,8 @@
NDK_BUILD_MODULES = @NDK_BUILD_MODULES@
NDK_BUILD_CXX_SHARED = @NDK_BUILD_CXX_SHARED@
NDK_BUILD_CXX_STL = @NDK_BUILD_CXX_STL@
NDK_BUILD_CXX_LDFLAGS = @NDK_BUILD_CXX_LDFLAGS@
NDK_BUILD_ANY_CXX_MODULE = @NDK_BUILD_ANY_CXX_MODULE@
NDK_BUILD_SHARED =
NDK_BUILD_STATIC =

32
cross/ndk-build/ndk-resolve.mk
View file

@ -20,7 +20,7 @@
# which actually builds targets.
# List of system libraries to ignore.
NDK_SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ log liblog android libandroid
NDK_SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ stlport libstlport gnustl libgnustl c++ libc++ log liblog android libandroid
# Save information.
NDK_LOCAL_PATH_$(LOCAL_MODULE) := $(LOCAL_PATH)
@ -90,11 +90,35 @@ endif
# Likewise for libstdc++.
ifeq ($(strip $(1)),libstdc++)
NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += -lstdc++
NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
endif
ifeq ($(strip $(1)),dl)
NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += -lstdc++
ifeq ($(strip $(1)),stdc++)
NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
endif
ifeq ($(strip $(1)),libstlport)
NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
endif
ifeq ($(strip $(1)),stlport)
NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
endif
ifeq ($(strip $(1)),libgnustl)
NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
endif
ifeq ($(strip $(1)),gnustl)
NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
endif
ifeq ($(strip $(1)),libc++)
NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
endif
ifeq ($(strip $(1)),c++)
NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
endif
# Likewise for liblog.

14
doc/emacs/android.texi
View file

@ -143,11 +143,13 @@ that if that Emacs in turn does not start the Emacs server, subsequent
attempts to open the file with the wrapper will fail.
@cindex /content/by-authority directory, android
@cindex /content/by-authority-named directory, android
Some files are given to Emacs as ``content identifiers'' that the
system provides access to outside the normal filesystem APIs. Emacs
uses a pseudo-directory named @file{/content/by-authority} to access
those files. Do not make any assumptions about the contents of this
directory, or try to open files in it yourself.
uses pseudo-directories named @file{/content/by-authority} and
@file{/content/by-authority-named} to access those files. Do not make
any assumptions about the contents of this directory, or try to open
files in it yourself.
This feature is not provided on Android 4.3 and earlier, in which
case such files are copied to a temporary directory before being
@ -862,6 +864,12 @@ behalf of a specific frame, Emacs deletes the frame displayed within
that window.
@end itemize
When the system predates Android 5.0, the window manager will not
accept more than one user-created Emacs window. If frame creation gives
rise to windows in excess of this limit, the window manager will
arbitrarily select one of their number to display, with the rest
remaining invisible until that window is destroyed with its frame.
@cindex windowing limitations, android
@cindex frame parameters, android
Emacs only supports a limited subset of GUI features on Android; the

8
doc/emacs/files.texi
View file

@ -779,6 +779,12 @@ operations typically break hard links, disconnecting the file name you
visited from any alternate names for the same file. This has nothing
to do with Emacs---the version control system does it.
Some file storage services support @dfn{file versioning}: they
record history of previous versions of files, and allow reverting to
those previous versions. If you want to be able to do that with files
hosted by those services when editing them with Emacs, customize
@code{backup-by-copying} to a non-@code{nil} value.
@node Customize Save
@subsection Customizing Saving of Files
@ -2392,7 +2398,7 @@ multiply the size by the factor of @w{@code{1 + @var{n} / 10}}, so
@findex image-decrease-size
@kindex i - (Image mode)
@item i -
Decrease the image size (@code{image-increase-size}) by 20%. Prefix
Decrease the image size (@code{image-decrease-size}) by 20%. Prefix
numeric argument controls the decrement; the value of @var{n} means to
multiply the size by the factor of @w{@code{1 - @var{n} / 10}}, so
@w{@kbd{C-u 3 i -}} means to decrease the size by 30%.

7
doc/emacs/help.texi
View file

@ -310,6 +310,13 @@ name is defined as a Lisp function. Type @kbd{C-g} to cancel the
@kbd{C-h f} command if you don't really want to view the
documentation.
The function's documentation displayed by @code{describe-function}
includes more than just the documentation string and the signature of
the function. It also shows auxiliary information such as its type, the
file where it was defined, whether it has been declared obsolete, and
yet further information is often reachable by clicking or typing
@key{RET} on emphasized parts of the text.
@vindex help-enable-symbol-autoload
If you request help for an autoloaded function whose @code{autoload}
form (@pxref{Autoload,,, elisp, The Emacs Lisp Reference Manual})

28
doc/emacs/killing.texi
View file

@ -91,9 +91,11 @@ Delete the next character (@code{delete-char}).
@item M-\
Delete spaces and tabs around point (@code{delete-horizontal-space}).
@item M-x just-one-space
Delete spaces and tabs around point, leaving one space.
@item M-@key{SPC}
Delete spaces and tabs around point, leaving one space
(@code{just-one-space}).
Delete spaces and tabs around point in flexible ways
(@code{cycle-spacing}).
@item C-x C-o
Delete blank lines around the current line (@code{delete-blank-lines}).
@item M-^
@ -118,12 +120,13 @@ characters before and after point. With a prefix argument, this only
deletes spaces and tab characters before point.
@findex just-one-space
@code{just-one-space} does likewise but leaves a single space before
point, regardless of the number of spaces that existed previously
(even if there were none before). With a numeric argument @var{n}, it
leaves @var{n} spaces before point if @var{n} is positive; if @var{n}
is negative, it deletes newlines in addition to spaces and tabs,
leaving @minus{}@var{n} spaces before point.
@kbd{M-x just-one-space} deletes tabs and spaces around point, but
leaves a single space before point, regardless of the number of spaces
that existed previously (even if there were none before). With a
numeric argument @var{n}, it leaves @var{n} spaces before point if
@var{n} is positive; if @var{n} is negative, it deletes newlines in
addition to spaces and tabs, leaving @minus{}@var{n} spaces before
point.
@kindex M-SPC
@findex cycle-spacing
@ -131,7 +134,14 @@ leaving @minus{}@var{n} spaces before point.
The command @code{cycle-spacing} (@kbd{M-@key{SPC}}) acts like a more
flexible version of @code{just-one-space}. It performs different
space cleanup actions defined by @code{cycle-spacing-actions}, in a
cyclic manner, if you call it repeatedly in succession.
cyclic manner, if you call it repeatedly in succession. By default,
the first invocation does the same as @code{just-one-space}, the
second deletes all whitespace characters around point like
@code{delete-horizontal-space}, and the third restores the original
whitespace characters; then it cycles. If invoked with a prefix
argument, each action is given that value of the argument. The user
option @code{cycle-spacing-actions} can include other members; see the
doc string of that option for the details.
@kbd{C-x C-o} (@code{delete-blank-lines}) deletes all blank lines
after the current line. If the current line is blank, it deletes all

9
doc/emacs/misc.texi
View file

@ -3009,6 +3009,15 @@ buffer, and lets you navigate to those pages by hitting @kbd{RET}.
It is bound to @kbd{H}.
@vindex xwidget-webkit-disable-javascript
@cindex disabling javascript in webkit buffers
JavaScript is enabled by default inside WebKit buffers, which could be
undesirable, as Web sites often use it to track your online activity.
You can disable JavaScript in WebKit buffers by customizing the variable
@code{xwidget-webkit-disable-javascript} to a non-@code{nil} value.
You must kill all WebKit buffers for this setting to take effect, after
it is changed.
@node Browse-URL
@subsection Following URLs
@cindex World Wide Web

5
doc/emacs/rmail.texi
View file

@ -875,7 +875,10 @@ already composing, or to alter a message you have sent.
If you set the variable @code{rmail-mail-new-frame} to a
non-@code{nil} value, then all the Rmail commands to start sending a
message create a new frame to edit it in. This frame is deleted when
you send the message.
you send the message (but not if it is the only visible frame on the
current display, or if it's a text-mode frame). If this frame cannot
be deleted when you send the message, Emacs will try to reuse it for
composing subsequent messages.
@ignore
@c FIXME does not work with Message -> Kill Message
, or when you use the @samp{Cancel} item in the @samp{Mail} menu.

6
doc/lispref/buffers.texi
View file

@ -371,6 +371,12 @@ See the related function @code{generate-new-buffer} in @ref{Creating
Buffers}.
@end defun
@defun buffer-last-name &optional buffer
This function returns the previous name of @var{buffer}, before it was
killed or before the last time it was renamed. If nil or omitted,
@var{buffer} defaults to the current buffer.
@end defun
@node Buffer File Name
@section Buffer File Name
@cindex visited file

2
doc/lispref/control.texi
View file

@ -323,7 +323,7 @@ described below.
@defmac if-let spec then-form else-forms...
Evaluate each binding in @var{spec} in turn, like in @code{let*}
(@pxref{Local Variables}, stopping if a binding value is @code{nil}.
(@pxref{Local Variables}), stopping if a binding value is @code{nil}.
If all are non-@code{nil}, return the value of @var{then-form},
otherwise the last form in @var{else-forms}.
@end defmac

24
doc/lispref/display.texi
View file

@ -6056,6 +6056,30 @@ to make things match up, you should either specify @code{:scale 1.0}
when creating the image, or use the result of
@code{image-compute-scaling-factor} to compute the elements of the
map.
When an image's @code{:scale}, @code{:rotation}, or @code{:flip} is
changed, @code{:map} will be recomputed based on the value of
@code{:original-map} and the values of those transformation.
@item :original-map @var{original-map}
@cindex original image map
This specifies the untransformed image map which will be used to
recompute @code{:map} after the image's @code{:scale}, @code{:rotation},
or @code{:flip} is changed.
If @code{:original-map} is not specified when creating an image with
@code{create-image}, it will be computed based on the supplied
@code{:map}, as well as any of @code{:scale}, @code{:rotation}, or
@code{:flip} which are non-nil.
Conversely, if @code{:original-map} is specified but @code{:map} is not,
@code{:map} will be computed based on @code{:original-map},
@code{:scale}, @code{:rotation}, and @code{:flip}.
@defopt image-recompute-map-p
Set this user option to nil to prevent Emacs from automatically
recomputing an image @code{:map} based on its @code{:original-map}.
@end defopt
@end table
@defun image-mask-p spec &optional frame

4
doc/lispref/frames.texi
View file

@ -4052,8 +4052,8 @@ programs. It takes two optional arguments, @var{type} and
The @var{data-type} argument specifies the form of data conversion to
use, to convert the raw data obtained from another program into Lisp
data. @xref{X Selections}, for an enumeration of data types valid
under X, and @xref{Other Selections} for those elsewhere.
data. @xref{X Selections}, for an enumeration of data types valid under
X, and @pxref{Other Selections} for those elsewhere.
@end defun
@defopt selection-coding-system

8
doc/lispref/markers.texi
View file

@ -283,6 +283,14 @@ This function returns the position that @var{marker} points to, or
@code{nil} if it points nowhere.
@end defun
@defun marker-last-position marker
This function returns the last known position of @var{marker} in its
buffer. It behaves like @code{marker-position} with one exception: if
the buffer of @var{marker} has been killed, it returns the last position
of @var{marker} in that buffer before the buffer was killed, instead of
returning @code{nil}.
@end defun
@defun marker-buffer marker
This function returns the buffer that @var{marker} points into, or
@code{nil} if it points nowhere.

27
doc/lispref/objects.texi
View file

@ -1485,8 +1485,8 @@ types that are not built into Emacs.
@subsection Type Descriptors
A @dfn{type descriptor} is a @code{record} which holds information
about a type. Slot 1 in the record must be a symbol naming the type, and
@code{type-of} relies on this to return the type of @code{record}
about a type. The first slot in the record must be a symbol naming the type,
and @code{type-of} relies on this to return the type of @code{record}
objects. No other type descriptor slot is used by Emacs; they are
free for use by Lisp extensions.
@ -2175,7 +2175,7 @@ with references to further information.
function @code{type-of}. Recall that each object belongs to one and
only one primitive type; @code{type-of} tells you which one (@pxref{Lisp
Data Types}). But @code{type-of} knows nothing about non-primitive
types. In most cases, it is more convenient to use type predicates than
types. In most cases, it is preferable to use type predicates than
@code{type-of}.
@defun type-of object
@ -2207,6 +2207,27 @@ slot is returned; @ref{Records}.
@end example
@end defun
@defun cl-type-of object
This function returns a symbol naming @emph{the} type of
@var{object}. It usually behaves like @code{type-of}, except
that it guarantees to return the most precise type possible, which also
implies that the specific type it returns may change depending on the
Emacs version. For this reason, as a rule you should never compare its
return value against some fixed set of types.
@example
(cl-type-of 1)
@result{} fixnum
@group
(cl-type-of 'nil)
@result{} null
(cl-type-of (record 'foo))
@result{} foo
@end group
@end example
@end defun
@node Equality Predicates
@section Equality Predicates
@cindex equality

1
doc/lispref/os.texi
View file

@ -3244,6 +3244,7 @@ of parameters analogous to its namesake in
@item :on-action @var{on-action}
@item :on-cancel @var{on-close}
@item :actions @var{actions}
@item :timeout @var{timeout}
@item :resident @var{resident}
These have the same meaning as they do when used in calls to
@code{notifications-notify}, except that no more than three non-default

2
doc/lispref/strings.texi
View file

@ -1369,7 +1369,7 @@ given width and precision, if specified.
@item >
This flag causes the substitution to be truncated on the right to the
given width, if specified.
given width and precision, if specified.
@item ^
This flag converts the substituted text to upper case (@pxref{Case

117
doc/lispref/windows.texi
View file

@ -6264,15 +6264,10 @@ this function does is to restore the value of the variable
@code{minibuffer-selected-window}. In this case, the function returns
@code{nil}. Otherwise, it returns @code{t}.
If the buffer of a window of @var{configuration} has been killed since
@var{configuration} was made, that window is, as a rule, removed from
the restored configuration. However, if that window is the last window
remaining in the restored configuration, another live buffer is shown in
it. Also, if the variable @var{window-kept-windows-functions} is
non-@code{nil}, any window whose buffer is now dead is not deleted.
Rather, this function will show another live buffer in that window and
include an entry for that window when calling any function in
@var{window-kept-windows-functions} (@pxref{Window Hooks}).
This function consults the variable
@code{window-restore-killed-buffer-windows} (see below) when it tries to
restore a window whose buffer was killed after @var{configuration} was
recorded.
Here is a way of using this function to get the same effect as
@code{save-window-excursion}:
@ -6361,14 +6356,9 @@ a live window, it is replaced by a new live window created on the same
frame before putting @var{state} into it. If @var{window} is @code{nil},
it puts the window state into a new window.
If the buffer of any window recorded in @var{state} has been killed
since @var{state} was made, that window is, as a rule, not restored.
However, if that window is the only window in @var{state}, another live
buffer will be shown in it. Also, if the variable
@var{window-kept-windows-functions} is non-@code{nil}, any window whose
buffer is now dead is restored. This function will show another live
buffer in it and include an entry for that window when calling a
function in @var{window-kept-windows-functions} (@pxref{Window Hooks}).
This function consults the variable
@code{window-restore-killed-buffer-windows} (see below) when it tries to
restore a window whose buffer was killed after @var{state} was recorded.
If the optional argument @var{ignore} is non-@code{nil}, it means to ignore
minimum window sizes and fixed-size restrictions. If @var{ignore}
@ -6376,6 +6366,78 @@ is @code{safe}, this means windows can get as small as one line
and/or two columns.
@end defun
By default, @code{set-window-configuration} and @code{window-state-put}
may delete a window from the restored configuration when they find out
that its buffer was killed since the corresponding configuration or
state has been recorded. The variable described next can be used to
fine-tune that behavior.
@cindex restoring windows whose buffers have been killed
@defvar window-restore-killed-buffer-windows
This variable specifies how @code{set-window-configuration} and
@code{window-state-put} shall handle a window whose buffer has been
killed since the corresponding configuration or state was recorded. Any
such window may be live---in which case it shows some other buffer---or
dead at the time one of these functions is called. Usually,
@code{set-window-configuration} leaves the window alone if it is live
while @code{window-state-put} deletes it.
The following values can be used to override the default behavior for
dead windows in the case of @code{set-window-configuration} and for dead
and live windows in the case of @code{window-state-put}.
@table @asis
@item @code{t}
This value means to unconditionally restore the window and show some
other buffer in it.
@item @code{delete}
This means to unconditionally try to delete the window.
@item @code{dedicated}
This means to try to delete the window if and only if it is dedicated to
its buffer.
@item @code{nil}
This is the default, and it means that @code{set-window-configuration}
will try to delete the window if and only if it is dedicated to its
buffer, and @code{window-state-put} will unconditionally try to delete
it.
@item a function
This means to restore the window and show some other buffer in it, like
if the value is @code{t}, and also add an entry for that window to a
list that will be later passed as the second argument to that function.
@end table
If a window cannot be deleted (typically, because it is the last window
on its frame), @code{set-window-configuration} and
@code{window-state-put} will show another buffer in it.
If the value of this variable is a function, that function should take
three arguments. The first argument specifies the frame whose windows
have been restored. The third argument is either the symbol
@code{configuration} if the windows are restored by
@code{set-window-configuration}, or the symbol @code{state} if the
windows are restored by @code{window-state-put}.
The second argument specifies a list of entries for @emph{all} windows
whose previous buffers have been found dead at the time
@code{set-window-configuration} or @code{window-state-put} tried to
restore them (minibuffer windows are excluded). This means that the
function may also delete windows which were found live by
@code{set-window-configuration}.
Each entry in the list that is passed as the second argument to the
function is itself a list of six values: the window whose buffer was
found dead, the dead buffer or its name, the positions of window-start
(@pxref{Window Start and End}) and window-point (@pxref{Window Point})
of the buffer in that window, the dedicated state of the window as
previously reported by @code{window-dedicated-p} and a flag that is
@code{t} if the window has been found to be alive by
@code{set-window-configuration} and @code{nil} otherwise.
@end defvar
The functions @code{window-state-get} and @code{window-state-put} also
allow exchanging the contents of two live windows. The following
function does precisely that:
@ -6636,27 +6698,6 @@ Lock fontification function, which will be called whenever parts of a
buffer are (re)fontified because a window was scrolled or its size
changed. @xref{Other Font Lock Variables}.
@cindex window kept windows functions
@defvar window-kept-windows-functions
This variable holds a list of functions that Emacs will call after
restoring a window configuration via @code{set-window-configuration} or
state via @code{window-state-put} (@pxref{Window Configurations}). When
the value of this variable is non-@code{nil}, these functions will not
delete any window whose buffer has been killed since the corresponding
configuration or state was saved, but show some live buffer in it.
The value should be a list of functions that take two arguments. The
first argument specifies the frame whose windows have been restored.
The second argument specifies a list of entries for each window whose
buffer has been found dead at the time @code{set-window-configuration}
or @code{window-state-put} tried to restore it. Each entry is a list of
four values - the window whose buffer was found dead, the dead buffer,
and the last known positions of start and point of the buffer in that
window. Any function run by this hook should check that the window is
live since another function run by this hook may have deleted it in the
meantime.
@end defvar
@cindex window change functions
The remainder of this section covers six hooks that are called
during redisplay provided a significant, non-scrolling change of a

12
doc/misc/calc.texi
View file

@ -6,6 +6,7 @@
@settitle GNU Emacs Calc Manual
@include docstyle.texi
@setchapternewpage odd
@documentencoding UTF-8
@comment %**end of header (This is for running Texinfo on a region.)
@include emacsver.texi
@ -10572,12 +10573,11 @@ Non-decimal fractions are entered and displayed as
form). The numerator and denominator always use the same radix.
@ifnottex
Fractions may also be entered with @kbd{@U{2044}} (U+2044 FRACTION
SLASH) in place of any @kbd{:}. Precomposed fraction characters from
@kbd{@U{00BD}} (U+00BD VULGAR FRACTION ONE HALF) through
@kbd{@U{215E}} (U+215E VULGAR FRACTION SEVEN EIGHTHS) are supported as
well. Thus, @samp{2:3}, @samp{2@U{2044}3}, and @samp{@U{2154}} are all
equivalent.
Fractions may also be entered with @kbd{⁄} (U+2044 FRACTION SLASH) in
place of any @kbd{:}. Precomposed fraction characters from @kbd{½}
(U+00BD VULGAR FRACTION ONE HALF) through @kbd{⅞} (U+215E VULGAR
FRACTION SEVEN EIGHTHS) are supported as well. Thus, @samp{2:3},
@samp{2⁄3}, and @samp{⅞} are all equivalent.
@end ifnottex
@iftex
Fractions may also be entered with U+2044 FRACTION SLASH in place of

10
doc/misc/dired-x.texi
View file

@ -346,6 +346,16 @@ only match against the non-directory part of the file name. Set it to
match the file name relative to the buffer's top-level directory.
@end defvar
@defvar dired-omit-size-limit
If non-@code{nil}, @code{dired-omit-mode} will be effectively disabled
in directories whose listing has size (in bytes) larger than the value
of this option. Since omitting can be slow for very large directories,
this avoids having to wait before seeing the directory. This variable
is ignored when @code{dired-omit-mode} is called interactively, such as
by @kbd{C-x M-o}, so you can still enable omitting in the directory
after the initial display.
@end defvar
@cindex omitting additional files
@defvar dired-omit-marker-char
Temporary marker used by Dired to implement omitting. Should never be used

21
doc/misc/eww.texi
View file

@ -146,6 +146,27 @@ a new tab is created on the frame tab bar.
which part of the document contains the ``readable'' text, and will
only display this part. This usually gets rid of menus and the like.
When called interactively, this command toggles the display of the
readable parts. With a positive prefix argument, this command always
displays the readable parts, and with a zero or negative prefix, it
always displays the full page.
@vindex eww-readable-urls
If you want EWW to render a certain page in ``readable'' mode by
default, you can add a regular expression matching its URL to
@code{eww-readable-urls}. Each entry can either be a regular expression
in string form or a cons cell of the form
@w{@code{(@var{regexp} . @var{readability})}}. If @var{readability} is
non-@code{nil}, this behaves the same as the string form; otherwise,
URLs matching @var{regexp} will never be displayed in readable mode by
default. For example, you can use this to make all pages default to
readable mode, except for a few outliers:
@example
(setq eww-readable-urls '(("https://example\\.com/" . nil)
".*"))
@end example
@findex eww-toggle-fonts
@vindex shr-use-fonts
@kindex F

1433
doc/misc/modus-themes.org
View file

File diff suppressed because it is too large Load diff

28
doc/misc/transient.texi
View file

@ -31,7 +31,7 @@ General Public License for more details.
@finalout
@titlepage
@title Transient User and Developer Manual
@subtitle for version 0.5.2
@subtitle for version 0.6.0
@author Jonas Bernoulli
@page
@vskip 0pt plus 1filll
@ -53,7 +53,7 @@ resource to get over that hurdle is Psionic K's interactive tutorial,
available at @uref{https://github.com/positron-solutions/transient-showcase}.
@noindent
This manual is for Transient version 0.5.2.
This manual is for Transient version 0.6.0.
@insertcopying
@end ifnottex
@ -554,7 +554,7 @@ state, you have to make sure that that state is currently active.
@item @kbd{C-x a} (@code{transient-toggle-level-limit})
@kindex C-x a
@findex transient-toggle-level-limit
This command toggle whether suffixes that are on levels lower than
This command toggle whether suffixes that are on levels higher than
the level specified by @code{transient-default-level} are temporarily
available anyway.
@end table
@ -1206,9 +1206,19 @@ The returned children must have the same form as stored in the
prefix's @code{transient--layout} property, but it is often more convenient
to use the same form as understood by @code{transient-define-prefix},
described below. If you use the latter approach, you can use the
@code{transient-parse-child} and @code{transient-parse-children} functions to
@code{transient-parse-suffixes} and @code{transient-parse-suffix} functions to
transform them from the convenient to the expected form.
If you explicitly specify children and then transform them using
@code{:setup-chilren}, then the class of the group is determined as usual,
based on explicitly specified children.
If you do not explicitly specify children and thus rely solely on
@code{:setup-children}, then you must specify the class using @code{:class}.
For backward compatibility, if you fail to do so, @code{transient-column}
is used and a warning is displayed. This warning will eventually
be replaced with an error.
@item
The boolean @code{:pad-keys} argument controls whether keys of all suffixes
contained in a group are right padded, effectively aligning the
@ -1220,11 +1230,11 @@ The @var{ELEMENT}s are either all subgroups, or all suffixes and strings.
subgroups with commands at the same level, though in principle there
is nothing that prevents that.)
If the @var{ELEMENT}s are not subgroups, then they can be a mixture of lists
that specify commands and strings. Strings are inserted verbatim into
the buffer. The empty string can be used to insert gaps between
suffixes, which is particularly useful if the suffixes are outlined as
a table.
If the @var{ELEMENT}s are not subgroups, then they can be a mixture of
lists, which specify commands, and strings. Strings are inserted
verbatim into the buffer. The empty string can be used to insert gaps
between suffixes, which is particularly useful if the suffixes are
outlined as a table.
Inside group specifications, including inside contained suffix
specifications, nothing has to be quoted and quoting anyway is

13
doc/misc/vtable.texi
View file

@ -554,12 +554,19 @@ the object after this object; otherwise append to @var{table}. This
also updates the displayed table.
@end defun
@defun vtable-update-object table object old-object
Change @var{old-object} into @var{object} in @var{table}. This also
updates the displayed table.
@defun vtable-update-object table object &optional old-object
Update @var{object}'s representation in @var{table}. Optional argument
@var{old-object}, if non-@code{nil}, means to replace @var{old-object}
with @var{object} and redisplay the associated row in the table. In
either case, if the existing object is not found in the table (being
compared with @code{equal}), signal an error.
This has the same effect as calling @code{vtable-remove-object} and
then @code{vtable-insert-object}, but is more efficient.
Note a limitation: if the table's buffer is not in a visible window, or
if its window has changed width since it was updated, updating the table
is not possible, and an error is signaled.
@end defun
@defun vtable-column table index

101
etc/NEWS
View file

@ -108,6 +108,12 @@ to your init:
* Changes in Emacs 30.1
** 'describe-function' now shows the type of the function object.
The text used to say things like "car is is a built-in function"
whereas it now says "car is a primitive-function" where "primitive-function"
is the symbol returned by `cl-type-of` and you can click on it to get
information about that type.
** 'advice-remove' is now an interactive command.
When called interactively, 'advice-remove' now prompts for an advised
function to the advice to remove.
@ -283,8 +289,21 @@ right-aligned to is controlled by the new user option
It specifies whether the window of the displayed buffer should be
selected or deselected at the end of executing the current command.
+++
*** New variable 'window-restore-killed-buffer-windows'.
It specifies how 'set-window-configuration' and 'window-state-put'
should proceed with windows whose buffer was killed after the
corresponding configuration or state was recorded.
** Tab Bars and Tab Lines
---
*** New user option 'tab-bar-select-restore-windows'.
It defines what to do with windows whose buffer was killed
since the tab was last selected. By default it displays
a placeholder buffer that provides information about the name
of the killed buffer that was displayed in that window.
---
*** New user option 'tab-bar-tab-name-format-functions'.
It can be used to add, remove and reorder functions that change
@ -686,6 +705,12 @@ marked or clicked on files according to the OS conventions. For
example, on systems supporting XDG, this runs 'xdg-open' on the
files.
*** The default value of 'dired-omit-size-limit' was increased.
After performance improvements to omitting in large directories, the new
default value is 300k, up from 100k. This means 'dired-omit-mode' will
omit files in directories whose directory listing is up to 300 kilobytes
in size.
+++
*** 'dired-listing-switches' handles connection-local values if exist.
This allows to customize different switches for different remote machines.
@ -1041,6 +1066,24 @@ entries newer than the current page. To change the behavior when
browsing from "historical" pages, you can customize
'eww-before-browse-history-function'.
+++
*** 'eww-readable' now toggles display of the readable parts of a web page.
When called interactively, 'eww-readable' toggles whether to display
only the readable parts of a page or the full page. With a positive
prefix argument, it always displays the readable parts, and with a zero
or negative prefix, it always displays the full page.
+++
*** New option 'eww-readable-urls'.
This is a list of regular expressions matching the URLs where EWW should
display only the readable parts by default. For more details, see
"(eww) Basics" in the EWW manual.
---
*** New option 'eww-readable-adds-to-history'.
When non-nil (the default), calling 'eww-readable' adds a new entry to
the EWW page history.
** go-ts-mode
+++
@ -1129,6 +1172,12 @@ distracting and easily confused with actual code, or a significant
early aid that relieves you from moving the buffer or reaching for the
mouse to consult an error message.
** Flyspell
*** New user option 'flyspell-check-changes'.
When non-nil, Flyspell mode spell-checks only words that you edited; it
does not check unedited words just because you move point across them.
** JS mode.
The binding 'M-.' has been removed from the major mode keymaps in
'js-mode' and 'js-ts-mode', having it default to the global binding
@ -1319,6 +1368,18 @@ without specifying a file, like this:
(notifications-notify
:title "I am playing music" :app-icon 'multimedia-player)
** Image
+++
*** Image :map property is now recomputed when image is transformed.
Now images with clickable maps work as expected after you run commands
such as `image-increase-size', `image-decrease-size', `image-rotate',
`image-flip-horizontally', and `image-flip-vertically'.
+++
*** New user option 'image-recompute-map-p'
Set this option to nil to prevent Emacs from recomputing image maps.
** Image Dired
*** New user option 'image-dired-thumb-naming'.
@ -1437,6 +1498,12 @@ This allows the user to customize the key selection method, which can be
either by using a pop-up buffer or from the minibuffer. The pop-up
buffer method is the default, which preserves previous behavior.
** Xwidget Webkit
+++
*** New user option 'xwidget-webkit-disable-javascript'.
This allows disabling JavaScript in xwidget Webkit sessions.
* New Modes and Packages in Emacs 30.1
@ -1622,6 +1689,21 @@ values.
* Lisp Changes in Emacs 30.1
** New function 'help-fns-function-name'.
For named functions, it just returns the name and otherwise
it returns a short "unique" string that identifies the function.
In either case, the string is propertized so clicking on it gives
further details.
** New function 'cl-type-of'.
This function is like 'type-of' except that it sometimes returns
a more precise type. For example, for nil and t it returns 'null'
and 'boolean' respectively, instead of just 'symbol'.
** New function `primitive-function-p`.
This is like `subr-primitive-p` except that it returns t only if the
argument is a function rather than a special-form.
** Built-in types have now corresponding classes.
At the Lisp level, this means that things like (cl-find-class 'integer)
will now return a class object, and at the UI level it means that
@ -1794,6 +1876,16 @@ styles to skip eager fontification of completion candidates, which
improves performance. Such a Lisp program can then use the
'completion-lazy-hilit' function to fontify candidates just in time.
** New primitive 'buffer-last-name'.
It returns the name of a buffer before the last time it was renamed or
killed.
** New primitive 'marker-last-position'.
It returns the last position of a marker in its buffer even if that
buffer has been killed. ('marker-position' would return nil in that
case.)
** Functions and variables to transpose sexps
+++
@ -2153,6 +2245,15 @@ aforementioned functions:
(and (arrayp executing-kbd-macro)
(>= executing-kbd-macro-index (length executing-kbd-macro))))
+++
** 'vtable-update-object' updates an existing object with just two arguments.
It is now possible to update the representation of an object in a vtable
by calling 'vtable-update-object' with just the vtable and the object as
arguments. (Previously the 'old-object' argument was required which, in
this case, would mean repeating the object in the argument list.) When
replacing an object with a different one, passing both the new and old
objects is still necessary.
* Changes in Emacs 30.1 on Non-Free Operating Systems

77
etc/themes/modus-operandi-deuteranopia-theme.el
View file

@ -1,11 +1,10 @@
;;; modus-operandi-deuteranopia-theme.el --- Deuteranopia-optimized theme with a white background -*- lexical-binding:t -*-
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@ -128,12 +127,12 @@ standard)."
(bg-magenta-subtle "#ffddff")
(bg-cyan-subtle "#bfefff")
(bg-red-nuanced "#fff1f0")
(bg-green-nuanced "#ecf7ed")
(bg-yellow-nuanced "#fff3da")
(bg-blue-nuanced "#f3f3ff")
(bg-magenta-nuanced "#fdf0ff")
(bg-cyan-nuanced "#ebf6fa")
(bg-red-nuanced "#ffe8e8")
(bg-green-nuanced "#e0f6e0")
(bg-yellow-nuanced "#f8f0d0")
(bg-blue-nuanced "#ecedff")
(bg-magenta-nuanced "#f8e6f5")
(bg-cyan-nuanced "#e0f2fa")
;;; Uncommon accent backgrounds
@ -212,6 +211,7 @@ standard)."
;;; Paren match
(bg-paren-match "#5fcfff")
(fg-paren-match fg-main)
(bg-paren-expression "#efd3f5")
(underline-paren-match unspecified)
@ -241,6 +241,11 @@ standard)."
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
(bg-active-argument bg-yellow-nuanced)
(fg-active-argument yellow-warmer)
(bg-active-value bg-blue-nuanced)
(fg-active-value blue-warmer)
;;;; Code mappings
(builtin magenta-warmer)
@ -289,7 +294,7 @@ standard)."
(date-event fg-alt)
(date-holiday yellow-warmer)
(date-holiday-other blue)
(date-now blue-faint)
(date-now fg-main)
(date-range fg-alt)
(date-scheduled yellow-cooler)
(date-weekday cyan)
@ -343,16 +348,29 @@ standard)."
;;;; Prose mappings
(prose-block fg-dim)
(prose-code cyan-cooler)
(bg-prose-block-delimiter bg-dim)
(fg-prose-block-delimiter fg-dim)
(bg-prose-block-contents bg-dim)
(bg-prose-code unspecified)
(fg-prose-code cyan-cooler)
(bg-prose-macro unspecified)
(fg-prose-macro magenta-cooler)
(bg-prose-verbatim unspecified)
(fg-prose-verbatim magenta-warmer)
(prose-done blue)
(prose-macro magenta-cooler)
(prose-todo yellow-warmer)
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
(prose-table fg-alt)
(prose-table-formula yellow-warmer)
(prose-tag magenta-faint)
(prose-todo yellow-warmer)
(prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@ -366,6 +384,17 @@ standard)."
(rainbow-7 yellow-faint)
(rainbow-8 cyan)
;;;; Search mappings
(bg-search-current bg-yellow-intense)
(bg-search-lazy bg-blue-intense)
(bg-search-replace bg-magenta-intense)
(bg-search-rx-group-0 bg-cyan-intense)
(bg-search-rx-group-1 bg-magenta-intense)
(bg-search-rx-group-2 bg-blue-subtle)
(bg-search-rx-group-3 bg-yellow-subtle)
;;;; Space mappings
(bg-space unspecified)
@ -374,10 +403,10 @@ standard)."
;;;; Terminal mappings
(bg-term-black "black")
(fg-term-black "black")
(bg-term-black-bright "gray35")
(fg-term-black-bright "gray35")
(bg-term-black "#000000")
(fg-term-black "#000000")
(bg-term-black-bright "#595959")
(fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@ -409,10 +438,10 @@ standard)."
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
(bg-term-white "gray65")
(fg-term-white "gray65")
(bg-term-white-bright "white")
(fg-term-white-bright "white")
(bg-term-white "#a6a6a6")
(fg-term-white "#a6a6a6")
(bg-term-white-bright "#ffffff")
(fg-term-white-bright "#ffffff")
;;;; Heading mappings

75
etc/themes/modus-operandi-theme.el
View file

@ -1,11 +1,10 @@
;;; modus-operandi-theme.el --- Elegant, highly legible theme with a white background -*- lexical-binding:t -*-
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@ -126,12 +125,12 @@ which corresponds to a minimum contrast in relative luminance of
(bg-magenta-subtle "#ffddff")
(bg-cyan-subtle "#bfefff")
(bg-red-nuanced "#fff1f0")
(bg-green-nuanced "#ecf7ed")
(bg-yellow-nuanced "#fff3da")
(bg-blue-nuanced "#f3f3ff")
(bg-magenta-nuanced "#fdf0ff")
(bg-cyan-nuanced "#ebf6fa")
(bg-red-nuanced "#ffe8e8")
(bg-green-nuanced "#e0f6e0")
(bg-yellow-nuanced "#f8f0d0")
(bg-blue-nuanced "#ecedff")
(bg-magenta-nuanced "#f8e6f5")
(bg-cyan-nuanced "#e0f2fa")
;;; Uncommon accent backgrounds
@ -210,6 +209,7 @@ which corresponds to a minimum contrast in relative luminance of
;;; Paren match
(bg-paren-match "#5fcfff")
(fg-paren-match fg-main)
(bg-paren-expression "#efd3f5")
(underline-paren-match unspecified)
@ -239,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
(bg-active-argument bg-yellow-nuanced)
(fg-active-argument yellow-warmer)
(bg-active-value bg-cyan-nuanced)
(fg-active-value cyan-warmer)
;;;; Code mappings
(builtin magenta-warmer)
@ -341,16 +346,29 @@ which corresponds to a minimum contrast in relative luminance of
;;;; Prose mappings
(prose-block fg-dim)
(prose-code green-cooler)
(bg-prose-block-delimiter bg-dim)
(fg-prose-block-delimiter fg-dim)
(bg-prose-block-contents bg-dim)
(bg-prose-code unspecified)
(fg-prose-code cyan-cooler)
(bg-prose-macro unspecified)
(fg-prose-macro magenta-cooler)
(bg-prose-verbatim unspecified)
(fg-prose-verbatim magenta-warmer)
(prose-done green)
(prose-macro magenta-cooler)
(prose-todo red)
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
(prose-table fg-alt)
(prose-table-formula magenta-warmer)
(prose-tag magenta-faint)
(prose-todo red)
(prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@ -364,6 +382,17 @@ which corresponds to a minimum contrast in relative luminance of
(rainbow-7 blue-warmer)
(rainbow-8 magenta-warmer)
;;;; Search mappings
(bg-search-current bg-yellow-intense)
(bg-search-lazy bg-cyan-intense)
(bg-search-replace bg-red-intense)
(bg-search-rx-group-0 bg-blue-intense)
(bg-search-rx-group-1 bg-green-intense)
(bg-search-rx-group-2 bg-red-subtle)
(bg-search-rx-group-3 bg-magenta-subtle)
;;;; Space mappings
(bg-space unspecified)
@ -372,10 +401,10 @@ which corresponds to a minimum contrast in relative luminance of
;;;; Terminal mappings
(bg-term-black "black")
(fg-term-black "black")
(bg-term-black-bright "gray35")
(fg-term-black-bright "gray35")
(bg-term-black "#000000")
(fg-term-black "#000000")
(bg-term-black-bright "#595959")
(fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@ -407,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
(bg-term-white "gray65")
(fg-term-white "gray65")
(bg-term-white-bright "white")
(fg-term-white-bright "white")
(bg-term-white "#a6a6a6")
(fg-term-white "#a6a6a6")
(bg-term-white-bright "#ffffff")
(fg-term-white-bright "#ffffff")
;;;; Heading mappings

84
etc/themes/modus-operandi-tinted-theme.el
View file

@ -1,11 +1,11 @@
;;; modus-operandi-tinted-theme.el --- Elegant, highly legible theme with a light ocher background -*- lexical-binding:t -*-
;;; modus-operandi-tinted-theme.el --- Elegant, highly legible theme with a light ochre background -*- lexical-binding:t -*-
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@ -44,7 +44,7 @@
;;;###theme-autoload
(deftheme modus-operandi-tinted
"Elegant, highly legible theme with a light ocher background.
"Elegant, highly legible theme with a light ochre background.
Conforms with the highest legibility standard for color contrast
between background and foreground in any given piece of text,
which corresponds to a minimum contrast in relative luminance of
@ -125,12 +125,12 @@ which corresponds to a minimum contrast in relative luminance of
(bg-magenta-subtle "#ffddff")
(bg-cyan-subtle "#bfefff")
(bg-red-nuanced "#ffe8f0")
(bg-green-nuanced "#e0f5e0")
(bg-yellow-nuanced "#f9ead0")
(bg-blue-nuanced "#ebebff")
(bg-magenta-nuanced "#f6e7ff")
(bg-cyan-nuanced "#e1f3fc")
(bg-red-nuanced "#ffe8e8")
(bg-green-nuanced "#e0f6e0")
(bg-yellow-nuanced "#f8f0d0")
(bg-blue-nuanced "#ecedff")
(bg-magenta-nuanced "#f8e6f5")
(bg-cyan-nuanced "#e0f2fa")
;;; Uncommon accent backgrounds
@ -209,6 +209,7 @@ which corresponds to a minimum contrast in relative luminance of
;;; Paren match
(bg-paren-match "#7fdfcf")
(fg-paren-match fg-main)
(bg-paren-expression "#efd3f5")
(underline-paren-match unspecified)
@ -217,9 +218,9 @@ which corresponds to a minimum contrast in relative luminance of
;;;; General mappings
(fringe bg-dim)
(cursor red)
(cursor red-intense)
(keybind blue-cooler)
(keybind red)
(name magenta)
(identifier yellow-cooler)
@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
(bg-active-argument bg-yellow-nuanced)
(fg-active-argument yellow-warmer)
(bg-active-value bg-cyan-nuanced)
(fg-active-value cyan-warmer)
;;;; Code mappings
(builtin magenta-warmer)
@ -340,16 +346,29 @@ which corresponds to a minimum contrast in relative luminance of
;;;; Prose mappings
(prose-block fg-dim)
(prose-code green-cooler)
(bg-prose-block-delimiter bg-dim)
(fg-prose-block-delimiter fg-dim)
(bg-prose-block-contents bg-dim)
(bg-prose-code unspecified)
(fg-prose-code cyan-cooler)
(bg-prose-macro unspecified)
(fg-prose-macro magenta-cooler)
(bg-prose-verbatim unspecified)
(fg-prose-verbatim magenta-warmer)
(prose-done green)
(prose-macro magenta-cooler)
(prose-todo red)
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
(prose-table fg-alt)
(prose-table-formula magenta-warmer)
(prose-tag magenta-faint)
(prose-todo red)
(prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@ -363,6 +382,17 @@ which corresponds to a minimum contrast in relative luminance of
(rainbow-7 blue-warmer)
(rainbow-8 magenta-warmer)
;;;; Search mappings
(bg-search-current bg-yellow-intense)
(bg-search-lazy bg-cyan-intense)
(bg-search-replace bg-red-intense)
(bg-search-rx-group-0 bg-blue-intense)
(bg-search-rx-group-1 bg-green-intense)
(bg-search-rx-group-2 bg-red-subtle)
(bg-search-rx-group-3 bg-magenta-subtle)
;;;; Space mappings
(bg-space unspecified)
@ -371,10 +401,10 @@ which corresponds to a minimum contrast in relative luminance of
;;;; Terminal mappings
(bg-term-black "black")
(fg-term-black "black")
(bg-term-black-bright "gray35")
(fg-term-black-bright "gray35")
(bg-term-black "#000000")
(fg-term-black "#000000")
(bg-term-black-bright "#595959")
(fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
(bg-term-white "gray65")
(fg-term-white "gray65")
(bg-term-white-bright "white")
(fg-term-white-bright "white")
(bg-term-white "#a6a6a6")
(fg-term-white "#a6a6a6")
(bg-term-white-bright "#ffffff")
(fg-term-white-bright "#ffffff")
;;;; Heading mappings

77
etc/themes/modus-operandi-tritanopia-theme.el
View file

@ -1,11 +1,10 @@
;;; modus-operandi-tritanopia-theme.el --- Tritanopia-optimized theme with a white background -*- lexical-binding:t -*-
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@ -128,12 +127,12 @@ standard)."
(bg-magenta-subtle "#ffddff")
(bg-cyan-subtle "#bfefff")
(bg-red-nuanced "#fff1f0")
(bg-green-nuanced "#ecf7ed")
(bg-yellow-nuanced "#fff3da")
(bg-blue-nuanced "#f3f3ff")
(bg-magenta-nuanced "#fdf0ff")
(bg-cyan-nuanced "#ebf6fa")
(bg-red-nuanced "#ffe8e8")
(bg-green-nuanced "#e0f6e0")
(bg-yellow-nuanced "#f8f0d0")
(bg-blue-nuanced "#ecedff")
(bg-magenta-nuanced "#f8e6f5")
(bg-cyan-nuanced "#e0f2fa")
;;; Uncommon accent backgrounds
@ -212,6 +211,7 @@ standard)."
;;; Paren match
(bg-paren-match "#5fcfff")
(fg-paren-match fg-main)
(bg-paren-expression "#efd3f5")
(underline-paren-match unspecified)
@ -241,6 +241,11 @@ standard)."
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
(bg-active-argument bg-red-nuanced)
(fg-active-argument red-warmer)
(bg-active-value bg-cyan-nuanced)
(fg-active-value cyan)
;;;; Code mappings
(builtin magenta)
@ -343,16 +348,29 @@ standard)."
;;;; Prose mappings
(prose-block fg-dim)
(prose-code cyan)
(bg-prose-block-delimiter bg-dim)
(fg-prose-block-delimiter fg-dim)
(bg-prose-block-contents bg-dim)
(bg-prose-code unspecified)
(fg-prose-code cyan)
(bg-prose-macro unspecified)
(fg-prose-macro red-warmer)
(bg-prose-verbatim unspecified)
(fg-prose-verbatim magenta-warmer)
(prose-done cyan)
(prose-macro red-warmer)
(prose-todo red)
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
(prose-table fg-alt)
(prose-tag fg-alt)
(prose-todo red)
(prose-verbatim magenta-warmer)
(prose-table-formula red-cooler)
(prose-tag magenta-faint)
;;;; Rainbow mappings
@ -366,6 +384,17 @@ standard)."
(rainbow-7 magenta-faint)
(rainbow-8 red-faint)
;;;; Search mappings
(bg-search-current bg-red-intense)
(bg-search-lazy bg-cyan-intense)
(bg-search-replace bg-magenta-intense)
(bg-search-rx-group-0 bg-blue-intense)
(bg-search-rx-group-1 bg-magenta-intense)
(bg-search-rx-group-2 bg-cyan-subtle)
(bg-search-rx-group-3 bg-red-subtle)
;;;; Space mappings
(bg-space unspecified)
@ -374,10 +403,10 @@ standard)."
;;;; Terminal mappings
(bg-term-black "black")
(fg-term-black "black")
(bg-term-black-bright "gray35")
(fg-term-black-bright "gray35")
(bg-term-black "#000000")
(fg-term-black "#000000")
(bg-term-black-bright "#595959")
(fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@ -409,10 +438,10 @@ standard)."
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
(bg-term-white "gray65")
(fg-term-white "gray65")
(bg-term-white-bright "white")
(fg-term-white-bright "white")
(bg-term-white "#a6a6a6")
(fg-term-white "#a6a6a6")
(bg-term-white-bright "#ffffff")
(fg-term-white-bright "#ffffff")
;;;; Heading mappings

545
etc/themes/modus-themes.el
View file

File diff suppressed because it is too large Load diff

78
etc/themes/modus-vivendi-deuteranopia-theme.el
View file

@ -1,11 +1,11 @@
;;; modus-vivendi-deuteranopia-theme.el --- Deuteranopia-optimized theme with a black background -*- lexical-binding:t -*-
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@ -127,12 +127,12 @@ standard)."
(bg-magenta-subtle "#552f5f")
(bg-cyan-subtle "#004065")
(bg-red-nuanced "#2c0614")
(bg-green-nuanced "#001904")
(bg-yellow-nuanced "#221000")
(bg-blue-nuanced "#0f0e39")
(bg-magenta-nuanced "#230631")
(bg-cyan-nuanced "#041529")
(bg-red-nuanced "#3a0c14")
(bg-green-nuanced "#092f1f")
(bg-yellow-nuanced "#381d0f")
(bg-blue-nuanced "#12154a")
(bg-magenta-nuanced "#2f0c3f")
(bg-cyan-nuanced "#042837")
;;; Uncommon accent backgrounds
@ -211,6 +211,7 @@ standard)."
;;; Paren match
(bg-paren-match "#2f7f9f")
(fg-paren-match fg-main)
(bg-paren-expression "#453040")
(underline-paren-match unspecified)
@ -240,6 +241,11 @@ standard)."
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
(bg-active-argument bg-yellow-nuanced)
(fg-active-argument yellow-warmer)
(bg-active-value bg-blue-nuanced)
(fg-active-value blue-warmer)
;;;; Code mappings
(builtin magenta-warmer)
@ -288,7 +294,7 @@ standard)."
(date-event fg-alt)
(date-holiday yellow-warmer)
(date-holiday-other blue)
(date-now blue-faint)
(date-now fg-main)
(date-range fg-alt)
(date-scheduled yellow-cooler)
(date-weekday cyan)
@ -342,16 +348,29 @@ standard)."
;;;; Prose mappings
(prose-block fg-dim)
(prose-code cyan-cooler)
(bg-prose-block-delimiter bg-dim)
(fg-prose-block-delimiter fg-dim)
(bg-prose-block-contents bg-dim)
(bg-prose-code unspecified)
(fg-prose-code cyan-cooler)
(bg-prose-macro unspecified)
(fg-prose-macro magenta-cooler)
(bg-prose-verbatim unspecified)
(fg-prose-verbatim magenta-warmer)
(prose-done blue)
(prose-macro magenta-cooler)
(prose-todo yellow-warmer)
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
(prose-table fg-alt)
(prose-table-formula yellow-warmer)
(prose-tag magenta-faint)
(prose-todo yellow-warmer)
(prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@ -365,6 +384,17 @@ standard)."
(rainbow-7 blue-faint)
(rainbow-8 magenta-faint)
;;;; Search mappings
(bg-search-current bg-yellow-intense)
(bg-search-lazy bg-blue-intense)
(bg-search-replace bg-magenta-intense)
(bg-search-rx-group-0 bg-cyan-intense)
(bg-search-rx-group-1 bg-magenta-intense)
(bg-search-rx-group-2 bg-blue-subtle)
(bg-search-rx-group-3 bg-yellow-subtle)
;;;; Space mappings
(bg-space unspecified)
@ -373,10 +403,10 @@ standard)."
;;;; Terminal mappings
(bg-term-black "black")
(fg-term-black "black")
(bg-term-black-bright "gray35")
(fg-term-black-bright "gray35")
(bg-term-black "#000000")
(fg-term-black "#000000")
(bg-term-black-bright "#595959")
(fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@ -408,10 +438,10 @@ standard)."
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
(bg-term-white "gray65")
(fg-term-white "gray65")
(bg-term-white-bright "white")
(fg-term-white-bright "white")
(bg-term-white "#a6a6a6")
(fg-term-white "#a6a6a6")
(bg-term-white-bright "#ffffff")
(fg-term-white-bright "#ffffff")
;;;; Heading mappings

77
etc/themes/modus-vivendi-theme.el
View file

@ -1,11 +1,11 @@
;;; modus-vivendi-theme.el --- Elegant, highly legible theme with a black background -*- lexical-binding:t -*-
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@ -125,12 +125,12 @@ which corresponds to a minimum contrast in relative luminance of
(bg-magenta-subtle "#552f5f")
(bg-cyan-subtle "#004065")
(bg-red-nuanced "#2c0614")
(bg-green-nuanced "#001904")
(bg-yellow-nuanced "#221000")
(bg-blue-nuanced "#0f0e39")
(bg-magenta-nuanced "#230631")
(bg-cyan-nuanced "#041529")
(bg-red-nuanced "#3a0c14")
(bg-green-nuanced "#092f1f")
(bg-yellow-nuanced "#381d0f")
(bg-blue-nuanced "#12154a")
(bg-magenta-nuanced "#2f0c3f")
(bg-cyan-nuanced "#042837")
;;; Uncommon accent backgrounds
@ -209,6 +209,7 @@ which corresponds to a minimum contrast in relative luminance of
;;; Paren match
(bg-paren-match "#2f7f9f")
(fg-paren-match fg-main)
(bg-paren-expression "#453040")
(underline-paren-match unspecified)
@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
(bg-active-argument bg-yellow-nuanced)
(fg-active-argument yellow-cooler)
(bg-active-value bg-cyan-nuanced)
(fg-active-value cyan-cooler)
;;;; Code mappings
(builtin magenta-warmer)
@ -340,16 +346,29 @@ which corresponds to a minimum contrast in relative luminance of
;;;; Prose mappings
(prose-block fg-dim)
(prose-code cyan-cooler)
(bg-prose-block-delimiter bg-dim)
(fg-prose-block-delimiter fg-dim)
(bg-prose-block-contents bg-dim)
(bg-prose-code unspecified)
(fg-prose-code cyan-cooler)
(bg-prose-macro unspecified)
(fg-prose-macro magenta-cooler)
(bg-prose-verbatim unspecified)
(fg-prose-verbatim magenta-warmer)
(prose-done green)
(prose-macro magenta-cooler)
(prose-todo red)
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
(prose-table fg-alt)
(prose-table-formula magenta-warmer)
(prose-tag magenta-faint)
(prose-todo red)
(prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@ -363,6 +382,17 @@ which corresponds to a minimum contrast in relative luminance of
(rainbow-7 blue-warmer)
(rainbow-8 magenta-warmer)
;;;; Search mappings
(bg-search-current bg-yellow-intense)
(bg-search-lazy bg-cyan-intense)
(bg-search-replace bg-red-intense)
(bg-search-rx-group-0 bg-blue-intense)
(bg-search-rx-group-1 bg-green-intense)
(bg-search-rx-group-2 bg-red-subtle)
(bg-search-rx-group-3 bg-magenta-subtle)
;;;; Space mappings
(bg-space unspecified)
@ -371,10 +401,10 @@ which corresponds to a minimum contrast in relative luminance of
;;;; Terminal mappings
(bg-term-black "black")
(fg-term-black "black")
(bg-term-black-bright "gray35")
(fg-term-black-bright "gray35")
(bg-term-black "#000000")
(fg-term-black "#000000")
(bg-term-black-bright "#595959")
(fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
(bg-term-white "gray65")
(fg-term-white "gray65")
(bg-term-white-bright "white")
(fg-term-white-bright "white")
(bg-term-white "#a6a6a6")
(fg-term-white "#a6a6a6")
(bg-term-white-bright "#ffffff")
(fg-term-white-bright "#ffffff")
;;;; Heading mappings
@ -451,7 +481,6 @@ Semantic color mappings have the form (MAPPING-NAME COLOR-NAME)
with both as symbols. The latter is a named color that already
exists in the palette and is associated with a HEX-VALUE.")
(defcustom modus-vivendi-palette-overrides nil
"Overrides for `modus-vivendi-palette'.

96
etc/themes/modus-vivendi-tinted-theme.el
View file

@ -1,11 +1,11 @@
;;; modus-vivendi-tinted-theme.el --- Elegant, highly legible theme with a night sky background -*- lexical-binding:t -*-
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@ -125,12 +125,18 @@ which corresponds to a minimum contrast in relative luminance of
(bg-magenta-subtle "#552f5f")
(bg-cyan-subtle "#004065")
(bg-red-nuanced "#350f14")
(bg-green-nuanced "#002718")
(bg-yellow-nuanced "#2c1f00")
(bg-blue-nuanced "#131c4d")
(bg-magenta-nuanced "#2f133f")
(bg-cyan-nuanced "#04253f")
(bg-red-nuanced "#3a0c14")
(bg-green-nuanced "#092f1f")
(bg-yellow-nuanced "#381d0f")
(bg-blue-nuanced "#12154a")
(bg-magenta-nuanced "#2f0c3f")
(bg-cyan-nuanced "#042837")
;;; Uncommon accent backgrounds
(bg-ochre "#442c2f")
(bg-lavender "#38325c")
(bg-sage "#0f3d30")
;;; Graphs
@ -200,15 +206,10 @@ which corresponds to a minimum contrast in relative luminance of
(bg-diff-context "#1a1f30")
;;; Uncommon accent backgrounds
(bg-ochre "#442c2f")
(bg-lavender "#38325c")
(bg-sage "#0f3d30")
;;; Paren match
(bg-paren-match "#2f7f9f")
(bg-paren-match "#5f789f")
(fg-paren-match fg-main)
(bg-paren-expression "#453040")
(underline-paren-match unspecified)
@ -217,9 +218,9 @@ which corresponds to a minimum contrast in relative luminance of
;;;; General mappings
(fringe bg-dim)
(cursor magenta-warmer)
(cursor magenta-intense)
(keybind blue-cooler)
(keybind magenta-cooler)
(name magenta)
(identifier yellow-faint)
@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
(bg-active-argument bg-yellow-nuanced)
(fg-active-argument yellow-cooler)
(bg-active-value bg-cyan-nuanced)
(fg-active-value cyan-cooler)
;;;; Code mappings
(builtin magenta-warmer)
@ -337,20 +343,32 @@ which corresponds to a minimum contrast in relative luminance of
(fg-prompt cyan-cooler)
(bg-prompt unspecified)
(bg-space-err bg-red-intense)
;;;; Prose mappings
(prose-block fg-dim)
(prose-code cyan-cooler)
(bg-prose-block-delimiter bg-dim)
(fg-prose-block-delimiter fg-dim)
(bg-prose-block-contents bg-dim)
(bg-prose-code unspecified)
(fg-prose-code cyan-cooler)
(bg-prose-macro unspecified)
(fg-prose-macro magenta-cooler)
(bg-prose-verbatim unspecified)
(fg-prose-verbatim magenta-warmer)
(prose-done green)
(prose-macro magenta-cooler)
(prose-todo red)
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
(prose-table fg-alt)
(prose-table-formula magenta-warmer)
(prose-tag magenta-faint)
(prose-todo red)
(prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@ -364,17 +382,29 @@ which corresponds to a minimum contrast in relative luminance of
(rainbow-7 blue-warmer)
(rainbow-8 magenta-warmer)
;;;; Search mappings
(bg-search-current bg-yellow-intense)
(bg-search-lazy bg-cyan-intense)
(bg-search-replace bg-red-intense)
(bg-search-rx-group-0 bg-blue-intense)
(bg-search-rx-group-1 bg-green-intense)
(bg-search-rx-group-2 bg-red-subtle)
(bg-search-rx-group-3 bg-magenta-subtle)
;;;; Space mappings
(bg-space unspecified)
(fg-space border)
(bg-space-err bg-red-intense)
;;;; Terminal mappings
(bg-term-black "black")
(fg-term-black "black")
(bg-term-black-bright "gray35")
(fg-term-black-bright "gray35")
(bg-term-black "#000000")
(fg-term-black "#000000")
(bg-term-black-bright "#595959")
(fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
(bg-term-white "gray65")
(fg-term-white "gray65")
(bg-term-white-bright "white")
(fg-term-white-bright "white")
(bg-term-white "#a6a6a6")
(fg-term-white "#a6a6a6")
(bg-term-white-bright "#ffffff")
(fg-term-white-bright "#ffffff")
;;;; Heading mappings

77
etc/themes/modus-vivendi-tritanopia-theme.el
View file

@ -1,11 +1,10 @@
;;; modus-vivendi-tritanopia-theme.el --- Tritanopia-optimized theme with a black background -*- lexical-binding:t -*-
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@ -128,12 +127,12 @@ standard)."
(bg-magenta-subtle "#552f5f")
(bg-cyan-subtle "#004065")
(bg-red-nuanced "#2c0614")
(bg-green-nuanced "#001904")
(bg-yellow-nuanced "#221000")
(bg-blue-nuanced "#0f0e39")
(bg-magenta-nuanced "#230631")
(bg-cyan-nuanced "#041529")
(bg-red-nuanced "#3a0c14")
(bg-green-nuanced "#092f1f")
(bg-yellow-nuanced "#381d0f")
(bg-blue-nuanced "#12154a")
(bg-magenta-nuanced "#2f0c3f")
(bg-cyan-nuanced "#042837")
;;; Uncommon accent backgrounds
@ -212,6 +211,7 @@ standard)."
;;; Paren match
(bg-paren-match "#2f7f9f")
(fg-paren-match fg-main)
(bg-paren-expression "#453040")
(underline-paren-match unspecified)
@ -241,6 +241,11 @@ standard)."
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
(bg-active-argument bg-red-nuanced)
(fg-active-argument red-warmer)
(bg-active-value bg-cyan-nuanced)
(fg-active-value cyan)
;;;; Code mappings
(builtin magenta)
@ -343,16 +348,29 @@ standard)."
;;;; Prose mappings
(prose-block fg-dim)
(prose-code cyan)
(bg-prose-block-delimiter bg-dim)
(fg-prose-block-delimiter fg-dim)
(bg-prose-block-contents bg-dim)
(bg-prose-code unspecified)
(fg-prose-code cyan)
(bg-prose-macro unspecified)
(fg-prose-macro red-warmer)
(bg-prose-verbatim unspecified)
(fg-prose-verbatim magenta-warmer)
(prose-done cyan)
(prose-macro red-warmer)
(prose-todo red)
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
(prose-table fg-alt)
(prose-tag fg-alt)
(prose-todo red)
(prose-verbatim magenta-warmer)
(prose-table-formula red-cooler)
(prose-tag magenta-faint)
;;;; Rainbow mappings
@ -366,6 +384,17 @@ standard)."
(rainbow-7 magenta-faint)
(rainbow-8 red-faint)
;;;; Search mappings
(bg-search-current bg-red-intense)
(bg-search-lazy bg-cyan-intense)
(bg-search-replace bg-magenta-intense)
(bg-search-rx-group-0 bg-blue-intense)
(bg-search-rx-group-1 bg-magenta-intense)
(bg-search-rx-group-2 bg-cyan-subtle)
(bg-search-rx-group-3 bg-red-subtle)
;;;; Space mappings
(bg-space unspecified)
@ -374,10 +403,10 @@ standard)."
;;;; Terminal mappings
(bg-term-black "black")
(fg-term-black "black")
(bg-term-black-bright "gray35")
(fg-term-black-bright "gray35")
(bg-term-black "#000000")
(fg-term-black "#000000")
(bg-term-black-bright "#595959")
(fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@ -409,10 +438,10 @@ standard)."
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
(bg-term-white "gray65")
(fg-term-white "gray65")
(bg-term-white-bright "white")
(fg-term-white-bright "white")
(bg-term-white "#a6a6a6")
(fg-term-white "#a6a6a6")
(bg-term-white-bright "#ffffff")
(fg-term-white-bright "#ffffff")
;;;; Heading mappings

8
exec/configure.ac
View file

@ -122,6 +122,7 @@ AH_TEMPLATE([SYSCALL_RET_REG], [Define to register holding value of system calls
AH_TEMPLATE([STACK_POINTER], [Define to register holding the stack pointer.])
AH_TEMPLATE([EXEC_SYSCALL], [Define to number of the `exec' system call.])
AH_TEMPLATE([USER_WORD], [Define to word type used by tracees.])
AH_TEMPLATE([USER_SWORD], [Define to signed word type used by tracees.])
AH_TEMPLATE([EXEC_64], [Define to 1 if the system utilizes 64-bit ELF.])
AH_TEMPLATE([STACK_GROWS_DOWNWARDS], [Define to 1 if the stack grows downwards.])
AH_TEMPLATE([ABI_RED_ZONE], [Define to number of reserved bytes past the stack frame.])
@ -251,6 +252,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [rsp])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXEC_64], [1])
AC_DEFINE([ABI_RED_ZONE], [128])
AC_DEFINE([EXECUTABLE_BASE], [0x555555554000])
@ -283,6 +285,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [esp])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXECUTABLE_BASE], [0x0f000000])
AC_DEFINE([INTERPRETER_BASE], [0xaf000000])
AC_DEFINE([STACK_GROWS_DOWNWARDS], [1])
@ -313,6 +316,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [sp])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXEC_64], [1])
AC_DEFINE([EXECUTABLE_BASE], [0x3000000000])
AC_DEFINE([INTERPRETER_BASE], [0x3f00000000])
@ -344,6 +348,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [[uregs[13]]])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXECUTABLE_BASE], [0x0f000000])
AC_DEFINE([INTERPRETER_BASE], [0x1f000000])
AC_DEFINE([STACK_GROWS_DOWNWARDS], [1])
@ -368,6 +373,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [[uregs[13]]])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXECUTABLE_BASE], [0x0f000000])
AC_DEFINE([INTERPRETER_BASE], [0x1f000000])
AC_DEFINE([STACK_GROWS_DOWNWARDS], [1])
@ -398,6 +404,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [[gregs[29]]]) # sp
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXECUTABLE_BASE], [0x0f000000])
AC_DEFINE([INTERPRETER_BASE], [0x1f000000])
AC_DEFINE([STACK_GROWS_DOWNWARDS], [1])
@ -427,6 +434,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [[gregs[29]]]) # sp
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXEC_64], [1])
AC_DEFINE([EXECUTABLE_BASE], [0x400000])
AC_DEFINE([INTERPRETER_BASE], [0x3f00000000])

2
exec/exec.c
View file

@ -865,7 +865,7 @@ insert_args (struct exec_tracee *tracee, USER_REGS_STRUCT *regs,
result in *IN, and return a pointer to the byte after the
result. REM should be NULL. */
static char *
char *
format_pid (char *in, unsigned int pid)
{
unsigned int digits[32], *fill;

1
exec/exec.h
View file

@ -180,6 +180,7 @@ extern int aarch64_set_regs (pid_t, USER_REGS_STRUCT *, bool);
extern char *format_pid (char *, unsigned int);
extern USER_WORD user_alloca (struct exec_tracee *, USER_REGS_STRUCT *,
USER_REGS_STRUCT *, USER_WORD);
extern int user_copy (struct exec_tracee *, const unsigned char *,

151
exec/trace.c
View file

@ -31,6 +31,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <unistd.h>
#include <stdlib.h>
#include <errno.h>
#include <fcntl.h>
#include "exec.h"
@ -894,6 +895,98 @@ handle_exec (struct exec_tracee *tracee, USER_REGS_STRUCT *regs)
return 3;
}
/* Define replacements for required string functions. */
#if !defined HAVE_STPCPY || !defined HAVE_DECL_STPCPY
/* Copy SRC to DEST, returning the address of the terminating '\0' in
DEST. */
static char *
rpl_stpcpy (char *dest, const char *src)
{
register char *d;
register const char *s;
d = dest;
s = src;
do
*d++ = *s;
while (*s++ != '\0');
return d - 1;
}
#define stpcpy rpl_stpcpy
#endif /* !defined HAVE_STPCPY || !defined HAVE_DECL_STPCPY */
/* Modify BUFFER, of size SIZE, so that it holds the absolute name of
the file identified by BUFFER, relative to the current working
directory of TRACEE if FD be AT_FDCWD, or the file referenced by FD
otherwise.
Value is 1 if this information is unavailable (of which there are
variety of causes), and 0 on success. */
static int
canon_path (struct exec_tracee *tracee, int fd, char *buffer,
ptrdiff_t size)
{
char link[sizeof "/proc//fd/" + 48], *p; /* Or /proc/pid/cwd. */
char target[PATH_MAX];
ssize_t rc, length;
if (buffer[0] == '/')
/* Absolute file name; return immediately. */
return 0;
else if (fd == AT_FDCWD)
{
p = stpcpy (link, "/proc/");
p = format_pid (p, tracee->pid);
stpcpy (p, "/cwd");
}
else if (fd < 0)
/* Invalid file descriptor. */
return 1;
else
{
p = stpcpy (link, "/proc/");
p = format_pid (p, tracee->pid);
p = stpcpy (p, "/fd/");
format_pid (p, fd);
}
/* Read LINK's target, and should it be oversized, punt. */
rc = readlink (link, target, PATH_MAX);
if (rc < 0 || rc >= PATH_MAX)
return 1;
/* Consider the amount by which BUFFER's existing contents should be
displaced. */
length = strlen (buffer) + 1;
if ((length + rc + (target[rc - 1] != '/')) > size)
/* Punt if this would overflow. */
return 1;
memmove ((buffer + rc + (target[rc - 1] != '/')),
buffer, length);
/* Copy the new file name into BUFFER. */
memcpy (buffer, target, rc);
/* Insert separator in between if need be. */
if (target[rc - 1] != '/')
buffer[rc] = '/';
return 0;
}
/* Handle a `readlink' or `readlinkat' system call.
CALLNO is the system call number, and REGS are the current user
@ -924,22 +1017,26 @@ handle_readlinkat (USER_WORD callno, USER_REGS_STRUCT *regs,
char buffer[PATH_MAX + 1];
USER_WORD address, return_buffer, size;
size_t length;
char proc_pid_exe[sizeof "/proc//exe" + 24], *p;
int dirfd;
/* Read the file name. */
#ifdef READLINK_SYSCALL
if (callno == READLINK_SYSCALL)
{
address = regs->SYSCALL_ARG_REG;
dirfd = AT_FDCWD;
address = regs->SYSCALL_ARG_REG;
return_buffer = regs->SYSCALL_ARG1_REG;
size = regs->SYSCALL_ARG2_REG;
size = regs->SYSCALL_ARG2_REG;
}
else
#endif /* READLINK_SYSCALL */
{
address = regs->SYSCALL_ARG1_REG;
dirfd = (USER_SWORD) regs->SYSCALL_ARG_REG;
address = regs->SYSCALL_ARG1_REG;
return_buffer = regs->SYSCALL_ARG2_REG;
size = regs->SYSCALL_ARG3_REG;
size = regs->SYSCALL_ARG3_REG;
}
read_memory (tracee, buffer, PATH_MAX, address);
@ -952,12 +1049,25 @@ handle_readlinkat (USER_WORD callno, USER_REGS_STRUCT *regs,
return 1;
}
/* Now check if the caller is looking for /proc/self/exe.
/* Expand BUFFER into an absolute file name. TODO:
AT_SYMLINK_FOLLOW? */
if (canon_path (tracee, dirfd, buffer, sizeof buffer))
return 0;
/* Now check if the caller is looking for /proc/self/exe or its
equivalent with the PID made explicit.
dirfd can be ignored, as for now only absolute file names are
handled. FIXME. */
if (strcmp (buffer, "/proc/self/exe") || !tracee->exec_file)
p = stpcpy (proc_pid_exe, "/proc/");
p = format_pid (p, tracee->pid);
stpcpy (p, "/exe");
if ((strcmp (buffer, "/proc/self/exe")
&& strcmp (buffer, proc_pid_exe))
|| !tracee->exec_file)
return 0;
/* Copy over tracee->exec_file. Truncate it to PATH_MAX, length, or
@ -1004,15 +1114,23 @@ handle_openat (USER_WORD callno, USER_REGS_STRUCT *regs,
USER_WORD address;
size_t length;
USER_REGS_STRUCT original;
char proc_pid_exe[sizeof "/proc//exe" + 24], *p;
int dirfd;
/* Read the file name. */
#ifdef OPEN_SYSCALL
if (callno == OPEN_SYSCALL)
address = regs->SYSCALL_ARG_REG;
{
dirfd = AT_FDCWD;
address = regs->SYSCALL_ARG_REG;
}
else
#endif /* OPEN_SYSCALL */
address = regs->SYSCALL_ARG1_REG;
{
dirfd = (USER_SWORD) regs->SYSCALL_ARG_REG;
address = regs->SYSCALL_ARG1_REG;
}
/* Read the file name into the buffer and verify that it is NULL
terminated. */
@ -1024,12 +1142,25 @@ handle_openat (USER_WORD callno, USER_REGS_STRUCT *regs,
return 1;
}
/* Now check if the caller is looking for /proc/self/exe.
/* Expand BUFFER into an absolute file name. TODO:
AT_SYMLINK_FOLLOW? */
if (canon_path (tracee, dirfd, buffer, sizeof buffer))
return 0;
/* Now check if the caller is looking for /proc/self/exe or its
equivalent with the PID made explicit.
dirfd can be ignored, as for now only absolute file names are
handled. FIXME. */
if (strcmp (buffer, "/proc/self/exe") || !tracee->exec_file)
p = stpcpy (proc_pid_exe, "/proc/");
p = format_pid (p, tracee->pid);
stpcpy (p, "/exe");
if ((strcmp (buffer, "/proc/self/exe")
&& strcmp (buffer, proc_pid_exe))
|| !tracee->exec_file)
return 0;
/* Copy over tracee->exec_file. This doesn't correctly handle the

4
java/AndroidManifest.xml.in
View file

@ -218,6 +218,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -->
<activity android:name="org.gnu.emacs.EmacsActivity"
android:launchMode="singleInstance"
android:taskAffinity="emacs.primary_frame"
android:windowSoftInputMode="adjustResize"
android:exported="true"
android:configChanges="orientation|screenSize|screenLayout|keyboardHidden|locale|fontScale">
@ -229,7 +230,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -->
</activity>
<activity android:name="org.gnu.emacs.EmacsOpenActivity"
android:taskAffinity="open.dialog"
android:taskAffinity="emacs.open_dialog"
android:excludeFromRecents="true"
android:exported="true">
@ -273,6 +274,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -->
</activity>
<activity android:name="org.gnu.emacs.EmacsMultitaskActivity"
android:taskAffinity="emacs.secondary_frame"
android:windowSoftInputMode="adjustResize"
android:exported="true"
android:configChanges="orientation|screenSize|screenLayout|keyboardHidden|locale|fontScale"/>

30
java/INSTALL
View file

@ -166,25 +166,21 @@ than a compressed package for a newer version of Android.
BUILDING C++ DEPENDENCIES
With a new version of the NDK, dependencies containing C++ code should
build without any further configuration. However, older versions
require that you use the ``make_standalone_toolchain.py'' script in
the NDK distribution to create a ``standalone toolchain'', and use
that instead, in order for C++ headers to be found.
In normal circumstances, Emacs should automatically detect and configure
one of the C++ standard libraries part of the NDK when such a library is
required to build a dependency specified under `--with-ndk-path'.
See https://developer.android.com/ndk/guides/standalone_toolchain for
more details; when a ``standalone toolchain'' is specified, the
configure script will try to determine the location of the C++
compiler based on the C compiler specified. If that automatic
detection does not work, you can specify a C++ compiler yourself, like
so:
Nevertheless, this process is not infalliable, and with certain versions
of the NDK is liable to fail to locate a C++ compiler, requiring that
you run the `make_standalone_toolchain.py' script in the NDK
distribution to create a ``standalone toolchain'' and substitute the
same for the regular compiler toolchain. See
https://developer.android.com/ndk/guides/standalone_toolchain for
further details.
./configure --with-ndk-cxx=/path/to/toolchain/bin/i686-linux-android-g++
Some versions of the NDK have a bug, where GCC fails to locate
``stddef.h'' after being copied to a standalone toolchain. To work
around this problem (which normally exhibits itself when building C++
code), add:
Some versions of the NDK that ship GCC 4.9.x exhibit a bug where the
compiler cannot locate `stddef.h' after being copied to a standalone
toolchain. To work around this problem, add:
-isystem /path/to/toolchain/include/c++/4.9.x

52
java/org/gnu/emacs/EmacsDesktopNotification.java
View file

@ -83,11 +83,16 @@ public final class EmacsDesktopNotification
notification. */
public final String[] actions, titles;
/* Delay in miliseconds after which this notification should be
automatically dismissed. */
public final long delay;
public
EmacsDesktopNotification (String title, String content,
String group, String tag, int icon,
int importance,
String[] actions, String[] titles)
String[] actions, String[] titles,
long delay)
{
this.content = content;
this.title = title;
@ -97,6 +102,7 @@ public final class EmacsDesktopNotification
this.importance = importance;
this.actions = actions;
this.titles = titles;
this.delay = delay;
}
@ -191,6 +197,8 @@ public final class EmacsDesktopNotification
builder.setContentTitle (title);
builder.setContentText (content);
builder.setSmallIcon (icon);
builder.setTimeoutAfter (delay);
insertActions (context, builder);
notification = builder.build ();
}
@ -200,35 +208,35 @@ else if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB)
distinct categories, but permit an importance to be
assigned to each individual notification. */
switch (importance)
{
case 2: /* IMPORTANCE_LOW */
default:
priority = Notification.PRIORITY_LOW;
break;
case 3: /* IMPORTANCE_DEFAULT */
priority = Notification.PRIORITY_DEFAULT;
break;
case 4: /* IMPORTANCE_HIGH */
priority = Notification.PRIORITY_HIGH;
break;
}
builder = new Notification.Builder (context);
builder.setContentTitle (title);
builder.setContentText (content);
builder.setSmallIcon (icon);
builder.setPriority (priority);
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.JELLY_BEAN)
insertActions (context, builder);
{
switch (importance)
{
case 2: /* IMPORTANCE_LOW */
default:
priority = Notification.PRIORITY_LOW;
break;
notification = builder.build ();
case 3: /* IMPORTANCE_DEFAULT */
priority = Notification.PRIORITY_DEFAULT;
break;
if (Build.VERSION.SDK_INT > Build.VERSION_CODES.JELLY_BEAN)
notification.priority = priority;
case 4: /* IMPORTANCE_HIGH */
priority = Notification.PRIORITY_HIGH;
break;
}
builder.setPriority (priority);
insertActions (context, builder);
notification = builder.build ();
}
else
notification = builder.getNotification ();
}
else
{

16
java/org/gnu/emacs/EmacsNative.java
View file

@ -281,7 +281,7 @@ public static native SurroundingText getSurroundingText (short window,
public static native int[] getSelection (short window);
/* Graphics functions used as a replacement for potentially buggy
/* Graphics functions used as replacements for potentially buggy
Android APIs. */
public static native void blitRect (Bitmap src, Bitmap dest, int x1,
@ -289,7 +289,6 @@ public static native void blitRect (Bitmap src, Bitmap dest, int x1,
/* Increment the generation ID of the specified BITMAP, forcing its
texture to be re-uploaded to the GPU. */
public static native void notifyPixelsChanged (Bitmap bitmap);
@ -313,6 +312,13 @@ public static native void blitRect (Bitmap src, Bitmap dest, int x1,
in the process. */
public static native boolean ftruncate (int fd);
/* Functions that assist in generating content file names. */
/* Calculate an 8 digit checksum for the byte array DISPLAYNAME
suitable for inclusion in a content file name. */
public static native String displayNameHash (byte[] displayName);
static
{
/* Older versions of Android cannot link correctly with shared
@ -323,7 +329,9 @@ public static native void blitRect (Bitmap src, Bitmap dest, int x1,
Every time you add a new shared library dependency to Emacs,
please add it here as well. */
libraryDeps = new String[] { "png_emacs", "selinux_emacs",
libraryDeps = new String[] { "c++_shared", "gnustl_shared",
"stlport_shared", "gabi++_shared",
"png_emacs", "selinux_emacs",
"crypto_emacs", "pcre_emacs",
"packagelistparser_emacs",
"gnutls_emacs", "gmp_emacs",
@ -331,7 +339,7 @@ public static native void blitRect (Bitmap src, Bitmap dest, int x1,
"tasn1_emacs", "hogweed_emacs",
"jansson_emacs", "jpeg_emacs",
"tiff_emacs", "xml2_emacs",
"icuuc_emacs",
"icuuc_emacs", "harfbuzz_emacs",
"tree-sitter_emacs", };
for (String dependency : libraryDeps)

43
java/org/gnu/emacs/EmacsOpenActivity.java
View file

@ -252,7 +252,7 @@ private class EmacsClientThread extends Thread
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.KITKAT)
{
content = EmacsService.buildContentName (uri);
content = EmacsService.buildContentName (uri, getContentResolver ());
return content;
}
@ -423,6 +423,7 @@ private class EmacsClientThread extends Thread
/* Obtain the intent that started Emacs. */
intent = getIntent ();
action = intent.getAction ();
resolver = getContentResolver ();
if (action == null)
{
@ -534,9 +535,19 @@ private class EmacsClientThread extends Thread
uri = intent.getParcelableExtra (Intent.EXTRA_STREAM);
if ((scheme = uri.getScheme ()) != null
&& scheme.equals ("content"))
&& scheme.equals ("content")
&& (Build.VERSION.SDK_INT
>= Build.VERSION_CODES.KITKAT))
{
tem1 = EmacsService.buildContentName (uri);
tem1 = EmacsService.buildContentName (uri, resolver);
attachmentString = ("'(\"" + (tem1.replace ("\\", "\\\\")
.replace ("\"", "\\\"")
.replace ("$", "\\$"))
+ "\")");
}
else if (scheme != null && scheme.equals ("file"))
{
tem1 = uri.getPath ();
attachmentString = ("'(\"" + (tem1.replace ("\\", "\\\\")
.replace ("\"", "\\\"")
.replace ("$", "\\$"))
@ -566,9 +577,22 @@ private class EmacsClientThread extends Thread
if (uri != null
&& (scheme = uri.getScheme ()) != null
&& scheme.equals ("content"))
&& scheme.equals ("content")
&& (Build.VERSION.SDK_INT
>= Build.VERSION_CODES.KITKAT))
{
tem1 = EmacsService.buildContentName (uri);
tem1
= EmacsService.buildContentName (uri, resolver);
builder.append ("\"");
builder.append (tem1.replace ("\\", "\\\\")
.replace ("\"", "\\\"")
.replace ("$", "\\$"));
builder.append ("\"");
}
else if (scheme != null
&& scheme.equals ("file"))
{
tem1 = uri.getPath ();
builder.append ("\"");
builder.append (tem1.replace ("\\", "\\\\")
.replace ("\"", "\\\"")
@ -602,14 +626,19 @@ private class EmacsClientThread extends Thread
{
fileName = null;
if (scheme.equals ("content"))
if (scheme.equals ("content")
/* Retrieving the native file descriptor of a
ParcelFileDescriptor requires Honeycomb, and
proceeding without this capability is pointless on
systems before KitKat, since Emacs doesn't support
opening content files on those. */
&& Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB)
{
/* This is one of the annoying Android ``content''
URIs. Most of the time, there is actually an
underlying file, but it cannot be found without
opening the file and doing readlink on its file
descriptor in /proc/self/fd. */
resolver = getContentResolver ();
fd = null;
try

108
java/org/gnu/emacs/EmacsService.java
View file

@ -19,6 +19,7 @@
package org.gnu.emacs;
import java.io.ByteArrayOutputStream;
import java.io.FileNotFoundException;
import java.io.IOException;
import java.io.UnsupportedEncodingException;
@ -79,6 +80,7 @@
import android.provider.DocumentsContract;
import android.provider.DocumentsContract.Document;
import android.provider.OpenableColumns;
import android.provider.Settings;
import android.util.Log;
@ -1033,22 +1035,114 @@ invocation of app_process (through android-emacs) can
return false;
}
/* Return a 8 character checksum for the string STRING, after encoding
as UTF-8 data. */
public static String
getDisplayNameHash (String string)
{
byte[] encoded;
ByteArrayOutputStream stream;
int i, ch;
/* Much of the VFS code expects file names to be encoded as modified
UTF-8 data, but Android's JNI implementation produces (while not
accepting!) regular UTF-8 sequences for all characters, even
non-Emoji ones. With no documentation to this effect, save for
two comments nestled in the source code of the Java virtual
machine, it is not sound to assume that this behavior will not be
revised in future or modified releases of Android, and as such,
encode STRING into modified UTF-8 by hand, to protect against
future changes in this respect. */
stream = new ByteArrayOutputStream ();
for (i = 0; i < string.length (); ++i)
{
ch = string.charAt (i);
if (ch != 0 && ch <= 127)
stream.write (ch);
else if (ch <= 2047)
{
stream.write (0xc0 | (0x1f & (ch >> 6)));
stream.write (0x80 | (0x3f & ch));
}
else
{
stream.write (0xe0 | (0x0f & (ch >> 12)));
stream.write (0x80 | (0x3f & (ch >> 6)));
stream.write (0x80 | (0x3f & ch));
}
}
encoded = stream.toByteArray ();
/* Closing a ByteArrayOutputStream has no effect.
encoded.close (); */
return EmacsNative.displayNameHash (encoded);
}
/* Build a content file name for URI.
Return a file name within the /contents/by-authority
pseudo-directory that `android_get_content_name' can then
transform back into an encoded URI.
If a display name can be requested from URI (using the resolver
RESOLVER), append it to this file name.
A content name consists of any number of unencoded path segments
separated by `/' characters, possibly followed by a question mark
and an encoded query string. */
public static String
buildContentName (Uri uri)
buildContentName (Uri uri, ContentResolver resolver)
{
StringBuilder builder;
String displayName;
Cursor cursor;
int column;
builder = new StringBuilder ("/content/by-authority/");
displayName = null;
cursor = null;
try
{
cursor = resolver.query (uri, null, null, null, null);
if (cursor != null)
{
cursor.moveToFirst ();
column
= cursor.getColumnIndexOrThrow (OpenableColumns.DISPLAY_NAME);
displayName
= cursor.getString (column);
/* Verify that the display name is valid, i.e. it
contains no characters unsuitable for a file name and
is nonempty. */
if (displayName.isEmpty () || displayName.contains ("/"))
displayName = null;
}
}
catch (Exception e)
{
/* Ignored. */
}
finally
{
if (cursor != null)
cursor.close ();
}
/* If a display name is available, at this point it should be the
value of displayName. */
builder = new StringBuilder (displayName != null
? "/content/by-authority-named/"
: "/content/by-authority/");
builder.append (uri.getAuthority ());
/* First, append each path segment. */
@ -1065,6 +1159,16 @@ invocation of app_process (through android-emacs) can
if (uri.getEncodedQuery () != null)
builder.append ('?').append (uri.getEncodedQuery ());
/* Append the display name. */
if (displayName != null)
{
builder.append ('/');
builder.append (getDisplayNameHash (displayName));
builder.append ('/');
builder.append (displayName);
}
return builder.toString ();
}

30
java/org/gnu/emacs/EmacsWindow.java
View file

@ -23,7 +23,6 @@
import java.util.ArrayList;
import java.util.List;
import java.util.ListIterator;
import java.util.HashMap;
import java.util.LinkedHashMap;
import java.util.Map;
@ -31,6 +30,7 @@
import android.content.ClipData;
import android.content.ClipDescription;
import android.content.ContentResolver;
import android.content.Context;
import android.graphics.Rect;
@ -49,6 +49,7 @@
import android.view.ViewManager;
import android.view.WindowManager;
import android.util.SparseArray;
import android.util.Log;
import android.os.Build;
@ -108,7 +109,7 @@ private static class Coordinate
/* Map between pointer identifiers and last known position. Used to
compute which pointer changed upon a touch event. */
private HashMap<Integer, Coordinate> pointerMap;
private SparseArray<Coordinate> pointerMap;
/* The window consumer currently attached, if it exists. */
private EmacsWindowAttachmentManager.WindowConsumer attached;
@ -165,7 +166,7 @@ private static class Coordinate
super (handle);
rect = new Rect (x, y, x + width, y + height);
pointerMap = new HashMap<Integer, Coordinate> ();
pointerMap = new SparseArray<Coordinate> ();
/* Create the view from the context's UI thread. The window is
unmapped, so the view is GONE. */
@ -1000,7 +1001,8 @@ private static class Coordinate
case MotionEvent.ACTION_CANCEL:
/* Primary pointer released with index 0. */
pointerID = event.getPointerId (0);
coordinate = pointerMap.remove (pointerID);
coordinate = pointerMap.get (pointerID);
pointerMap.delete (pointerID);
break;
case MotionEvent.ACTION_POINTER_DOWN:
@ -1019,7 +1021,8 @@ private static class Coordinate
/* Pointer removed. Remove it from the map. */
pointerIndex = event.getActionIndex ();
pointerID = event.getPointerId (pointerIndex);
coordinate = pointerMap.remove (pointerID);
coordinate = pointerMap.get (pointerID);
pointerMap.delete (pointerID);
break;
default:
@ -1699,10 +1702,11 @@ else if (EmacsWindow.this.isMapped)
ClipData data;
ClipDescription description;
int i, j, x, y, itemCount;
String type;
String type, uriString;
Uri uri;
EmacsActivity activity;
StringBuilder builder;
ContentResolver resolver;
x = (int) event.getX ();
y = (int) event.getY ();
@ -1799,6 +1803,20 @@ else if (type.equals (ClipDescription.MIMETYPE_TEXT_URILIST))
{
if ((activity.requestDragAndDropPermissions (event) == null))
uri = null;
else
{
resolver = activity.getContentResolver ();
/* Substitute a content file name for the URI, if
possible. */
uriString = EmacsService.buildContentName (uri, resolver);
if (uriString != null)
{
builder.append (uriString).append ("\n");
continue;
}
}
}
if (uri != null)

9
java/org/gnu/emacs/EmacsWindowAttachmentManager.java
View file

@ -124,10 +124,15 @@ public interface WindowConsumer
intent = new Intent (EmacsService.SERVICE,
EmacsMultitaskActivity.class);
intent.addFlags (Intent.FLAG_ACTIVITY_NEW_DOCUMENT
| Intent.FLAG_ACTIVITY_NEW_TASK
intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK
| Intent.FLAG_ACTIVITY_MULTIPLE_TASK);
/* Intent.FLAG_ACTIVITY_NEW_DOCUMENT is lamentably unavailable on
older systems than Lolipop. */
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.LOLLIPOP)
intent.addFlags (Intent.FLAG_ACTIVITY_NEW_DOCUMENT);
if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N)
EmacsService.SERVICE.startActivity (intent);
else

43
lisp/bind-key.el
View file

@ -453,31 +453,28 @@ other modes. See `override-global-mode'."
(macroexp-progn (bind-keys-form args 'override-global-map)))
(defun bind-key--get-binding-description (elem)
(cond
((listp elem)
(let (doc)
(cond
((memq (car elem) '(lambda function))
(if (and bind-key-describe-special-forms
(stringp (nth 2 elem)))
(nth 2 elem)
"#<lambda>"))
((eq 'closure (car elem))
(if (and bind-key-describe-special-forms
(stringp (nth 3 elem)))
(nth 3 elem)
"#<closure>"))
((eq 'keymap (car elem))
"#<keymap>")
((symbolp elem)
(cond
((and bind-key-describe-special-forms (keymapp elem)
;; FIXME: Is this really ever better than the symbol-name?
;; FIXME: `variable-documentation' describe what's in
;; elem's `symbol-value', whereas `elem' here stands for
;; its `symbol-function'.
(stringp (setq doc (get elem 'variable-documentation))))
doc)
(t elem)))
((and bind-key-describe-special-forms (functionp elem)
(stringp (setq doc (documentation elem))))
doc) ;;FIXME: Keep only the first line?
;; FIXME: Use `help-fns-function-name'?
((consp elem)
(if (symbolp (car elem))
(format "#<%s>" (car elem))
elem))
(t
elem)))
;; must be a symbol, non-symbol keymap case covered above
((and bind-key-describe-special-forms (keymapp elem))
(let ((doc (get elem 'variable-documentation)))
(if (stringp doc) doc elem)))
((symbolp elem)
elem)
(t
"#<byte-compiled lambda>")))
(format "#<%s>" (type-of elem))))))
(defun bind-key--compare-keybindings (l r)
(let* ((regex bind-key-segregation-regexp)

2
lisp/calendar/calendar.el
View file

@ -1985,7 +1985,7 @@ Gregorian date Sunday, December 31, 1 BC. This function does not
handle dates in years BC."
;; For an explanation, see the footnote on page 384 of "Calendrical
;; Calculations, Part II: Three Historical Calendars" by
;; E. M. Reingold, N. Dershowitz, and S. M. Clamen,
;; E. M. Reingold, N. Dershowitz, and S. M. Clamen,
;; Software--Practice and Experience, Volume 23, Number 4 (April,
;; 1993), pages 383-404 <https://doi.org/10.1002/spe.4380230404>
;; <http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.42.6421&rep=rep1&type=pdf>.

8
lisp/calendar/todo-mode.el
View file

@ -1612,7 +1612,7 @@ archive file and the source category is deleted."
(garchive (concat (file-name-sans-extension gfile) ".toda"))
(archived-count (todo-get-count 'archived))
here)
(with-current-buffer (get-buffer (find-file-noselect tfile))
(with-current-buffer (find-file-noselect tfile)
(widen)
(let* ((inhibit-read-only t)
(cbeg (progn
@ -1638,7 +1638,7 @@ archive file and the source category is deleted."
(todo-count (todo-get-count 'todo cat))
(done-count (todo-get-count 'done cat)))
;; Merge into goal todo category.
(with-current-buffer (get-buffer (find-file-noselect gfile))
(with-current-buffer (find-file-noselect gfile)
(unless (derived-mode-p 'todo-mode) (todo-mode))
(widen)
(goto-char (point-min))
@ -1677,7 +1677,7 @@ archive file and the source category is deleted."
(mapc (lambda (m) (set-marker m nil))
(list cbeg tbeg dbeg tend cend))))
(when (> archived-count 0)
(with-current-buffer (get-buffer (find-file-noselect tarchive))
(with-current-buffer (find-file-noselect tarchive)
(widen)
(goto-char (point-min))
(let* ((inhibit-read-only t)
@ -1697,7 +1697,7 @@ archive file and the source category is deleted."
(forward-line)
(buffer-substring-no-properties (point) cend))))
;; Merge into goal archive category, if it exists, else create it.
(with-current-buffer (get-buffer (find-file-noselect garchive))
(with-current-buffer (find-file-noselect garchive)
(let ((gbeg (when (re-search-forward
(concat "^" (regexp-quote
(concat todo-category-beg goal))

2
lisp/comint.el
View file

@ -3510,7 +3510,7 @@ the completions."
;; Read the next key, to process SPC.
(let (key first)
(if (with-current-buffer (get-buffer "*Completions*")
(if (with-current-buffer "*Completions*"
(setq-local comint-displayed-dynamic-completions
completions)
(setq key (read-key-sequence nil)

7
lisp/cus-edit.el
View file

@ -1159,14 +1159,15 @@ argument or if the current major mode has no known group, prompt
for the MODE to customize."
(interactive
(list
(let ((completion-regexp-list '("-mode\\'"))
(group (custom-group-of-mode major-mode)))
(let ((group (custom-group-of-mode major-mode)))
(if (and group (not current-prefix-arg))
major-mode
(intern
(completing-read (format-prompt "Mode" (and group major-mode))
obarray
'custom-group-of-mode
(lambda (s)
(and (string-match "-mode\\'" (symbol-name s))
(custom-group-of-mode s)))
t nil nil (if group (symbol-name major-mode))))))))
(customize-group (custom-group-of-mode mode)))

4
lisp/cus-start.el
View file

@ -846,6 +846,8 @@ since it could result in memory overflow and make Emacs crash."
(x-select-enable-clipboard-manager killing boolean "24.1")
;; xsettings.c
(font-use-system-font font-selection boolean "23.2")
;; xwidget.c
(xwidget-webkit-disable-javascript xwidget boolean "30.1")
;; haikuterm.c
(haiku-debug-on-fatal-error debug boolean "29.1")
;; haikufns.c
@ -906,6 +908,8 @@ since it could result in memory overflow and make Emacs crash."
(symbol-name symbol))
;; Any function from fontset.c will do.
(fboundp 'new-fontset))
((string-match "xwidget-" (symbol-name symbol))
(boundp 'xwidget-internal))
(t t))))
(if (not (boundp symbol))
;; If variables are removed from C code, give an error here!

52
lisp/descr-text.el
View file

@ -42,26 +42,6 @@
(insert-text-button
"(widget)Top" 'type 'help-info 'help-args '("(widget)Top")))
(defun describe-text-sexp (sexp)
"Insert a short description of SEXP in the current buffer."
(let ((pp (condition-case signal
(pp-to-string sexp)
(error (prin1-to-string signal)))))
(when (string-match-p "\n\\'" pp)
(setq pp (substring pp 0 (1- (length pp)))))
(if (and (not (string-search "\n" pp))
(<= (length pp) (- (window-width) (current-column))))
(insert pp)
(insert-text-button
"[Show]"
'follow-link t
'action (lambda (&rest _ignore)
(with-output-to-temp-buffer
"*Pp Eval Output*"
(princ pp)))
'help-echo "mouse-2, RET: pretty print value in another buffer"))))
(defun describe-property-list (properties)
"Insert a description of PROPERTIES in the current buffer.
PROPERTIES should be a list of overlay or text properties.
@ -92,7 +72,9 @@ into help buttons that call `describe-text-category' or
(format "%S" value)
'type 'help-face 'help-args (list value)))
(t
(describe-text-sexp value))))
(require 'pp)
(declare-function pp-insert-short-sexp "pp" (sexp &optional width))
(pp-insert-short-sexp value))))
(insert "\n")))
;;; Describe-Text Commands.
@ -522,24 +504,24 @@ The character information includes:
(setcar composition
(concat
" with the surrounding characters \""
(mapconcat 'describe-char-padded-string
(buffer-substring from pos) "")
(mapconcat #'describe-char-padded-string
(buffer-substring from pos))
"\" and \""
(mapconcat 'describe-char-padded-string
(buffer-substring (1+ pos) to) "")
(mapconcat #'describe-char-padded-string
(buffer-substring (1+ pos) to))
"\""))
(setcar composition
(concat
" with the preceding character(s) \""
(mapconcat 'describe-char-padded-string
(buffer-substring from pos) "")
(mapconcat #'describe-char-padded-string
(buffer-substring from pos))
"\"")))
(if (< (1+ pos) to)
(setcar composition
(concat
" with the following character(s) \""
(mapconcat 'describe-char-padded-string
(buffer-substring (1+ pos) to) "")
(mapconcat #'describe-char-padded-string
(buffer-substring (1+ pos) to))
"\""))
(setcar composition nil)))
(setcar (cdr composition)
@ -568,7 +550,7 @@ The character information includes:
("character"
,(format "%s (displayed as %s) (codepoint %d, #o%o, #x%x)"
char-description
(apply 'propertize char-description
(apply #'propertize char-description
(text-properties-at pos))
char char char))
("charset"
@ -620,7 +602,7 @@ The character information includes:
(if (consp key-list)
(list "type"
(concat "\""
(mapconcat 'identity
(mapconcat #'identity
key-list "\" or \"")
"\"")
"with"
@ -721,7 +703,7 @@ The character information includes:
(let ((unicodedata (describe-char-unicode-data char)))
(if unicodedata
(cons (list "Unicode data" "") unicodedata))))))
(setq max-width (apply 'max (mapcar (lambda (x)
(setq max-width (apply #'max (mapcar (lambda (x)
(if (cadr x) (length (car x)) 0))
item-list)))
(set-buffer src-buf)
@ -736,7 +718,7 @@ The character information includes:
(dolist (clm (cdr elt))
(cond ((eq (car-safe clm) 'insert-text-button)
(insert " ")
(eval clm))
(eval clm t))
((not (zerop (length clm)))
(insert " " clm))))
(insert "\n"))))
@ -855,7 +837,7 @@ The character information includes:
(insert "\n")
(dolist (elt
(cond ((eq describe-char-unidata-list t)
(nreverse (mapcar 'car char-code-property-alist)))
(nreverse (mapcar #'car char-code-property-alist)))
((< char 32)
;; Temporary fix (2016-05-22): The
;; decomposition item for \n corrupts the
@ -898,7 +880,7 @@ characters."
(setq width (- width (length (car last)) 1)))
(let ((ellipsis (and (cdr last) "...")))
(setcdr last nil)
(concat (mapconcat 'identity words " ") ellipsis)))
(concat (mapconcat #'identity words " ") ellipsis)))
"")))
(defun describe-char-eldoc--format (ch &optional width)

26
lisp/dired-x.el
View file

@ -77,12 +77,17 @@ files not writable by you are visited read-only."
(other :tag "non-writable only" if-file-read-only))
:group 'dired-x)
(defcustom dired-omit-size-limit 100000
"Maximum size for the \"omitting\" feature.
(defcustom dired-omit-size-limit 300000
"Maximum buffer size for `dired-omit-mode'.
Omitting will be disabled if the directory listing exceeds this size in
bytes. This variable is ignored when `dired-omit-mode' is called
interactively.
If nil, there is no maximum size."
:type '(choice (const :tag "no maximum" nil) integer)
:group 'dired-x
:version "29.1")
:version "30.1")
(defcustom dired-omit-case-fold 'filesystem
"Determine whether \"omitting\" patterns are case-sensitive.
@ -506,14 +511,23 @@ status message."
(re-search-forward dired-re-mark nil t))))
count)))
(defvar dired-omit--extension-regexp-cache
nil
"A cache of `regexp-opt' applied to `dired-omit-extensions'.
This is a cons whose car is a list of strings and whose cdr is a
regexp produced by `regexp-opt'.")
(defun dired-omit-regexp ()
(unless (equal dired-omit-extensions (car dired-omit--extension-regexp-cache))
(setq dired-omit--extension-regexp-cache
(cons dired-omit-extensions (regexp-opt dired-omit-extensions))))
(concat (if dired-omit-files (concat "\\(" dired-omit-files "\\)") "")
(if (and dired-omit-files dired-omit-extensions) "\\|" "")
(if dired-omit-extensions
(concat ".";; a non-extension part should exist
"\\("
(mapconcat 'regexp-quote dired-omit-extensions "\\|")
"\\)$")
(cdr dired-omit--extension-regexp-cache)
"$")
"")))
;; Returns t if any work was done, nil otherwise.

15
lisp/dnd.el
View file

@ -453,7 +453,10 @@ on FRAME itself.
This function might return immediately if no mouse buttons are
currently being held down. It should only be called upon a
`down-mouse-1' (or similar) event."
`down-mouse-1' (or similar) event.
This function is only supported on X Windows, macOS/GNUstep, and Haiku;
on all other platforms it will signal an error."
(unless (fboundp 'x-begin-drag)
(error "Dragging text from Emacs is not supported by this window system"))
(gui-set-selection 'XdndSelection text)
@ -513,7 +516,10 @@ nil, any drops on FRAME itself will be ignored.
This function might return immediately if no mouse buttons are
currently being held down. It should only be called upon a
`down-mouse-1' (or similar) event."
`down-mouse-1' (or similar) event.
This function is only supported on X Windows, macOS/GNUstep, and Haiku;
on all other platforms it will signal an error."
(unless (fboundp 'x-begin-drag)
(error "Dragging files from Emacs is not supported by this window system"))
(dnd-remove-last-dragged-remote-file)
@ -580,7 +586,10 @@ FRAME, ACTION and ALLOW-SAME-FRAME mean the same as in
FILES is a list of files that will be dragged. If the drop
target doesn't support dropping multiple files, the first file in
FILES will be dragged."
FILES will be dragged.
This function is only supported on X Windows, macOS/GNUstep, and Haiku;
on all other platforms it will signal an error."
(unless (fboundp 'x-begin-drag)
(error "Dragging files from Emacs is not supported by this window system"))
(dnd-remove-last-dragged-remote-file)

2
lisp/emacs-lisp/advice.el
View file

@ -2042,8 +2042,6 @@ in that CLASS."
function class name)))
(error "ad-remove-advice: `%s' is not advised" function)))
(declare-function comp-subr-trampoline-install "comp-run")
;;;###autoload
(defun ad-add-advice (function advice class position)
"Add a piece of ADVICE to FUNCTION's list of advices in CLASS.

4
lisp/emacs-lisp/bindat.el
View file

@ -945,9 +945,13 @@ a bindat type expression."
(bindat-defmacro sint (bitlen le)
"Signed integer of size BITLEN.
Big-endian if LE is nil and little-endian if not."
(unless lexical-binding
(error "The `sint' type requires 'lexical-binding'"))
(let ((bl (make-symbol "bitlen"))
(max (make-symbol "max"))
(wrap (make-symbol "wrap")))
;; FIXME: This `let*' around the `struct' results in code which the
;; byte-compiler does not handle efficiently. 🙁
`(let* ((,bl ,bitlen)
(,max (ash 1 (1- ,bl)))
(,wrap (+ ,max ,max)))

1
lisp/emacs-lisp/byte-opt.el
View file

@ -3118,7 +3118,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
;;
(eval-when-compile
(or (compiled-function-p (symbol-function 'byte-optimize-form))
(assq 'byte-code (symbol-function 'byte-optimize-form))
(let ((byte-optimize nil)
(byte-compile-warnings nil))
(mapc (lambda (x)

15
lisp/emacs-lisp/bytecomp.el
View file

@ -5558,23 +5558,14 @@ invoked interactively."
(if (null f)
" <top level>";; shouldn't insert nil then, actually -sk
" <not defined>"))
((subrp (setq f (symbol-function f)))
" <subr>")
((symbolp f)
((symbolp (setq f (symbol-function f))) ;; An alias.
(format " ==> %s" f))
((byte-code-function-p f)
"<compiled function>")
((not (consp f))
"<malformed function>")
(format " <%s>" (type-of f)))
((eq 'macro (car f))
(if (or (compiled-function-p (cdr f))
;; FIXME: Can this still happen?
(assq 'byte-code (cdr (cdr (cdr f)))))
(if (compiled-function-p (cdr f))
" <compiled macro>"
" <macro>"))
((assq 'byte-code (cdr (cdr f)))
;; FIXME: Can this still happen?
"<compiled lambda>")
((eq 'lambda (car f))
"<function>")
(t "???"))

2
lisp/emacs-lisp/checkdoc.el
View file

@ -2794,7 +2794,7 @@ function called to create the messages."
": " msg)))
(if (string= checkdoc-diagnostic-buffer "*warn*")
(warn (apply #'concat text))
(with-current-buffer (get-buffer checkdoc-diagnostic-buffer)
(with-current-buffer checkdoc-diagnostic-buffer
(let ((inhibit-read-only t)
(pt (point-max)))
(goto-char pt)

18
lisp/emacs-lisp/cl-extra.el
View file

@ -711,13 +711,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(eval-when-compile (require 'cl-macs)) ;Explicitly, for cl--find-class.
(require 'help-mode)
;; FIXME: We could go crazy and add another entry so describe-symbol can be
;; used with the slot names of CL structs (and/or EIEIO objects).
(add-to-list 'describe-symbol-backends
`(nil ,#'cl-find-class ,#'cl-describe-type)
;; Document the `cons` function before the `cons` type.
t)
(defconst cl--typedef-regexp
(concat "(" (regexp-opt '("defclass" "defstruct" "cl-defstruct"
"cl-deftype" "deftype"))
@ -727,11 +720,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(add-to-list 'find-function-regexp-alist
'(define-type . cl--typedef-regexp)))
(define-button-type 'cl-help-type
:supertype 'help-function-def
'help-function #'cl-describe-type
'help-echo (purecopy "mouse-2, RET: describe this type"))
(define-button-type 'cl-type-definition
:supertype 'help-function-def
'help-echo (purecopy "mouse-2, RET: find type definition"))
@ -784,7 +772,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
(insert (symbol-name type)
(substitute-command-keys " is a type (of kind `"))
(help-insert-xref-button (symbol-name metatype)
'cl-help-type metatype)
'help-type metatype)
(insert (substitute-command-keys "')"))
(when location
(insert (substitute-command-keys " in `"))
@ -803,7 +791,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
(setq cur (cl--class-name cur))
(insert (substitute-quotes "`"))
(help-insert-xref-button (symbol-name cur)
'cl-help-type cur)
'help-type cur)
(insert (substitute-command-keys (if pl "', " "'"))))
(insert ".\n")))
@ -815,7 +803,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
(while (setq cur (pop ch))
(insert (substitute-quotes "`"))
(help-insert-xref-button (symbol-name cur)
'cl-help-type cur)
'help-type cur)
(insert (substitute-command-keys (if ch "', " "'"))))
(insert ".\n")))

10
lisp/emacs-lisp/cl-generic.el
View file

@ -1367,6 +1367,11 @@ These match if the argument is `eql' to VAL."
;;; Dispatch on "normal types".
(defconst cl--generic--unreachable-types
;; FIXME: Try to make that list empty?
'(keyword)
"Built-in classes on which we cannot dispatch for technical reasons.")
(defun cl--generic-type-specializers (tag &rest _)
(and (symbolp tag)
(let ((class (cl--find-class tag)))
@ -1374,8 +1379,7 @@ These match if the argument is `eql' to VAL."
(cl--class-allparents class)))))
(cl-generic-define-generalizer cl--generic-typeof-generalizer
;; FIXME: We could also change `type-of' to return `null' for nil.
10 (lambda (name &rest _) `(if ,name (type-of ,name) 'null))
10 (lambda (name &rest _) `(cl-type-of ,name))
#'cl--generic-type-specializers)
(cl-defmethod cl-generic-generalizers :extra "typeof" (type)
@ -1387,6 +1391,8 @@ This currently works for built-in types and types built on top of records."
(and (symbolp type)
(not (eq type t)) ;; Handled by the `t-generalizer'.
(let ((class (cl--find-class type)))
(when (memq type cl--generic--unreachable-types)
(error "Dispatch on %S is currently not supported" type))
(memq (type-of class)
'(built-in-class cl-structure-class eieio--class)))
(list cl--generic-typeof-generalizer))

47
lisp/emacs-lisp/cl-macs.el
View file

@ -2253,7 +2253,7 @@ Like `cl-flet' but the definitions can refer to previous ones.
;;;###autoload
(defmacro cl-labels (bindings &rest body)
"Make local (recursive) function definitions.
+BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where
BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where
FUNC is the function name, ARGLIST its arguments, and BODY the
forms of the function body. FUNC is defined in any BODY, as well
as FORM, so you can write recursive and mutually recursive
@ -3468,45 +3468,12 @@ Of course, we really can't know that for sure, so it's just a heuristic."
;; Please keep it in sync with `comp-known-predicates'.
(pcase-dolist (`(,type . ,pred)
;; Mostly kept in alphabetical order.
'((array . arrayp)
(atom . atom)
(base-char . characterp)
(bignum . bignump)
(boolean . booleanp)
(bool-vector . bool-vector-p)
(buffer . bufferp)
(byte-code-function . byte-code-function-p)
(character . natnump)
(char-table . char-table-p)
(command . commandp)
(compiled-function . compiled-function-p)
(hash-table . hash-table-p)
(cons . consp)
(fixnum . fixnump)
(float . floatp)
(frame . framep)
(function . functionp)
(integer . integerp)
(keyword . keywordp)
(list . listp)
(marker . markerp)
(natnum . natnump)
(number . numberp)
(null . null)
(obarray . obarrayp)
(overlay . overlayp)
(process . processp)
(real . numberp)
(sequence . sequencep)
(subr . subrp)
(string . stringp)
(symbol . symbolp)
(symbol-with-pos . symbol-with-pos-p)
(vector . vectorp)
(window . windowp)
;; FIXME: Do we really want to consider these types?
(number-or-marker . number-or-marker-p)
(integer-or-marker . integer-or-marker-p)
;; These aren't defined via `cl--define-built-in-type'.
'((base-char . characterp) ;Could be subtype of `fixnum'.
(character . natnump) ;Could be subtype of `fixnum'.
(command . commandp) ;Subtype of closure & subr.
(natnum . natnump) ;Subtype of fixnum & bignum.
(real . numberp) ;Not clear where it would fit.
))
(put type 'cl-deftype-satisfies pred))

77
lisp/emacs-lisp/cl-preloaded.el
View file

@ -260,7 +260,7 @@
(cl-defstruct (cl--class
(:constructor nil)
(:copier nil))
"Type of descriptors for any kind of structure-like data."
"Abstract supertype of all type descriptors."
;; Intended to be shared between defstruct and defclass.
(name nil :type symbol) ;The type name.
(docstring nil :type string)
@ -306,9 +306,11 @@
(:constructor nil)
(:constructor built-in-class--make (name docstring parents))
(:copier nil))
"Type descriptors for built-in types.
The `slots' (and hence `index-table') are currently unused."
)
(defmacro cl--define-built-in-type (name parents &optional docstring &rest _slots)
(defmacro cl--define-built-in-type (name parents &optional docstring &rest slots)
;; `slots' is currently unused, but we could make it take
;; a list of "slot like properties" together with the corresponding
;; accessor, and then we could maybe even make `slot-value' work
@ -317,32 +319,49 @@
(unless (listp parents) (setq parents (list parents)))
(unless (or parents (eq name t))
(error "Missing parents for %S: %S" name parents))
`(progn
(put ',name 'cl--class
(built-in-class--make ',name ,docstring
(mapcar (lambda (type)
(let ((class (get type 'cl--class)))
(unless class
(error "Unknown type: %S" type))
class))
',parents)))))
(let ((predicate (intern-soft (format
(if (string-match "-" (symbol-name name))
"%s-p" "%sp")
name))))
(unless (fboundp predicate) (setq predicate nil))
(while (keywordp (car slots))
(let ((kw (pop slots)) (val (pop slots)))
(pcase kw
(:predicate (setq predicate val))
(_ (error "Unknown keyword arg: %S" kw)))))
`(progn
,(if predicate `(put ',name 'cl-deftype-satisfies #',predicate)
;; (message "Missing predicate for: %S" name)
nil)
(put ',name 'cl--class
(built-in-class--make ',name ,docstring
(mapcar (lambda (type)
(let ((class (get type 'cl--class)))
(unless class
(error "Unknown type: %S" type))
class))
',parents))))))
;; FIXME: Our type DAG has various quirks:
;; - `subr' says it's a `compiled-function' but that's not true
;; for those subrs that are special forms!
;; - Some `keyword's are also `symbol-with-pos' but that's not reflected
;; in the DAG.
;; - An OClosure can be an interpreted function or a `byte-code-function',
;; so the DAG of OClosure types is "orthogonal" to the distinction
;; between interpreted and compiled functions.
(cl--define-built-in-type t nil "The type of everything.")
(cl--define-built-in-type atom t "The type of anything but cons cells.")
(cl--define-built-in-type t nil "Abstract supertype of everything.")
(cl--define-built-in-type atom t "Abstract supertype of anything but cons cells."
:predicate atom)
(cl--define-built-in-type tree-sitter-compiled-query atom)
(cl--define-built-in-type tree-sitter-node atom)
(cl--define-built-in-type tree-sitter-parser atom)
(cl--define-built-in-type user-ptr atom)
(declare-function user-ptrp "data.c")
(when (fboundp 'user-ptrp)
(cl--define-built-in-type user-ptr atom nil
;; FIXME: Shouldn't it be called
;; `user-ptr-p'?
:predicate user-ptrp))
(cl--define-built-in-type font-object atom)
(cl--define-built-in-type font-entity atom)
(cl--define-built-in-type font-spec atom)
@ -355,10 +374,11 @@
(cl--define-built-in-type buffer atom)
(cl--define-built-in-type window atom)
(cl--define-built-in-type process atom)
(cl--define-built-in-type finalizer atom)
(cl--define-built-in-type window-configuration atom)
(cl--define-built-in-type overlay atom)
(cl--define-built-in-type number-or-marker atom
"Abstract super type of both `number's and `marker's.")
"Abstract supertype of both `number's and `marker's.")
(cl--define-built-in-type symbol atom
"Type of symbols."
;; Example of slots we could document. It would be desirable to
@ -373,14 +393,14 @@
(cl--define-built-in-type obarray atom)
(cl--define-built-in-type native-comp-unit atom)
(cl--define-built-in-type sequence t "Abstract super type of sequences.")
(cl--define-built-in-type sequence t "Abstract supertype of sequences.")
(cl--define-built-in-type list sequence)
(cl--define-built-in-type array (sequence atom) "Abstract super type of arrays.")
(cl--define-built-in-type array (sequence atom) "Abstract supertype of arrays.")
(cl--define-built-in-type number (number-or-marker)
"Abstract super type of numbers.")
"Abstract supertype of numbers.")
(cl--define-built-in-type float (number))
(cl--define-built-in-type integer-or-marker (number-or-marker)
"Abstract super type of both `integer's and `marker's.")
"Abstract supertype of both `integer's and `marker's.")
(cl--define-built-in-type integer (number integer-or-marker))
(cl--define-built-in-type marker (integer-or-marker))
(cl--define-built-in-type bignum (integer)
@ -404,26 +424,29 @@ For this build of Emacs it's %dbit."
"Type of special arrays that are indexed by characters.")
(cl--define-built-in-type string (array))
(cl--define-built-in-type null (boolean list) ;FIXME: `atom' comes before `list'?
"Type of the nil value.")
"Type of the nil value."
:predicate null)
(cl--define-built-in-type cons (list)
"Type of cons cells."
;; Example of slots we could document.
(car car) (cdr cdr))
(cl--define-built-in-type function (atom)
"Abstract super type of function values.")
"Abstract supertype of function values.")
(cl--define-built-in-type compiled-function (function)
"Abstract type of functions that have been compiled.")
(cl--define-built-in-type byte-code-function (compiled-function)
"Type of functions that have been byte-compiled.")
(cl--define-built-in-type subr (compiled-function)
(cl--define-built-in-type subr (atom)
"Abstract type of functions compiled to machine code.")
(cl--define-built-in-type module-function (function)
"Type of functions provided via the module API.")
(cl--define-built-in-type interpreted-function (function)
"Type of functions that have not been compiled.")
(cl--define-built-in-type subr-native-elisp (subr)
"Type of function that have been compiled by the native compiler.")
(cl--define-built-in-type subr-primitive (subr)
(cl--define-built-in-type special-form (subr)
"Type of the core syntactic elements of the Emacs Lisp language.")
(cl--define-built-in-type subr-native-elisp (subr compiled-function)
"Type of functions that have been compiled by the native compiler.")
(cl--define-built-in-type primitive-function (subr compiled-function)
"Type of functions hand written in C.")
(unless (cl--class-parents (cl--find-class 'cl-structure-object))

2
lisp/emacs-lisp/cl-print.el
View file

@ -461,7 +461,7 @@ primitives such as `prin1'.")
(defun cl-print--preprocess (object)
(let ((print-number-table (make-hash-table :test 'eq :rehash-size 2.0)))
(if (fboundp 'print--preprocess)
(if (fboundp 'print--preprocess) ;Emacs≥26
;; Use the predefined C version if available.
(print--preprocess object) ;Fill print-number-table!
(let ((cl-print--number-index 0))

19
lisp/emacs-lisp/comp-cstr.el
View file

@ -288,13 +288,10 @@ Return them as multiple value."
(apply #'append
(mapcar #'comp--direct-supertypes typeset)))
for subs = (comp--direct-subtypes sup)
when (and (length> subs 1) ;;FIXME: Why?
;; Every subtype of `sup` is a subtype of
;; some element of `typeset`?
;; It's tempting to just check (member x typeset),
;; but think of the typeset (marker number),
;; where `sup' is `integer-or-marker' and `sub'
;; is `integer'.
when (and (length> subs 1) ;; If there's only one sub do
;; nothing as we want to
;; return the most specific
;; type.
(cl-every (lambda (sub)
(cl-some (lambda (type)
(comp-subtype-p sub type))
@ -575,7 +572,7 @@ All SRCS constraints must be homogeneously negated or non-negated."
;; We propagate only values those types are not already
;; into typeset.
when (cl-notany (lambda (x)
(comp-subtype-p (type-of v) x))
(comp-subtype-p (cl-type-of v) x))
(comp-cstr-typeset dst))
collect v)))
@ -664,7 +661,7 @@ DST is returned."
;; Verify disjoint condition between positive types and
;; negative types coming from values, in case give-up.
(let ((neg-value-types (nconc (mapcar #'type-of (valset neg))
(let ((neg-value-types (nconc (mapcar #'cl-type-of (valset neg))
(when (range neg)
'(integer)))))
(when (cl-some (lambda (x)
@ -685,7 +682,7 @@ DST is returned."
((cl-some (lambda (x)
(cl-some (lambda (y)
(comp-subtype-p y x))
(mapcar #'type-of (valset pos))))
(mapcar #'cl-type-of (valset pos))))
(typeset neg))
(give-up))
(t
@ -1108,7 +1105,7 @@ DST is returned."
(cl-loop for v in (valset dst)
unless (symbolp v)
do (push v strip-values)
(push (type-of v) strip-types))
(push (cl-type-of v) strip-types))
(when strip-values
(setf (typeset dst) (comp-union-typesets (typeset dst) strip-types)
(valset dst) (cl-set-difference (valset dst) strip-values)))

21
lisp/emacs-lisp/comp-run.el
View file

@ -233,8 +233,8 @@ display a message."
"`comp-files-queue' should be \".el\" files: %s"
source-file)
when (or native-comp-always-compile
load ; Always compile when the compilation is
; commanded for late load.
load ; Always compile when the compilation is
; commanded for late load.
;; Skip compilation if `comp-el-to-eln-filename' fails
;; to find a writable directory.
(with-demoted-errors "Async compilation :%S"
@ -256,6 +256,7 @@ display a message."
load-path
backtrace-line-length
byte-compile-warnings
comp-sanitizer-emit
;; package-load-list
;; package-user-dir
;; package-directory-list
@ -364,13 +365,15 @@ Return the trampoline if found or nil otherwise."
(when (memq subr-name comp-warn-primitives)
(warn "Redefining `%s' might break native compilation of trampolines."
subr-name))
(unless (or (null native-comp-enable-subr-trampolines)
(memq subr-name native-comp-never-optimize-functions)
(gethash subr-name comp-installed-trampolines-h))
(cl-assert (subr-primitive-p (symbol-function subr-name)))
(when-let ((trampoline (or (comp-trampoline-search subr-name)
(comp-trampoline-compile subr-name))))
(comp--install-trampoline subr-name trampoline))))
(let ((subr (symbol-function subr-name)))
(unless (or (not (string= subr-name (subr-name subr))) ;; (bug#69573)
(null native-comp-enable-subr-trampolines)
(memq subr-name native-comp-never-optimize-functions)
(gethash subr-name comp-installed-trampolines-h))
(cl-assert (subr-primitive-p subr))
(when-let ((trampoline (or (comp-trampoline-search subr-name)
(comp-trampoline-compile subr-name))))
(comp--install-trampoline subr-name trampoline)))))
;;;###autoload
(defun native--compile-async (files &optional recursively load selector)

81
lisp/emacs-lisp/comp.el
View file

@ -165,6 +165,7 @@ Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.")
comp--tco
comp--fwprop
comp--remove-type-hints
comp--sanitizer
comp--compute-function-types
comp--final)
"Passes to be executed in order.")
@ -202,7 +203,7 @@ Useful to hook into pass checkers.")
(consp . cons)
(floatp . float)
(framep . frame)
(functionp . (or function symbol))
(functionp . (or function symbol cons))
(hash-table-p . hash-table)
(integer-or-marker-p . integer-or-marker)
(integerp . integer)
@ -244,6 +245,7 @@ Useful to hook into pass checkers.")
(defun comp--pred-to-cstr (predicate)
"Given PREDICATE, return the corresponding constraint."
;; FIXME: Unify those two hash tables?
(or (gethash predicate comp-known-predicates-h)
(gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt))))
@ -1786,7 +1788,9 @@ into the C code forwarding the compilation unit."
for insn in (comp-block-insns b)
for (op . args) = insn
if (comp--assign-op-p op)
do (comp--collect-mvars (cdr args))
do (comp--collect-mvars (if (eq op 'setimm)
(cl-first args)
(cdr args)))
else
do (comp--collect-mvars args))))
@ -2440,6 +2444,8 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil."
(setf (comp-vec-aref frame slot-n) mvar
(cadr insn) mvar))))
(pcase insn
(`(setimm ,(pred targetp) ,_imm)
(new-lvalue))
(`(,(pred comp--assign-op-p) ,(pred targetp) . ,_)
(let ((mvar (comp-vec-aref frame slot-n)))
(setf (cddr insn) (cl-nsubst-if mvar #'targetp (cddr insn))))
@ -2543,7 +2549,7 @@ Return t when one or more block was removed, nil otherwise."
;; native compiling all Emacs code-base.
"Max number of scanned insn before giving-up.")
(defun comp--copy-insn (insn)
(defun comp--copy-insn-rec (insn)
"Deep copy INSN."
;; Adapted from `copy-tree'.
(if (consp insn)
@ -2560,6 +2566,13 @@ Return t when one or more block was removed, nil otherwise."
(copy-comp-mvar insn)
insn)))
(defun comp--copy-insn (insn)
"Deep copy INSN."
(pcase insn
(`(setimm ,mvar ,imm)
`(setimm ,(copy-comp-mvar mvar) ,imm))
(_ (comp--copy-insn-rec insn))))
(defmacro comp--apply-in-env (func &rest args)
"Apply FUNC to ARGS in the current compilation environment."
`(let ((env (cl-loop
@ -2901,7 +2914,8 @@ Return the list of m-var ids nuked."
for (op arg0 . rest) = insn
if (comp--assign-op-p op)
do (push (comp-mvar-id arg0) l-vals)
(setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals))
(unless (eq op 'setimm)
(setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals)))
else
do (setf r-vals (nconc (comp--collect-mvar-ids insn) r-vals))))
;; Every l-value appearing that does not appear as r-value has no right to
@ -3005,6 +3019,65 @@ These are substituted with a normal `set' op."
(comp--log-func comp-func 3))))
(comp-ctxt-funcs-h comp-ctxt)))
;;; Sanitizer pass specific code.
;; This pass aims to verify compile-time value-type predictions during
;; execution of the code.
;; The sanitizer pass injects a call to 'helper_sanitizer_assert' before
;; each conditional branch. 'helper_sanitizer_assert' will verify that
;; the variable tested by the conditional branch is of the predicted
;; value type, or signal an error otherwise.
;;; Example:
;; Assume we want to compile 'test.el' and test the function `foo'
;; defined in it. Then:
;; - Native-compile 'test.el' instrumenting it for sanitizer usage:
;; (let ((comp-sanitizer-emit t))
;; (load (native-compile "test.el")))
;; - Run `foo' with the sanitizer active:
;; (let ((comp-sanitizer-active t))
;; (foo))
(defvar comp-sanitizer-emit nil
"Gates the sanitizer pass.
This is intended to be used only for development and verification of
the native compiler.")
(defun comp--sanitizer (_)
(when comp-sanitizer-emit
(cl-loop
for f being each hash-value of (comp-ctxt-funcs-h comp-ctxt)
for comp-func = f
unless (comp-func-has-non-local comp-func)
do
(cl-loop
for b being each hash-value of (comp-func-blocks f)
do
(cl-loop
named in-the-basic-block
for insns-seq on (comp-block-insns b)
do (pcase insns-seq
(`((cond-jump ,(and (pred comp-mvar-p) mvar-tested)
,(pred comp-mvar-p) ,_bb1 ,_bb2))
(let ((type (comp-cstr-to-type-spec mvar-tested))
(insn (car insns-seq)))
;; No need to check if type is t.
(unless (eq type t)
(comp--add-const-to-relocs type)
(setcar
insns-seq
(comp--call 'helper_sanitizer_assert
mvar-tested
(make--comp-mvar :constant type)))
(setcdr insns-seq (list insn)))
;; (setf (comp-func-ssa-status comp-func) 'dirty)
(cl-return-from in-the-basic-block))))))
do (comp--log-func comp-func 3))))
;;; Function types pass specific code.

25
lisp/emacs-lisp/debug.el
View file

@ -153,6 +153,12 @@ where CAUSE can be:
(insert (debugger--buffer-state-content state)))
(goto-char (debugger--buffer-state-pos state)))
(defvar debugger--last-error nil)
(defun debugger--duplicate-p (args)
(pcase args
(`(error ,err . ,_) (and (consp err) (eq err debugger--last-error)))))
;;;###autoload
(if (null noninteractive)
(setq debugger 'debug))
@ -177,9 +183,14 @@ first will be printed into the backtrace buffer.
If `inhibit-redisplay' is non-nil when this function is called,
the debugger will not be entered."
(interactive)
(if inhibit-redisplay
;; Don't really try to enter debugger within an eval from redisplay.
(if (or inhibit-redisplay
(debugger--duplicate-p args))
;; Don't really try to enter debugger within an eval from redisplay
;; or if we already popper into the debugger for this error,
;; which can happen when we have several nested `handler-bind's that
;; want to invoke the debugger.
debugger-value
(setq debugger--last-error nil)
(let ((non-interactive-frame
(or noninteractive ;FIXME: Presumably redundant.
;; If we're in the initial-frame (where `message' just
@ -202,7 +213,7 @@ the debugger will not be entered."
(let (debugger-value
(debugger-previous-state
(if (get-buffer "*Backtrace*")
(with-current-buffer (get-buffer "*Backtrace*")
(with-current-buffer "*Backtrace*"
(debugger--save-buffer-state))))
(debugger-args args)
(debugger-buffer (get-buffer-create "*Backtrace*"))
@ -320,6 +331,12 @@ the debugger will not be entered."
(backtrace-mode))))
(with-timeout-unsuspend debugger-with-timeout-suspend)
(set-match-data debugger-outer-match-data)))
(when (eq 'error (car-safe debugger-args))
;; Remember the error we just debugged, to avoid re-entering
;; the debugger if some higher-up `handler-bind' invokes us
;; again, oblivious that the error was already debugged from
;; a more deeply nested `handler-bind'.
(setq debugger--last-error (nth 1 debugger-args)))
(setq debug-on-next-call debugger-step-after-exit)
debugger-value))))
@ -653,7 +670,7 @@ Complete list of commands:
(princ (debugger-eval-expression exp))
(terpri))
(with-current-buffer (get-buffer debugger-record-buffer)
(with-current-buffer debugger-record-buffer
(message "%s"
(buffer-substring (line-beginning-position 0)
(line-end-position 0)))))

155
lisp/emacs-lisp/edebug.el
View file

@ -193,11 +193,15 @@ Use this with caution since it is not debugged."
(defcustom edebug-print-length 50
"If non-nil, default value of `print-length' for printing results in Edebug."
:type '(choice integer (const nil)))
"Maximum length of list to print before abbreviating, when in Edebug.
If this is nil, use the value of `print-length' instead."
:type '(choice (integer :tag "A number")
(const :tag "Use `print-length'" nil)))
(defcustom edebug-print-level 50
"If non-nil, default value of `print-level' for printing results in Edebug."
:type '(choice integer (const nil)))
"Maximum depth of list nesting to print before abbreviating, when in Edebug.
If nil, use the value of `print-level' instead."
:type '(choice (integer :tag "A number")
(const :tag "Use `print-level'" nil)))
(defcustom edebug-print-circle t
"If non-nil, default value of `print-circle' for printing results in Edebug."
:type 'boolean)
@ -1230,10 +1234,12 @@ purpose by adding an entry to this alist, and setting
;; But the list will just be reversed.
,@(nreverse edebug-def-args))
'nil)
;; Make sure `forms' is not nil so we don't accidentally return
;; the magic keyword. Mark the closure so we don't throw away
;; unused vars (bug#59213).
#'(lambda () :closure-dont-trim-context ,@(or forms '(nil)))))
#'(lambda ()
;; Mark the closure so we don't throw away unused vars (bug#59213).
:closure-dont-trim-context
;; Make sure `forms' is not nil so we don't accidentally return
;; the magic keyword.
,@(or forms '(nil)))))
(defvar edebug-form-begin-marker) ; the mark for def being instrumented
@ -1271,55 +1277,48 @@ Does not unwrap inside vectors, records, structures, or hash tables."
(pcase sexp
(`(edebug-after ,_before-form ,_after-index ,form)
form)
(`(lambda ,args (edebug-enter ',_sym ,_arglist
(function (lambda nil . ,body))))
`(lambda ,args ,@body))
(`(closure ,env ,args (edebug-enter ',_sym ,_arglist
(function (lambda nil . ,body))))
`(closure ,env ,args ,@body))
(`(edebug-enter ',_sym ,_args (function (lambda nil . ,body)))
(`(edebug-enter ',_sym ,_args
#'(lambda nil :closure-dont-trim-context . ,body))
(macroexp-progn body))
(_ sexp)))
(defconst edebug--unwrap-cache
(make-hash-table :test 'eq :weakness 'key)
"Hash-table containing the results of unwrapping cons cells.
These results are reused to avoid redundant work but also to avoid
infinite loops when the code/environment contains a circular object.")
(defun edebug-unwrap* (sexp)
"Return the SEXP recursively unwrapped."
(let ((ht (make-hash-table :test 'eq)))
(edebug--unwrap1 sexp ht)))
(defun edebug--unwrap1 (sexp hash-table)
"Unwrap SEXP using HASH-TABLE of things already unwrapped.
HASH-TABLE contains the results of unwrapping cons cells within
SEXP, which are reused to avoid infinite loops when SEXP is or
contains a circular object."
(let ((new-sexp (edebug-unwrap sexp)))
(while (not (eq sexp new-sexp))
(setq sexp new-sexp
new-sexp (edebug-unwrap sexp)))
(if (consp new-sexp)
(let ((result (gethash new-sexp hash-table nil)))
(unless result
(let ((remainder new-sexp)
current)
(setq result (cons nil nil)
current result)
(while
(progn
(puthash remainder current hash-table)
(setf (car current)
(edebug--unwrap1 (car remainder) hash-table))
(setq remainder (cdr remainder))
(cond
((atom remainder)
(setf (cdr current)
(edebug--unwrap1 remainder hash-table))
nil)
((gethash remainder hash-table nil)
(setf (cdr current) (gethash remainder hash-table nil))
nil)
(t (setq current
(setf (cdr current) (cons nil nil)))))))))
result)
new-sexp)))
(while (not (eq sexp (setq sexp (edebug-unwrap sexp)))))
(cond
((consp sexp)
(or (gethash sexp edebug--unwrap-cache nil)
(let ((remainder sexp)
(current (cons nil nil)))
(prog1 current
(while
(progn
(puthash remainder current edebug--unwrap-cache)
(setf (car current)
(edebug-unwrap* (car remainder)))
(setq remainder (cdr remainder))
(cond
((atom remainder)
(setf (cdr current)
(edebug-unwrap* remainder))
nil)
((gethash remainder edebug--unwrap-cache nil)
(setf (cdr current) (gethash remainder edebug--unwrap-cache nil))
nil)
(t (setq current
(setf (cdr current) (cons nil nil)))))))))))
((byte-code-function-p sexp)
(apply #'make-byte-code
(aref sexp 0) (aref sexp 1)
(vconcat (mapcar #'edebug-unwrap* (aref sexp 2)))
(nthcdr 3 (append sexp ()))))
(t sexp)))
(defun edebug-defining-form (cursor form-begin form-end speclist)
@ -4240,13 +4239,13 @@ Remove frames for Edebug's functions and the lambdas in
and after-index fields in both FRAMES and the returned list
of deinstrumented frames, for those frames where the source
code location is known."
(let (skip-next-lambda def-name before-index after-index results
(index (length frames)))
(let ((index (length frames))
skip-next-lambda def-name before-index after-index results)
(dolist (frame (reverse frames))
(let ((new-frame (copy-edebug--frame frame))
(fun (edebug--frame-fun frame))
(args (edebug--frame-args frame)))
(cl-decf index)
(cl-decf index) ;; FIXME: Not used?
(pcase fun
('edebug-enter
(setq skip-next-lambda t
@ -4256,38 +4255,46 @@ code location is known."
(nth 1 (nth 0 args))
(nth 0 args))
after-index (nth 1 args)))
((pred edebug--symbol-not-prefixed-p)
(edebug--unwrap-frame new-frame)
(edebug--add-source-info new-frame def-name before-index after-index)
(edebug--add-source-info frame def-name before-index after-index)
(push new-frame results)
(setq before-index nil
after-index nil))
(`(,(or 'lambda 'closure) . ,_)
;; Just skip all our own frames.
((pred edebug--symbol-prefixed-p) nil)
(_
(when (and skip-next-lambda
(not (memq (car-safe fun) '(closure lambda))))
(warn "Edebug--strip-instrumentation expected an interpreted function:\n%S" fun))
(unless skip-next-lambda
(edebug--unwrap-frame new-frame)
(edebug--add-source-info frame def-name before-index after-index)
(edebug--add-source-info new-frame def-name before-index after-index)
(edebug--add-source-info frame def-name before-index after-index)
(push new-frame results))
(setq before-index nil
(setq before-index nil
after-index nil
skip-next-lambda nil)))))
results))
(defun edebug--symbol-not-prefixed-p (sym)
"Return non-nil if SYM is a symbol not prefixed by \"edebug-\"."
(defun edebug--symbol-prefixed-p (sym)
"Return non-nil if SYM is a symbol prefixed by \"edebug-\"."
(and (symbolp sym)
(not (string-prefix-p "edebug-" (symbol-name sym)))))
(string-prefix-p "edebug-" (symbol-name sym))))
(defun edebug--unwrap-frame (frame)
"Remove Edebug's instrumentation from FRAME.
Strip it from the function and any unevaluated arguments."
(setf (edebug--frame-fun frame) (edebug-unwrap* (edebug--frame-fun frame)))
(unless (edebug--frame-evald frame)
(let (results)
(dolist (arg (edebug--frame-args frame))
(push (edebug-unwrap* arg) results))
(setf (edebug--frame-args frame) (nreverse results)))))
(cl-callf edebug-unwrap* (edebug--frame-fun frame))
;; We used to try to be careful to apply `edebug-unwrap' only to source
;; expressions and not to values, so we did not apply unwrap to the arguments
;; of the frame if they had already been evaluated.
;; But this was not careful enough since `edebug-unwrap*' gleefully traverses
;; its argument without paying attention to its syntactic structure so it
;; also "mistakenly" descends into the values contained within the "source
;; code". In practice this *very* rarely leads to undesired results.
;; On the contrary, it's often useful to descend into values because they
;; may contain interpreted closures and hence source code where we *do*
;; want to apply `edebug-unwrap'.
;; So based on this experience, we now also apply `edebug-unwrap*' to
;; the already evaluated arguments.
;;(unless (edebug--frame-evald frame)
(cl-callf (lambda (xs) (mapcar #'edebug-unwrap* xs))
(edebug--frame-args frame)))
(defun edebug--add-source-info (frame def-name before-index after-index)
"Update FRAME with the additional info needed by an edebug--frame.

2
lisp/emacs-lisp/eieio-core.el
View file

@ -1046,7 +1046,7 @@ method invocation orders of the involved classes."
(defun cl--generic-struct-tag (name &rest _)
;; Use exactly the same code as for `typeof'.
`(if ,name (type-of ,name) 'null))
`(cl-type-of ,name))
(cl-generic-define-generalizer eieio--generic-generalizer
;; Use the exact same tagcode as for cl-struct, so that methods

2
lisp/emacs-lisp/eieio-opt.el
View file

@ -50,7 +50,7 @@ variable `eieio-default-superclass'."
(if (not root-class) (setq root-class 'eieio-default-superclass))
(cl-check-type root-class class)
(display-buffer (get-buffer-create "*EIEIO OBJECT BROWSE*") t)
(with-current-buffer (get-buffer "*EIEIO OBJECT BROWSE*")
(with-current-buffer "*EIEIO OBJECT BROWSE*"
(erase-buffer)
(goto-char 0)
(eieio-browse-tree root-class "" "")

2
lisp/emacs-lisp/nadvice.el
View file

@ -189,7 +189,7 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.")
if
(cl-assert (eq 'interactive (car if)))
(let ((form (cadr if)))
(if (macroexp-const-p form)
(if (macroexp-const-p form) ;Common case: a string.
if
;; The interactive is expected to be run in the static context
;; that the function captured.

2
lisp/emacs-lisp/oclosure.el
View file

@ -437,7 +437,7 @@ This has 2 uses:
- For compiled code, this is used as a marker which cconv uses to check that
immutable fields are indeed not mutated."
(if (byte-code-function-p oclosure)
;; Actually, this should never happen since the `cconv.el' should have
;; Actually, this should never happen since `cconv.el' should have
;; optimized away the call to this function.
oclosure
;; For byte-coded functions, we store the type as a symbol in the docstring

2
lisp/emacs-lisp/package.el
View file

@ -2941,7 +2941,7 @@ Helper function for `describe-package'."
(insert " "))
(insert "\n"))
(when maintainers
(unless (proper-list-p maintainers)
(when (stringp (car maintainers))
(setq maintainers (list maintainers)))
(package--print-help-section
(if (cdr maintainers) "Maintainers" "Maintainer"))

34
lisp/emacs-lisp/pp.el
View file

@ -193,11 +193,18 @@ it inserts and pretty-prints that arg at point."
(and
(save-excursion
(goto-char beg)
(if (save-excursion (skip-chars-backward " \t({[',")
(bolp))
;; The sexp was already on its own line.
nil
(skip-chars-backward " \t")
;; We skip backward over open parens because cutting
;; the line right after an open paren does not help
;; reduce the indentation depth.
;; Similarly, we prefer to cut before a "." than after
;; it because it reduces the indentation depth.
(while (not (zerop (skip-chars-backward " \t({[',.")))
(and (memq (char-before) '(?# ?s ?f))
(looking-back "#[sf]?" (- (point) 2))
(goto-char (match-beginning 0))))
(if (bolp)
;; The sexp already starts on its own line.
(progn (goto-char beg) nil)
(setq beg (copy-marker beg t))
(if paired (setq paired (copy-marker paired t)))
;; We could try to undo this insertion if it
@ -346,6 +353,23 @@ after OUT-BUFFER-NAME."
(setq buffer-read-only nil)
(setq-local font-lock-verbose nil)))))
(defun pp-insert-short-sexp (sexp &optional width)
"Insert a short description of SEXP in the current buffer.
WIDTH is the maximum width to use for it and it defaults to the
space available between point and the window margin."
(let ((printed (format "%S" sexp)))
(if (and (not (string-search "\n" printed))
(<= (string-width printed)
(or width (- (window-width) (current-column)))))
(insert printed)
(insert-text-button
"[Show]"
'follow-link t
'action (lambda (&rest _ignore)
;; FIXME: Why "eval output"?
(pp-display-expression sexp "*Pp Eval Output*"))
'help-echo "mouse-2, RET: pretty print value in another buffer"))))
;;;###autoload
(defun pp-eval-expression (expression)
"Evaluate EXPRESSION and pretty-print its value.

2
lisp/emacs-lisp/re-builder.el
View file

@ -825,7 +825,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
(defun reb-restart-font-lock ()
"Restart `font-lock-mode' to fit current regexp format."
(with-current-buffer (get-buffer reb-buffer)
(with-current-buffer reb-buffer
(let ((font-lock-is-on font-lock-mode))
(font-lock-mode -1)
(kill-local-variable 'font-lock-set-defaults)

3
lisp/emacs-lisp/seq.el
View file

@ -362,8 +362,7 @@ the result.
The result is a sequence of the same type as SEQUENCE."
(seq-concatenate
(let ((type (type-of sequence)))
(if (eq type 'cons) 'list type))
(if (listp sequence) 'list (type-of sequence))
(seq-subseq sequence 0 n)
(seq-subseq sequence (1+ n))))

2
lisp/emacs-lisp/shortdoc.el
View file

@ -1781,7 +1781,7 @@ With prefix numeric argument ARG, do it that many times."
(interactive)
(save-excursion
(goto-char (pos-bol))
(when-let* ((re (rx bol "(" (group (+ (not (in " "))))))
(when-let* ((re (rx bol "(" (group (+ (not (in " )"))))))
(string
(and (or (looking-at re)
(re-search-backward re nil t))

59
lisp/emacs-lisp/vtable.el
View file

@ -283,8 +283,16 @@ If it can't be found, return nil and don't move point."
(goto-char (prop-match-beginning match))
(end-of-line)))
(defun vtable-update-object (table object old-object)
"Replace OLD-OBJECT in TABLE with OBJECT."
(defun vtable-update-object (table object &optional old-object)
"Update OBJECT's representation in TABLE.
If OLD-OBJECT is non-nil, replace OLD-OBJECT with OBJECT and display it.
In either case, if the existing object is not found in the table (being
compared with `equal'), signal an error. Note a limitation: if TABLE's
buffer is not in a visible window, or if its window has changed width
since it was updated, updating the TABLE is not possible, and an error
is signaled."
(unless old-object
(setq old-object object))
(let* ((objects (vtable-objects table))
(inhibit-read-only t))
;; First replace the object in the object storage.
@ -300,26 +308,31 @@ If it can't be found, return nil and don't move point."
(error "Can't find the old object"))
(setcar (cdr objects) object))
;; Then update the cache...
(let* ((line-number (seq-position old-object (car (vtable--cache table))))
(line (elt (car (vtable--cache table)) line-number)))
(unless line
(error "Can't find cached object"))
(setcar line object)
(setcdr line (vtable--compute-cached-line table object))
;; ... and redisplay the line in question.
(save-excursion
(vtable-goto-object old-object)
(let ((keymap (get-text-property (point) 'keymap))
(start (point)))
(delete-line)
(vtable--insert-line table line line-number
(nth 1 (vtable--cache table))
(vtable--spacer table))
(add-text-properties start (point) (list 'keymap keymap
'vtable table))))
;; We may have inserted a non-numerical value into a previously
;; all-numerical table, so recompute.
(vtable--recompute-numerical table (cdr line)))))
;; FIXME: If the table's buffer has no visible window, or if its
;; width has changed since the table was updated, the cache key will
;; not match and the object can't be updated. (Bug #69837).
(if-let ((line-number (seq-position (car (vtable--cache table)) old-object
(lambda (a b)
(equal (car a) b))))
(line (elt (car (vtable--cache table)) line-number)))
(progn
(setcar line object)
(setcdr line (vtable--compute-cached-line table object))
;; ... and redisplay the line in question.
(save-excursion
(vtable-goto-object old-object)
(let ((keymap (get-text-property (point) 'keymap))
(start (point)))
(delete-line)
(vtable--insert-line table line line-number
(nth 1 (vtable--cache table))
(vtable--spacer table))
(add-text-properties start (point) (list 'keymap keymap
'vtable table))))
;; We may have inserted a non-numerical value into a previously
;; all-numerical table, so recompute.
(vtable--recompute-numerical table (cdr line)))
(error "Can't find cached object in vtable"))))
(defun vtable-remove-object (table object)
"Remove OBJECT from TABLE.
@ -741,7 +754,7 @@ If NEXT, do the next column."
(seq-do-indexed
(lambda (elem index)
(when (and (vtable-column--numerical (elt columns index))
(not (numberp elem)))
(not (numberp (car elem))))
(setq recompute t)))
line)
(when recompute

2
lisp/erc/erc-dcc.el
View file

@ -619,7 +619,7 @@ It lists the current state of `erc-dcc-list' in an easy to read manner."
(buffer-live-p (get-buffer (plist-get elt :file)))
(plist-member elt :size))
(let ((byte-count (with-current-buffer
(get-buffer (plist-get elt :file))
(plist-get elt :file)
(+ (buffer-size) 0.0
erc-dcc-byte-count))))
(format " (%d%%)"

24
lisp/erc/erc-desktop-notifications.el
View file

@ -54,6 +54,9 @@
(defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
(declare-function haiku-notifications-notify "haikuselect.c")
(declare-function android-notifications-notify "androidselect.c")
(defun erc-notifications-notify (nick msg &optional privp)
"Notify that NICK send some MSG, where PRIVP should be non-nil for PRIVMSGs.
This will replace the last notification sent with this function."
@ -64,14 +67,19 @@ This will replace the last notification sent with this function."
(let* ((channel (if privp (erc-get-buffer nick) (current-buffer)))
(title (format "%s in %s" (xml-escape-string nick t) channel))
(body (xml-escape-string (erc-controls-strip msg) t)))
(notifications-notify :bus erc-notifications-bus
:title title
:body body
:replaces-id erc-notifications-last-notification
:app-icon erc-notifications-icon
:actions '("default" "Switch to buffer")
:on-action (lambda (&rest _)
(pop-to-buffer channel)))))))
(funcall (cond ((featurep 'android)
#'android-notifications-notify)
((featurep 'haiku)
#'haiku-notifications-notify)
(t #'notifications-notify))
:bus erc-notifications-bus
:title title
:body body
:replaces-id erc-notifications-last-notification
:app-icon erc-notifications-icon
:actions '("default" "Switch to buffer")
:on-action (lambda (&rest _)
(pop-to-buffer channel)))))))
(defun erc-notifications-PRIVMSG (_proc parsed)
(let ((nick (car (erc-parse-user (erc-response.sender parsed))))

58
lisp/erc/erc-goodies.el
View file

@ -625,6 +625,48 @@ Do nothing if the variable `erc-command-indicator' is nil."
erc--msg-props))))
(erc--refresh-prompt))))
;;;###autoload
(defun erc-load-irc-script-lines (lines &optional force noexpand)
"Process a list of LINES as prompt input submissions.
If optional NOEXPAND is non-nil, do not expand script-specific
substitution sequences via `erc-process-script-line' and instead
process LINES as literal prompt input. With FORCE, bypass flood
protection."
;; The various erc-cmd-CMDs were designed to return non-nil when
;; their command line should be echoed. But at some point, these
;; handlers began displaying their own output, which naturally
;; appeared *above* the echoed command. This tries to intercept
;; these insertions, deferring them until the command has returned
;; and its command line has been printed.
(cl-assert (eq 'erc-mode major-mode))
(let ((args (and erc-script-args
(if (string-match "^ " erc-script-args)
(substring erc-script-args 1)
erc-script-args))))
(with-silent-modifications
(dolist (line lines)
(erc-log (concat "erc-load-script: CMD: " line))
(unless (string-match (rx bot (* (syntax whitespace)) eot) line)
(unless noexpand
(setq line (erc-process-script-line line args)))
(let ((erc--current-line-input-split (erc--make-input-split line))
calls insertp)
(add-function :around (local 'erc--send-message-nested-function)
(lambda (&rest args) (push args calls))
'((name . erc-script-lines-fn) (depth . -80)))
(add-function :around (local 'erc--send-action-function)
(lambda (&rest args) (push args calls))
'((name . erc-script-lines-fn) (depth . -80)))
(setq insertp
(unwind-protect (erc-process-input-line line force)
(remove-function (local 'erc--send-action-function)
'erc-script-lines-fn)
(remove-function (local 'erc--send-message-nested-function)
'erc-script-lines-fn)))
(when (and insertp erc-script-echo)
(erc--command-indicator-display line)
(dolist (call calls)
(apply (car call) (cdr call))))))))))
;;; IRC control character processing.
(defgroup erc-control-characters nil
@ -673,14 +715,6 @@ The value `erc-interpret-controls-p' must also be t for this to work."
"ERC underline face."
:group 'erc-faces)
(defface erc-control-default-fg '((t :inherit default))
"ERC foreground face for the \"default\" color code."
:group 'erc-faces)
(defface erc-control-default-bg '((t :inherit default))
"ERC background face for the \"default\" color code."
:group 'erc-faces)
;; FIXME rename these to something like `erc-control-color-N-fg',
;; and deprecate the old names via `define-obsolete-face-alias'.
(defface fg:erc-color-face0 '((t :foreground "White"))
@ -812,7 +846,7 @@ The value `erc-interpret-controls-p' must also be t for this to work."
(intern (concat "bg:erc-color-face" (number-to-string n))))
((< 15 n 99)
(list :background (aref erc--controls-additional-colors (- n 16))))
(t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-fg))))
(t (erc-log (format " Wrong color: %s" n)) nil))))
(defun erc-get-fg-color-face (n)
"Fetches the right face for foreground color N (0-15)."
@ -828,7 +862,7 @@ The value `erc-interpret-controls-p' must also be t for this to work."
(intern (concat "fg:erc-color-face" (number-to-string n))))
((< 15 n 99)
(list :foreground (aref erc--controls-additional-colors (- n 16))))
(t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-bg))))
(t (erc-log (format " Wrong color: %s" n)) nil))))
;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t)
(define-erc-module irccontrols nil
@ -883,7 +917,7 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
(setq s (replace-match "" nil nil s 1))
(cond ((and erc-interpret-mirc-color (or fg-color bg-color))
(setq fg fg-color)
(setq bg bg-color))
(when bg-color (setq bg bg-color)))
((string= control "\C-b")
(setq boldp (not boldp)))
((string= control "\C-]")
@ -944,7 +978,7 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'."
(replace-match "" nil nil nil 1)
(cond ((and erc-interpret-mirc-color (or fg-color bg-color))
(setq fg fg-color)
(setq bg bg-color))
(when bg-color (setq bg bg-color)))
((string= control "\C-b")
(setq boldp (not boldp)))
((string= control "\C-]")

1
lisp/erc/erc-stamp.el
View file

@ -623,6 +623,7 @@ printed just after each line's text (no alignment)."
((guard erc-stamp--display-margin-mode)
(let ((s (propertize (substring-no-properties string)
'invisible erc-stamp--invisible-property)))
(insert " ")
(put-text-property 0 (length string) 'display
`((margin right-margin) ,s)
string)))

58
lisp/erc/erc.el
View file

@ -4004,17 +4004,19 @@ erc-cmd-FOO, this returns a string /FOO."
command-name)))
(defun erc-process-input-line (line &optional force no-command)
"Translate LINE to an RFC1459 command and send it based.
Returns non-nil if the command is actually sent to the server, and nil
otherwise.
If the command in the LINE is not bound as a function `erc-cmd-<COMMAND>',
it is passed to `erc-cmd-default'. If LINE is not a command (i.e. doesn't
start with /<COMMAND>) then it is sent as a message.
An optional FORCE argument forces sending the line when flood
protection is in effect. The optional NO-COMMAND argument prohibits
this function from interpreting the line as a command."
"Dispatch a slash-command or chat-input handler from user-input LINE.
If simplistic validation fails, print an error and return nil.
Otherwise, defer to an appropriate handler. For \"slash\" commands,
like \"/JOIN\", expect a handler, like `erc-cmd-JOIN', to return non-nil
if LINE is fit for echoing as a command line when executing scripts.
For normal chat input, expect a handler to return non-nil if a message
was successfully processed as an outgoing \"PRIVMSG\". If LINE is a
slash command, and ERC can't find a corresponding handler of the form
`erc-cmd-<COMMAND>', pass LINE to `erc-cmd-default', treating it as a
catch-all handler. Otherwise, for normal chat input, pass LINE and the
boolean argument FORCE to `erc-send-input-line-function'. With a
non-nil NO-COMMAND, always treat LINE as normal chat input rather than a
slash command."
(let ((command-list (erc-extract-command-from-line line)))
(if (and command-list
(not no-command))
@ -8512,7 +8514,8 @@ and so on."
((string-match "^%[Ss]$" esc) server)
((string-match "^%[Nn]$" esc) nick)
((string-match "^%\\(.\\)$" esc) (match-string 1 esc))
(t (erc-log (format "BUG in erc-process-script-line: bad escape sequence: %S\n" esc))
(t (erc-log (format "Bad escape sequence in %s: %S\n"
'erc-process-script-line esc))
(message "BUG IN ERC: esc=%S" esc)
"")))
(setq line tail)
@ -8531,37 +8534,6 @@ and so on."
(buffer-string))))
(erc-load-irc-script-lines (erc-split-multiline-safe str) force)))
(defun erc-load-irc-script-lines (lines &optional force noexpand)
"Load IRC script LINES (a list of strings).
If optional NOEXPAND is non-nil, do not expand script-specific
sequences, process the lines verbatim. Use this for multiline
user input."
(let* ((cb (current-buffer))
(s "")
(sp (or (and (bound-and-true-p erc-command-indicator-mode)
(fboundp 'erc-command-indicator)
(erc-command-indicator))
(erc-prompt)))
(args (and (boundp 'erc-script-args) erc-script-args)))
(if (and args (string-match "^ " args))
(setq args (substring args 1)))
;; prepare the prompt string for echo
(erc-put-text-property 0 (length sp)
'font-lock-face 'erc-command-indicator-face sp)
(while lines
(setq s (car lines))
(erc-log (concat "erc-load-script: CMD: " s))
(unless (string-match "^\\s-*$" s)
(let ((line (if noexpand s (erc-process-script-line s args))))
(if (and (erc-process-input-line line force)
erc-script-echo)
(progn
(erc-put-text-property 0 (length line)
'font-lock-face 'erc-input-face line)
(erc-display-line (concat sp line) cb)))))
(setq lines (cdr lines)))))
;; authentication
(defun erc--unfun (maybe-fn)

2
lisp/eshell/em-unix.el
View file

@ -789,7 +789,7 @@ available..."
(ignore-errors
(occur (car args))))
(if (get-buffer "*Occur*")
(with-current-buffer (get-buffer "*Occur*")
(with-current-buffer "*Occur*"
(setq string (buffer-string))
(kill-buffer (current-buffer)))))
(if string (insert string))

3
lisp/ffap.el
View file

@ -1065,6 +1065,9 @@ If a given RFC isn't in these then `ffap-rfc-path' is offered."
;; (La)TeX: don't allow braces
(latex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
(tex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
;; XML: don't allow angle brackets
(xml-mode "--:\\\\${}+@-Z_[:alpha:]~*?#" "{<@" "@>;.,!:}")
(nxml-mode "--:\\\\${}+@-Z_[:alpha:]~*?#" "{<@" "@>;.,!:}")
)
"Alist of (MODE CHARS BEG END), where MODE is a symbol.
This is possibly a major-mode name, or one of the symbols

231
lisp/files.el
View file

@ -3425,7 +3425,7 @@ set the major mode only if that would change it. In other words
we don't actually set it to the same mode the buffer already has."
;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
(let ((try-locals (not (inhibit-local-variables-p)))
end done mode modes)
end modes)
;; Once we drop the deprecated feature where mode: is also allowed to
;; specify minor-modes (ie, there can be more than one "mode:"), we can
;; remove this section and just let (hack-local-variables t) handle it.
@ -3456,100 +3456,96 @@ we don't actually set it to the same mode the buffer already has."
(push (intern (concat (downcase (buffer-substring (point) end))
"-mode"))
modes))))
;; If we found modes to use, invoke them now, outside the save-excursion.
(if modes
(catch 'nop
(dolist (mode (nreverse modes))
(if (not (functionp mode))
(message "Ignoring unknown mode `%s'" mode)
(setq done t)
(or (set-auto-mode-0 mode keep-mode-if-same)
;; continuing would call minor modes again, toggling them off
(throw 'nop nil))))))
;; Check for auto-mode-alist entry in dir-locals.
(unless done
(with-demoted-errors "Directory-local variables error: %s"
;; Note this is a no-op if enable-local-variables is nil.
(let* ((mode-alist (cdr (hack-dir-local--get-variables
(lambda (key) (eq key 'auto-mode-alist))))))
(setq done (set-auto-mode--apply-alist mode-alist
keep-mode-if-same t)))))
(and (not done)
(setq mode (hack-local-variables t (not try-locals)))
(not (memq mode modes)) ; already tried and failed
(if (not (functionp mode))
(message "Ignoring unknown mode `%s'" mode)
(setq done t)
(set-auto-mode-0 mode keep-mode-if-same)))
;; If we didn't, look for an interpreter specified in the first line.
;; As a special case, allow for things like "#!/bin/env perl", which
;; finds the interpreter anywhere in $PATH.
(and (not done)
(setq mode (save-excursion
(goto-char (point-min))
(if (looking-at auto-mode-interpreter-regexp)
(match-string 2))))
;; Map interpreter name to a mode, signaling we're done at the
;; same time.
(setq done (assoc-default
(file-name-nondirectory mode)
(mapcar (lambda (e)
(cons
(format "\\`%s\\'" (car e))
(cdr e)))
interpreter-mode-alist)
#'string-match-p))
;; If we found an interpreter mode to use, invoke it now.
(set-auto-mode-0 done keep-mode-if-same))
;; Next try matching the buffer beginning against magic-mode-alist.
(unless done
(if (setq done (save-excursion
(goto-char (point-min))
(save-restriction
(narrow-to-region (point-min)
(min (point-max)
(+ (point-min) magic-mode-regexp-match-limit)))
(assoc-default
nil magic-mode-alist
(lambda (re _dummy)
(cond
((functionp re)
(funcall re))
((stringp re)
(let ((case-fold-search nil))
(looking-at re)))
(t
(error
"Problem in magic-mode-alist with element %s"
re))))))))
(set-auto-mode-0 done keep-mode-if-same)))
;; Next compare the filename against the entries in auto-mode-alist.
(unless done
(setq done (set-auto-mode--apply-alist auto-mode-alist
keep-mode-if-same nil)))
;; Next try matching the buffer beginning against magic-fallback-mode-alist.
(unless done
(if (setq done (save-excursion
(goto-char (point-min))
(save-restriction
(narrow-to-region (point-min)
(min (point-max)
(+ (point-min) magic-mode-regexp-match-limit)))
(assoc-default nil magic-fallback-mode-alist
(lambda (re _dummy)
(cond
((functionp re)
(funcall re))
((stringp re)
(let ((case-fold-search nil))
(looking-at re)))
(t
(error
"Problem with magic-fallback-mode-alist element: %s"
re))))))))
(set-auto-mode-0 done keep-mode-if-same)))
(unless done
(set-buffer-major-mode (current-buffer)))))
(or
;; If we found modes to use, invoke them now, outside the save-excursion.
;; Presume `modes' holds a major mode followed by minor modes.
(let ((done ()))
(dolist (mode (nreverse modes))
(if (eq done :keep)
;; `keep-mode-if-same' is set and the (major) mode
;; was already set. Refrain from calling the following
;; minor modes since they have already been set.
;; It was especially important in the past when calling
;; minor modes without an arg would toggle them, but it's
;; still preferable to avoid re-enabling them,
nil
(let ((res (set-auto-mode-0 mode keep-mode-if-same)))
(setq done (or res done)))))
done)
;; Check for auto-mode-alist entry in dir-locals.
(with-demoted-errors "Directory-local variables error: %s"
;; Note this is a no-op if enable-local-variables is nil.
(let* ((mode-alist (cdr (hack-dir-local--get-variables
(lambda (key) (eq key 'auto-mode-alist))))))
(set-auto-mode--apply-alist mode-alist keep-mode-if-same t)))
(let ((mode (hack-local-variables t (not try-locals))))
(unless (memq mode modes) ; already tried and failed
(set-auto-mode-0 mode keep-mode-if-same)))
;; If we didn't, look for an interpreter specified in the first line.
;; As a special case, allow for things like "#!/bin/env perl", which
;; finds the interpreter anywhere in $PATH.
(when-let
((interp (save-excursion
(goto-char (point-min))
(if (looking-at auto-mode-interpreter-regexp)
(match-string 2))))
;; Map interpreter name to a mode, signaling we're done at the
;; same time.
(mode (assoc-default
(file-name-nondirectory interp)
(mapcar (lambda (e)
(cons
(format "\\`%s\\'" (car e))
(cdr e)))
interpreter-mode-alist)
#'string-match-p)))
;; If we found an interpreter mode to use, invoke it now.
(set-auto-mode-0 mode keep-mode-if-same))
;; Next try matching the buffer beginning against magic-mode-alist.
(let ((mode (save-excursion
(goto-char (point-min))
(save-restriction
(narrow-to-region (point-min)
(min (point-max)
(+ (point-min) magic-mode-regexp-match-limit)))
(assoc-default
nil magic-mode-alist
(lambda (re _dummy)
(cond
((functionp re)
(funcall re))
((stringp re)
(let ((case-fold-search nil))
(looking-at re)))
(t
(error
"Problem in magic-mode-alist with element %s"
re)))))))))
(set-auto-mode-0 mode keep-mode-if-same))
;; Next compare the filename against the entries in auto-mode-alist.
(set-auto-mode--apply-alist auto-mode-alist
keep-mode-if-same nil)
;; Next try matching the buffer beginning against magic-fallback-mode-alist.
(let ((mode (save-excursion
(goto-char (point-min))
(save-restriction
(narrow-to-region (point-min)
(min (point-max)
(+ (point-min) magic-mode-regexp-match-limit)))
(assoc-default nil magic-fallback-mode-alist
(lambda (re _dummy)
(cond
((functionp re)
(funcall re))
((stringp re)
(let ((case-fold-search nil))
(looking-at re)))
(t
(error
"Problem with magic-fallback-mode-alist element: %s"
re)))))))))
(set-auto-mode-0 mode keep-mode-if-same))
(set-buffer-major-mode (current-buffer)))))
(defvar-local set-auto-mode--last nil
"Remember the mode we have set via `set-auto-mode-0'.")
@ -3583,18 +3579,29 @@ and it is meant to be modified by packages rather than users.")
"Apply MODE and return it.
If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of
any aliases and compared to current major mode. If they are the
same, do nothing and return nil."
(unless (and keep-mode-if-same
(or (eq (indirect-function mode)
(indirect-function major-mode))
(and set-auto-mode--last
(eq mode (car set-auto-mode--last))
(eq major-mode (cdr set-auto-mode--last)))))
(when mode
(funcall (major-mode-remap mode))
(unless (eq mode major-mode)
(setq set-auto-mode--last (cons mode major-mode)))
mode)))
same, do nothing and return `:keep'.
Return nil if MODE could not be applied."
(when mode
(if (and keep-mode-if-same
(or (eq (indirect-function mode)
(indirect-function major-mode))
(and set-auto-mode--last
(eq mode (car set-auto-mode--last))
(eq major-mode (cdr set-auto-mode--last)))))
:keep
(let ((modefun (major-mode-remap mode)))
(if (not (functionp modefun))
(progn
(message "Ignoring unknown mode `%s'%s" mode
(if (eq mode modefun) ""
(format " (remapped to `%S')" modefun)))
nil)
(funcall modefun)
(unless (or (eq mode major-mode) ;`set-auto-mode--last' is overkill.
;; `modefun' is something like a minor mode.
(local-variable-p 'set-auto-mode--last))
(setq set-auto-mode--last (cons mode major-mode)))
mode)))))
(defvar file-auto-mode-skip "^\\(#!\\|'\\\\\"\\)"
"Regexp of lines to skip when looking for file-local settings.
@ -4201,8 +4208,9 @@ major-mode."
(not (string-match
"-minor\\'"
(setq val2 (downcase (symbol-name val)))))
;; Allow several mode: elements.
(push (intern (concat val2 "-mode")) result))
(let ((mode (intern (concat val2 "-mode"))))
(when (fboundp (major-mode-remap mode))
(setq result mode))))
(cond ((eq var 'coding))
((eq var 'lexical-binding)
(unless hack-local-variables--warned-lexical
@ -4233,10 +4241,7 @@ major-mode."
val)
result))))))
(forward-line 1)))))))
(if (eq handle-mode t)
;; Return the final mode: setting that's defined.
(car (seq-filter #'fboundp result))
result)))
result))
(defun hack-local-variables-apply ()
"Apply the elements of `file-local-variables-alist'.

6
lisp/format-spec.el
View file

@ -38,7 +38,7 @@ For instance:
(?l . \"ls\")))
Each %-spec may contain optional flag, width, and precision
modifiers, as follows:
specifiers, as follows:
%<flags><width><precision>character
@ -51,7 +51,7 @@ The following flags are allowed:
* ^: Convert to upper case.
* _: Convert to lower case.
The width and truncation modifiers behave like the corresponding
The width and precision specifiers behave like the corresponding
ones in `format' when applied to %s.
For example, \"%<010b\" means \"substitute into the output the
@ -145,7 +145,7 @@ is returned, where each format spec is its own element."
"Return STR formatted according to FLAGS, WIDTH, and TRUNC.
FLAGS is a list of keywords as returned by
`format-spec--parse-flags'. WIDTH and TRUNC are either nil or
string widths corresponding to `format-spec' modifiers."
string widths corresponding to `format-spec' specifiers."
(let (diff str-width)
;; Truncate original string first, like `format' does.
(when trunc

2
lisp/gnus/gnus-group.el
View file

@ -4638,7 +4638,7 @@ and the second element is the address."
"Mark ARTICLE in GROUP with MARK, whether the group is displayed or not."
(let ((buffer (gnus-summary-buffer-name group)))
(if (gnus-buffer-live-p buffer)
(with-current-buffer (get-buffer buffer)
(with-current-buffer buffer
(gnus-summary-add-mark article mark))
(gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists))
(list article)))))

46
lisp/gnus/gnus-notifications.el
View file

@ -75,35 +75,55 @@ not get notifications."
(when group-article
(let ((group (cadr group-article))
(article (nth 2 group-article)))
(cond ((string= key "read")
(cond ((or (equal key "read")
(equal key "default"))
(gnus-fetch-group group (list article))
(select-frame-set-input-focus (selected-frame)))
((string= key "mark-read")
((equal key "mark-read")
(gnus-update-read-articles
group
(delq article (gnus-list-of-unread-articles group)))
;; gnus-group-refresh-group
(gnus-group-update-group group)))))))
(gnus-group-update-group group))))))
;; Notifications are removed unless otherwise specified once they (or
;; an action of theirs) are selected
(assoc-delete-all id gnus-notifications-id-to-msg))
(defun gnus-notifications-close (id _reason)
"Remove ID from the alist of notification identifiers to messages.
REASON is ignored."
(assoc-delete-all id gnus-notifications-id-to-msg))
(defun gnus-notifications-notify (from subject photo-file)
"Send a notification about a new mail.
Return a notification id if any, or t on success."
(if (fboundp 'notifications-notify)
(if (featurep 'android)
(gnus-funcall-no-warning
'notifications-notify
'android-notifications-notify
:title from
:body subject
:actions '("read" "Read" "mark-read" "Mark As Read")
:on-action 'gnus-notifications-action
:app-icon (gnus-funcall-no-warning
'image-search-load-path "gnus/gnus.png")
:image-path photo-file
:app-name "Gnus"
:category "email.arrived"
:on-close 'gnus-notifications-close
:group "Email arrivals"
:timeout gnus-notifications-timeout)
(message "New message from %s: %s" from subject)
;; Don't return an id
t))
(if (fboundp 'notifications-notify)
(gnus-funcall-no-warning
'notifications-notify
:title from
:body subject
:actions '("read" "Read" "mark-read" "Mark As Read")
:on-action 'gnus-notifications-action
:on-close 'gnus-notifications-close
:app-icon (gnus-funcall-no-warning
'image-search-load-path "gnus/gnus.png")
:image-path photo-file
:app-name "Gnus"
:category "email.arrived"
:timeout gnus-notifications-timeout)
(message "New message from %s: %s" from subject)
;; Don't return an id
t)))
(declare-function gravatar-retrieve-synchronously "gravatar.el"
(mail-address))

106
lisp/help-fns.el
View file

@ -1061,10 +1061,10 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
(concat
"an autoloaded " (if (commandp def)
"interactive "))
(if (commandp def) "an interactive " "a "))))
;; Print what kind of function-like object FUNCTION is.
(princ (cond ((or (stringp def) (vectorp def))
(if (commandp def) "an interactive " "a ")))
;; Print what kind of function-like object FUNCTION is.
(description
(cond ((or (stringp def) (vectorp def))
"a keyboard macro")
((and (symbolp function)
(get function 'reader-construct))
@ -1073,12 +1073,6 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
;; aliases before functions.
(aliased
(format-message "an alias for `%s'" real-def))
((subr-native-elisp-p def)
(concat beg "native-compiled Lisp function"))
((subrp def)
(concat beg (if (eq 'unevalled (cdr (subr-arity def)))
"special form"
"built-in function")))
((autoloadp def)
(format "an autoloaded %s"
(cond
@ -1092,12 +1086,13 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
;; need to check macros before functions.
(macrop function))
(concat beg "Lisp macro"))
((byte-code-function-p def)
(concat beg "byte-compiled Lisp function"))
((module-function-p def)
(concat beg "module function"))
((memq (car-safe def) '(lambda closure))
(concat beg "Lisp function"))
((atom def)
(let ((type (or (oclosure-type def) (cl-type-of def))))
(concat beg (format "%s"
(make-text-button
(symbol-name type) nil
'type 'help-type
'help-args (list type))))))
((keymapp def)
(let ((is-full nil)
(elts (cdr-safe def)))
@ -1107,7 +1102,9 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
elts nil))
(setq elts (cdr-safe elts)))
(concat beg (if is-full "keymap" "sparse keymap"))))
(t "")))
(t ""))))
(with-current-buffer standard-output
(insert description))
(if (and aliased (not (fboundp real-def)))
(princ ",\nwhich is not defined.")
@ -2448,6 +2445,81 @@ one of them returns non-nil."
(setq buffer-undo-list nil)
(texinfo-mode)))
(defconst help-fns--function-numbers
(make-hash-table :test 'equal :weakness 'value))
(defconst help-fns--function-names (make-hash-table :weakness 'key))
(defun help-fns--display-function (function)
(cond
((subr-primitive-p function)
(describe-function function))
((and (compiled-function-p function)
(not (and (fboundp 'kmacro-p) (kmacro-p function))))
(disassemble function))
(t
;; FIXME: Use cl-print!
(pp-display-expression function "*Help Source*" (consp function)))))
;;;###autoload
(defun help-fns-function-name (function)
"Return a short buttonized string representing FUNCTION.
The string is propertized with a button; clicking on that
provides further details about FUNCTION.
FUNCTION can be a function, a built-in, a keyboard macro,
or a compile function.
This function is intended to be used to display various
callable symbols in buffers in a way that allows the user
to find out more details about the symbols."
;; FIXME: For kmacros, should we print the key-sequence?
(cond
((symbolp function)
(let ((name (if (eq (intern-soft (symbol-name function)) function)
(symbol-name function)
(concat "#:" (symbol-name function)))))
(if (not (fboundp function))
name
(make-text-button name nil
'type 'help-function
'help-args (list function)))))
((gethash function help-fns--function-names))
((subrp function)
(let ((name (subr-name function)))
;; FIXME: For native-elisp-functions, should we use `help-function'
;; or `disassemble'?
(format "#<%s %s>"
(cl-type-of function)
(make-text-button name nil
'type 'help-function
;; Let's hope the subr hasn't been redefined!
'help-args (list (intern name))))))
(t
(let ((type (or (oclosure-type function)
(if (consp function)
(car function) (cl-type-of function))))
(hash (sxhash-eq function))
;; Use 3 digits minimum.
(mask #xfff)
name)
(while
(let* ((hex (format (concat "%0"
(number-to-string (1+ (/ (logb mask) 4)))
"X")
(logand mask hash)))
;; FIXME: For kmacros, we don't want to `disassemble'!
(button (buttonize
hex #'help-fns--display-function function
;; FIXME: Shouldn't `buttonize' add
;; the "mouse-2, RET:" prefix?
"mouse-2, RET: Display the function's body")))
(setq name (format "#<%s %s>" type button))
(and (< mask (abs hash)) ; We can add more digits.
(gethash name help-fns--function-numbers)))
;; Add a digit.
(setq mask (+ (ash mask 4) #x0f)))
(puthash name function help-fns--function-numbers)
(puthash function name help-fns--function-names)
name))))
(provide 'help-fns)
;;; help-fns.el ends here

273
lisp/help-macro.el
View file

@ -92,141 +92,146 @@ and then returns."
`(defun ,fname ()
"Help command."
(interactive)
(let ((line-prompt
(substitute-command-keys ,help-line))
(help-buffer-under-preparation t))
(when three-step-help
(message "%s" line-prompt))
(let* ((help-screen ,help-text)
;; We bind overriding-local-map for very small
;; sections, *excluding* where we switch buffers
;; and where we execute the chosen help command.
(local-map (make-sparse-keymap))
(new-minor-mode-map-alist minor-mode-map-alist)
(prev-frame (selected-frame))
config new-frame key char)
(when (string-match "%THIS-KEY%" help-screen)
(setq help-screen
(replace-match (help--key-description-fontified
(substring (this-command-keys) 0 -1))
t t help-screen)))
(unwind-protect
(let ((minor-mode-map-alist nil))
(setcdr local-map ,helped-map)
(define-key local-map [t] 'undefined)
;; Make the scroll bar keep working normally.
(define-key local-map [vertical-scroll-bar]
(lookup-key global-map [vertical-scroll-bar]))
(if three-step-help
(progn
(setq key (let ((overriding-local-map local-map))
(read-key-sequence nil)))
;; Make the HELP key translate to C-h.
(if (lookup-key function-key-map key)
(setq key (lookup-key function-key-map key)))
(setq char (aref key 0)))
(setq char ??))
(when (or (eq char ??) (eq char help-char)
(memq char help-event-list))
(setq config (current-window-configuration))
(pop-to-buffer (or ,buffer-name " *Metahelp*") nil t)
(and (fboundp 'make-frame)
(not (eq (window-frame)
prev-frame))
(setq new-frame (window-frame)
config nil))
(setq buffer-read-only nil)
(let ((inhibit-read-only t))
(erase-buffer)
(insert (substitute-command-keys help-screen)))
(let ((minor-mode-map-alist new-minor-mode-map-alist))
(help-mode)
(variable-pitch-mode)
(setq new-minor-mode-map-alist minor-mode-map-alist))
(goto-char (point-min))
(while (or (memq char (append help-event-list
(cons help-char '( ?? ?\C-v ?\s ?\177 ?\M-v ?\S-\s
deletechar backspace vertical-scroll-bar
home end next prior up down))))
(eq (car-safe char) 'switch-frame)
(equal key "\M-v"))
(condition-case nil
(cond
((eq (car-safe char) 'switch-frame)
(handle-switch-frame char))
((memq char '(?\C-v ?\s next end))
(scroll-up))
((or (memq char '(?\177 ?\M-v ?\S-\s deletechar backspace prior home))
(equal key "\M-v"))
(scroll-down))
((memq char '(down))
(scroll-up 1))
((memq char '(up))
(scroll-down 1)))
(error nil))
(let ((cursor-in-echo-area t)
(overriding-local-map local-map))
(frame-toggle-on-screen-keyboard (selected-frame) nil)
(setq key (read-key-sequence
(format "Type one of listed options%s: "
(if (pos-visible-in-window-p
(point-max))
""
(concat ", or "
(help--key-description-fontified (kbd "<PageDown>"))
"/"
(help--key-description-fontified (kbd "<PageUp>"))
"/"
(help--key-description-fontified (kbd "SPC"))
"/"
(help--key-description-fontified (kbd "DEL"))
" to scroll")))
nil nil nil nil
;; Disable ``text conversion''. OS
;; input methods might otherwise chose
;; to insert user input directly into
;; a buffer.
t)
char (aref key 0)))
(help--help-screen ,help-line ,help-text ,helped-map ,buffer-name)))
;; If this is a scroll bar command, just run it.
(when (eq char 'vertical-scroll-bar)
(command-execute (lookup-key local-map key) nil key))))
;; We don't need the prompt any more.
(message "")
;; Mouse clicks are not part of the help feature,
;; so reexecute them in the standard environment.
(if (listp char)
(setq unread-command-events
(cons char unread-command-events)
config nil)
(let ((defn (lookup-key local-map key)))
(if defn
(progn
(when config
(set-window-configuration config)
(setq config nil))
;; Temporarily rebind `minor-mode-map-alist'
;; to `new-minor-mode-map-alist' (Bug#10454).
(let ((minor-mode-map-alist new-minor-mode-map-alist))
;; `defn' must make sure that its frame is
;; selected, so we won't iconify it below.
(call-interactively defn))
(when new-frame
;; Do not iconify the selected frame.
(unless (eq new-frame (selected-frame))
(iconify-frame new-frame))
(setq new-frame nil)))
(unless (equal (key-description key) "C-g")
(message (substitute-command-keys
(format "No help command is bound to `\\`%s''"
(key-description key))))
(ding))))))
(when config
(set-window-configuration config))
(when new-frame
(iconify-frame new-frame))
(setq minor-mode-map-alist new-minor-mode-map-alist))))))
;;;###autoload
(defun help--help-screen (help-line help-text helped-map buffer-name)
(let ((line-prompt
(substitute-command-keys help-line))
(help-buffer-under-preparation t))
(when three-step-help
(message "%s" line-prompt))
(let* ((help-screen help-text)
;; We bind overriding-local-map for very small
;; sections, *excluding* where we switch buffers
;; and where we execute the chosen help command.
(local-map (make-sparse-keymap))
(new-minor-mode-map-alist minor-mode-map-alist)
(prev-frame (selected-frame))
config new-frame key char)
(when (string-match "%THIS-KEY%" help-screen)
(setq help-screen
(replace-match (help--key-description-fontified
(substring (this-command-keys) 0 -1))
t t help-screen)))
(unwind-protect
(let ((minor-mode-map-alist nil))
(setcdr local-map helped-map)
(define-key local-map [t] #'undefined)
;; Make the scroll bar keep working normally.
(define-key local-map [vertical-scroll-bar]
(lookup-key global-map [vertical-scroll-bar]))
(if three-step-help
(progn
(setq key (let ((overriding-local-map local-map))
(read-key-sequence nil)))
;; Make the HELP key translate to C-h.
(if (lookup-key function-key-map key)
(setq key (lookup-key function-key-map key)))
(setq char (aref key 0)))
(setq char ??))
(when (or (eq char ??) (eq char help-char)
(memq char help-event-list))
(setq config (current-window-configuration))
(pop-to-buffer (or buffer-name " *Metahelp*") nil t)
(and (fboundp 'make-frame)
(not (eq (window-frame)
prev-frame))
(setq new-frame (window-frame)
config nil))
(setq buffer-read-only nil)
(let ((inhibit-read-only t))
(erase-buffer)
(insert (substitute-command-keys help-screen)))
(let ((minor-mode-map-alist new-minor-mode-map-alist))
(help-mode)
(variable-pitch-mode)
(setq new-minor-mode-map-alist minor-mode-map-alist))
(goto-char (point-min))
(while (or (memq char (append help-event-list
(cons help-char '( ?? ?\C-v ?\s ?\177 ?\M-v ?\S-\s
deletechar backspace vertical-scroll-bar
home end next prior up down))))
(eq (car-safe char) 'switch-frame)
(equal key "\M-v"))
(condition-case nil
(cond
((eq (car-safe char) 'switch-frame)
(handle-switch-frame char))
((memq char '(?\C-v ?\s next end))
(scroll-up))
((or (memq char '(?\177 ?\M-v ?\S-\s deletechar backspace prior home))
(equal key "\M-v"))
(scroll-down))
((memq char '(down))
(scroll-up 1))
((memq char '(up))
(scroll-down 1)))
(error nil))
(let ((cursor-in-echo-area t)
(overriding-local-map local-map))
(frame-toggle-on-screen-keyboard (selected-frame) nil)
(setq key (read-key-sequence
(format "Type one of listed options%s: "
(if (pos-visible-in-window-p
(point-max))
""
(concat ", or "
(help--key-description-fontified (kbd "<PageDown>"))
"/"
(help--key-description-fontified (kbd "<PageUp>"))
"/"
(help--key-description-fontified (kbd "SPC"))
"/"
(help--key-description-fontified (kbd "DEL"))
" to scroll")))
nil nil nil nil
;; Disable ``text conversion''. OS
;; input methods might otherwise chose
;; to insert user input directly into
;; a buffer.
t)
char (aref key 0)))
;; If this is a scroll bar command, just run it.
(when (eq char 'vertical-scroll-bar)
(command-execute (lookup-key local-map key) nil key))))
;; We don't need the prompt any more.
(message "")
;; Mouse clicks are not part of the help feature,
;; so reexecute them in the standard environment.
(if (listp char)
(setq unread-command-events
(cons char unread-command-events)
config nil)
(let ((defn (lookup-key local-map key)))
(if defn
(progn
(when config
(set-window-configuration config)
(setq config nil))
;; Temporarily rebind `minor-mode-map-alist'
;; to `new-minor-mode-map-alist' (Bug#10454).
(let ((minor-mode-map-alist new-minor-mode-map-alist))
;; `defn' must make sure that its frame is
;; selected, so we won't iconify it below.
(call-interactively defn))
(when new-frame
;; Do not iconify the selected frame.
(unless (eq new-frame (selected-frame))
(iconify-frame new-frame))
(setq new-frame nil)))
(unless (equal (key-description key) "C-g")
(message (substitute-command-keys
(format "No help command is bound to `\\`%s''"
(key-description key))))
(ding))))))
(when config
(set-window-configuration config))
(when new-frame
(iconify-frame new-frame))
(setq minor-mode-map-alist new-minor-mode-map-alist)))))
(provide 'help-macro)

8
lisp/help-mode.el
View file

@ -177,6 +177,11 @@ The format is (FUNCTION ARGS...).")
'help-function 'describe-variable
'help-echo (purecopy "mouse-2, RET: describe this variable"))
(define-button-type 'help-type
:supertype 'help-xref
'help-function #'cl-describe-type
'help-echo (purecopy "mouse-2, RET: describe this type"))
(define-button-type 'help-face
:supertype 'help-xref
'help-function 'describe-face
@ -545,6 +550,9 @@ it does not already exist."
(or (and (boundp symbol) (not (keywordp symbol)))
(get symbol 'variable-documentation)))
,#'describe-variable)
;; FIXME: We could go crazy and add another entry so describe-symbol can be
;; used with the slot names of CL structs (and/or EIEIO objects).
("type" ,#'cl-find-class ,#'cl-describe-type)
("face" ,#'facep ,(lambda (s _b _f) (describe-face s))))
"List of providers of information about symbols.
Each element has the form (NAME TESTFUN DESCFUN) where:

Some files were not shown because too many files have changed in this diff Show more