[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 46e7613 2/3: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 46e7613 2/3: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Thu, 13 Aug 2020 06:49:38 -0400 (EDT) |
branch: feature/native-comp
commit 46e7613ad3b88807d25cfab3d78bf46c9e2fe13e
Merge: f6502f9 e9eafd2
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into HEAD
---
Makefile.in | 7 +
configure.ac | 34 +-
doc/emacs/calendar.texi | 5 +-
doc/emacs/dired.texi | 8 +
doc/emacs/misc.texi | 18 +-
doc/lispref/positions.texi | 5 +-
doc/lispref/tips.texi | 65 +++-
doc/misc/tramp.texi | 23 +-
etc/NEWS | 106 ++++-
etc/emacs.service | 2 +-
etc/emacsclient.desktop | 12 +
lib-src/emacsclient.c | 16 +-
lib/alloca.in.h | 2 +-
lib/arg-nonnull.h | 2 +-
lib/binary-io.h | 2 +-
lib/c++defs.h | 2 +-
lib/cdefs.h | 103 +++--
lib/count-one-bits.h | 3 +-
lib/dirent.in.h | 2 +-
lib/fcntl.c | 4 +-
lib/ignore-value.h | 5 +-
lib/intprops.h | 3 +-
lib/malloca.h | 2 +-
lib/regex.h | 17 +-
lib/regex_internal.h | 6 +-
lib/stdalign.in.h | 19 +-
lib/stddef.in.h | 2 +-
lib/stdint.in.h | 5 +-
lib/stdio.in.h | 2 +-
lib/stdlib.in.h | 2 +-
lib/string.in.h | 14 +-
lib/verify.h | 11 +-
lib/warn-on-use.h | 31 +-
lisp/allout-widgets.el | 19 +-
lisp/allout.el | 46 +--
lisp/apropos.el | 14 +
lisp/bookmark.el | 78 +++-
lisp/calc/calc-yank.el | 56 ++-
lisp/calc/calc.el | 50 ++-
lisp/calendar/cal-dst.el | 6 +-
lisp/calendar/calendar.el | 10 +-
lisp/calendar/solar.el | 6 +-
lisp/cedet/semantic/fw.el | 10 +-
lisp/cedet/semantic/grammar.el | 1 +
lisp/comint.el | 22 +-
lisp/dired-aux.el | 43 ++-
lisp/dired.el | 6 +
lisp/emacs-lisp/autoload.el | 7 +-
lisp/emacs-lisp/checkdoc.el | 13 +-
lisp/emacs-lisp/eldoc.el | 8 +-
lisp/emacs-lisp/lisp.el | 3 +-
lisp/emulation/viper-cmd.el | 33 +-
lisp/emulation/viper.el | 35 +-
lisp/epa-dired.el | 1 +
lisp/epa-file.el | 10 +
lisp/epa-hook.el | 1 +
lisp/epa-mail.el | 10 +
lisp/epa.el | 37 +-
lisp/epg-config.el | 7 +
lisp/epg.el | 80 ++--
lisp/erc/erc-goodies.el | 27 +-
lisp/erc/erc-join.el | 22 +-
lisp/erc/erc.el | 85 ++--
lisp/eshell/esh-proc.el | 2 +-
lisp/files.el | 14 +-
lisp/font-lock.el | 30 +-
lisp/gnus/gnus-util.el | 4 +-
lisp/gnus/gnus.el | 3 +-
lisp/gnus/mm-util.el | 77 +---
lisp/help-fns.el | 1 +
lisp/language/burmese.el | 1 -
lisp/language/cyril-util.el | 2 +-
lisp/language/hanja-util.el | 4 +-
lisp/language/indian.el | 2 +-
lisp/leim/quail/latin-ltx.el | 7 +-
lisp/mail/smtpmail.el | 10 +-
lisp/man.el | 5 +-
lisp/net/dns.el | 5 +-
lisp/net/eudc-bob.el | 10 +-
lisp/net/eudcb-macos-contacts.el | 16 +-
lisp/net/imap.el | 32 +-
lisp/net/mailcap.el | 5 -
lisp/net/tramp-adb.el | 3 +-
lisp/net/tramp-sh.el | 3 +-
lisp/net/tramp.el | 40 +-
lisp/obsolete/longlines.el | 17 +-
lisp/play/bubbles.el | 10 +-
lisp/progmodes/compile.el | 2 -
lisp/progmodes/idlw-shell.el | 4 +-
lisp/progmodes/idlwave.el | 21 +-
lisp/progmodes/prolog.el | 18 -
lisp/progmodes/sql.el | 34 +-
lisp/ps-def.el | 2 +-
lisp/ps-print.el | 4 +-
lisp/server.el | 9 +-
lisp/shell.el | 7 +-
lisp/simple.el | 147 +++++--
lisp/term/st.el | 20 +
lisp/textmodes/paragraphs.el | 63 +--
lisp/textmodes/tex-mode.el | 2 +-
lisp/textmodes/texinfo.el | 71 ++++
lisp/url/url-handlers.el | 3 +-
lisp/vc/ediff-init.el | 15 -
lisp/vc/vc-git.el | 2 +-
lisp/vc/vc-src.el | 67 ++--
lisp/vt100-led.el | 2 +-
lisp/whitespace.el | 2 +-
lisp/xwidget.el | 275 +++++++++----
m4/gnulib-common.m4 | 8 +-
m4/stddef_h.m4 | 4 +-
m4/stdint.m4 | 4 +-
nextstep/templates/Info.plist.in | 12 +-
src/Makefile.in | 1 +
src/bytecode.c | 1 -
src/composite.c | 1 -
src/emacs.c | 3 +-
src/fns.c | 67 +---
src/json.c | 4 +-
src/lisp.h | 24 +-
src/macfont.m | 88 ++++-
src/minibuf.c | 3 -
src/nsterm.m | 21 +-
src/nsxwidget.h | 80 ++++
src/nsxwidget.m | 601 +++++++++++++++++++++++++++++
src/pdumper.c | 320 +++++++--------
src/pdumper.h | 1 +
src/timefns.c | 2 +-
src/xfaces.c | 20 +-
src/xwidget.c | 253 +++++++++++-
src/xwidget.h | 48 ++-
test/lisp/bookmark-resources/test-list.bmk | 20 +
test/lisp/bookmark-tests.el | 215 +++++++++++
test/lisp/emacs-lisp/lisp-tests.el | 55 +++
test/lisp/files-tests.el | 5 +-
test/lisp/gnus/mml-sec-tests.el | 3 +
test/lisp/help-fns-tests.el | 11 +
test/src/emacs-module-tests.el | 21 +-
137 files changed, 3075 insertions(+), 1180 deletions(-)
diff --git a/Makefile.in b/Makefile.in
index 2f6a68f..f28623e 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -715,6 +715,13 @@ install-etc:
${srcdir}/etc/emacs.desktop > $${tmp}; \
${INSTALL_DATA} $${tmp}
"$(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop"; \
rm -f $${tmp}
+ tmp=etc/emacsclient.tmpdesktop; rm -f $${tmp}; \
+ client_name=`echo emacsclient | sed '$(TRANSFORM)'`${EXEEXT}; \
+ sed -e "/^Exec=emacsclient/ s|emacsclient|${bindir}/$${client_name}|" \
+ -e "/^Icon=emacs/ s/emacs/${EMACS_NAME}/" \
+ ${srcdir}/etc/emacsclient.desktop > $${tmp}; \
+ ${INSTALL_DATA} $${tmp}
"$(DESTDIR)${desktopdir}/$${client_name}.desktop"; \
+ rm -f $${tmp}
umask 022; ${MKDIR_P} "$(DESTDIR)${appdatadir}"
tmp=etc/emacs.tmpappdata; rm -f $${tmp}; \
sed -e "s/emacs\.desktop/${EMACS_NAME}.desktop/" \
diff --git a/configure.ac b/configure.ac
index 76a3e6b..4b8497b 100644
--- a/configure.ac
+++ b/configure.ac
@@ -490,7 +490,7 @@ otherwise for the first of 'inotify', 'kqueue' or 'gfile'
that is usable.])
[with_file_notification=$with_features])
OPTION_DEFAULT_OFF([xwidgets],
- [enable use of some gtk widgets in Emacs buffers (requires gtk3)])
+ [enable use of xwidgets in Emacs buffers (requires gtk3 or macOS Cocoa)])
## For the times when you want to build Emacs but don't have
## a suitable makeinfo, and can live without the manuals.
@@ -2755,20 +2755,34 @@ fi
dnl Enable xwidgets if GTK3 and WebKitGTK+ are available.
+dnl Enable xwidgets if macOS Cocoa and WebKit framework are available.
HAVE_XWIDGETS=no
XWIDGETS_OBJ=
if test "$with_xwidgets" != "no"; then
- test "$USE_GTK_TOOLKIT" = "GTK3" && test "$window_system" != "none" ||
- AC_MSG_ERROR([xwidgets requested but gtk3 not used.])
+ if test "$USE_GTK_TOOLKIT" = "GTK3" && test "$window_system" != "none"; then
+ WEBKIT_REQUIRED=2.12
+ WEBKIT_MODULES="webkit2gtk-4.0 >= $WEBKIT_REQUIRED"
+ EMACS_CHECK_MODULES([WEBKIT], [$WEBKIT_MODULES])
+ HAVE_XWIDGETS=$HAVE_WEBKIT
+ XWIDGETS_OBJ="xwidget.o"
+ elif test "${NS_IMPL_COCOA}" = "yes"; then
+ dnl FIXME: Check framework WebKit2
+ dnl WEBKIT_REQUIRED=M.m.p
+ WEBKIT_LIBS="-Wl,-framework -Wl,WebKit"
+ WEBKIT_CFLAGS="-I/System/Library/Frameworks/WebKit.framework/Headers"
+ HAVE_WEBKIT="yes"
+ HAVE_XWIDGETS=$HAVE_WEBKIT
+ XWIDGETS_OBJ="xwidget.o"
+ NS_OBJC_OBJ="$NS_OBJC_OBJ nsxwidget.o"
+ dnl Update NS_OBJC_OBJ with added nsxwidget.o
+ AC_SUBST(NS_OBJC_OBJ)
+ else
+ AC_MSG_ERROR([xwidgets requested, it requires GTK3 as X window toolkit or
macOS Cocoa as window system.])
+ fi
- WEBKIT_REQUIRED=2.12
- WEBKIT_MODULES="webkit2gtk-4.0 >= $WEBKIT_REQUIRED"
- EMACS_CHECK_MODULES([WEBKIT], [$WEBKIT_MODULES])
- HAVE_XWIDGETS=$HAVE_WEBKIT
test $HAVE_XWIDGETS = yes ||
- AC_MSG_ERROR([xwidgets requested but WebKitGTK+ not found.])
+ AC_MSG_ERROR([xwidgets requested but WebKitGTK+ or WebKit framework not
found.])
- XWIDGETS_OBJ=xwidget.o
AC_DEFINE([HAVE_XWIDGETS], 1, [Define to 1 if you have xwidgets support.])
fi
AC_SUBST(XWIDGETS_OBJ)
@@ -5776,7 +5790,7 @@ AS_ECHO([" Does Emacs use -lXaw3d?
${HAVE_XAW3D
Does Emacs directly use zlib? ${HAVE_ZLIB}
Does Emacs have dynamic modules support? ${HAVE_MODULES}
Does Emacs use toolkit scroll bars?
${USE_TOOLKIT_SCROLL_BARS}
- Does Emacs support Xwidgets (requires gtk3)? ${HAVE_XWIDGETS}
+ Does Emacs support Xwidgets? ${HAVE_XWIDGETS}
Does Emacs have threading support in lisp? ${threads_enabled}
Does Emacs support the portable dumper? ${with_pdumper}
Does Emacs support legacy unexec dumping? ${with_unexec}
diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi
index 31db815..e5ee7e9 100644
--- a/doc/emacs/calendar.texi
+++ b/doc/emacs/calendar.texi
@@ -625,10 +625,9 @@ your time zone. Emacs displays the times of sunrise and
sunset
@emph{corrected for daylight saving time}. @xref{Daylight Saving},
for how daylight saving time is determined.
-@vindex calendar-use-numeric-time-zones
+@vindex calendar-time-zone-style
If you want to display numerical time zones (like @samp{"+0100"})
-instead of symbolic time zones (like @samp{"CET"}), set the
-@code{calendar-use-numeric-time-zones} variable to non-@code{nil}.
+instead of symbolic ones (like @samp{"CET"}), set this to @code{numeric}.
As a user, you might find it convenient to set the calendar location
variables for your usual physical location in your @file{.emacs} file.
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 4ff1dc1..de449e3 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -694,6 +694,14 @@ The variable @code{dired-recursive-copies} controls
whether to copy
directories recursively (like @samp{cp -r}). The default is
@code{top}, which means to ask before recursively copying a directory.
+@vindex dired-copy-dereference
+@cindex follow symbolic links
+@cindex dereference symbolic links
+The variable @code{dired-copy-dereference} controls whether to copy
+symbolic links as links or after dereferencing (like @samp{cp -L}).
+The default is @code{nil}, which means that the symbolic links are
+copied by creating new ones.
+
@item D
@findex dired-do-delete
@kindex D @r{(Dired)}
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index cb9fc61..f3c9d76 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -729,10 +729,9 @@ See the Eshell Info manual, which is distributed with
Emacs.
minibuffer and executes it as a shell command, in a subshell made just
for that command. Standard input for the command comes from the null
device. If the shell command produces any output, the output appears
-either in the echo area (if it is short), or in an Emacs buffer,
-displayed in another window (if the output is long). The name of
-this buffer is taken from the constant @code{shell-command-buffer-name}.
-The variables @code{resize-mini-windows} and
+either in the echo area (if it is short), or in the @samp{"*Shell
+Command Output*"} (@code{shell-command-buffer-name}) buffer (if the
+output is long). The variables @code{resize-mini-windows} and
@code{max-mini-window-height} (@pxref{Minibuffer Edit}) control when
Emacs should consider the output to be too long for the echo area.
@@ -766,10 +765,11 @@ which is impossible to ignore.
You can also type @kbd{M-&} (@code{async-shell-command}) to execute a
shell command asynchronously; this is exactly like calling @kbd{M-!}
with a trailing @samp{&}, except that you do not need the @samp{&}.
-The constant @code{shell-command-buffer-name-async} stores the name
-of the default output buffer for asynchronous shell commands.
-Emacs inserts the output into this buffer as it comes in,
-whether or not the buffer is visible in a window.
+The output from asynchronous shell commands, by default, goes into the
+@samp{"*Async Shell Command*"} buffer
+(@code{shell-command-buffer-name-async}). Emacs inserts the output
+into this buffer as it comes in, whether or not the buffer is visible
+in a window.
@vindex async-shell-command-buffer
If you want to run more than one asynchronous shell command at the
@@ -807,7 +807,7 @@ old region and replaces it with the output from the shell
command.
see what keys are in the buffer. If the buffer contains a GnuPG key,
type @kbd{C-x h M-| gpg @key{RET}} to feed the entire buffer contents
to @command{gpg}. This will output the list of keys to the
-buffer named @code{shell-command-buffer-name}.
+buffer whose name is the value of @code{shell-command-buffer-name}.
@vindex shell-file-name
The above commands use the shell specified by the variable
diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index d7856ce..9141970 100644
--- a/doc/lispref/positions.texi
+++ b/doc/lispref/positions.texi
@@ -411,7 +411,7 @@ function counts that line as one line successfully moved.
In an interactive call, @var{count} is the numeric prefix argument.
@end deffn
-@defun count-lines start end
+@defun count-lines start end &optional ignore-invisible-lines
@cindex lines in region
@anchor{Definition of count-lines}
This function returns the number of lines between the positions
@@ -420,6 +420,9 @@ This function returns the number of lines between the
positions
1, even if @var{start} and @var{end} are on the same line. This is
because the text between them, considered in isolation, must contain at
least one line unless it is empty.
+
+If the optional @var{ignore-invisible-lines} is non-@code{nil},
+invisible lines will not be included in the count.
@end defun
@deffn Command count-words start end
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index 5b09b2c..6292054 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -918,29 +918,56 @@ values. It is much better to convert such comments to
documentation
strings, though.
@item ;;;
-Comments that start with three semicolons, @samp{;;;}, should start at
-the left margin. We use them
-for comments which should be considered a
-heading by Outline minor mode. By default, comments starting with
-at least three semicolons (followed by a single space and a
-non-whitespace character) are considered headings, comments starting
-with two or fewer are not. Historically, triple-semicolon comments have
-also been used for commenting out lines within a function, but this use
-is discouraged.
-
-When commenting out entire functions, use two semicolons.
-
-@item ;;;;
-Comments that start with four (or more) semicolons, @samp{;;;;},
-should be aligned to the left margin and are used for headings of
-major sections of a program. For example:
+
+Comments that start with three (or more) semicolons, @samp{;;;},
+should start at the left margin. We use them for comments that should
+be considered a heading by Outline minor mode. By default, comments
+starting with at least three semicolons (followed by a single space
+and a non-whitespace character) are considered section headings,
+comments starting with two or fewer are not.
+
+(Historically, triple-semicolon comments have also been used for
+commenting out lines within a function, but this use is discouraged in
+favor of using just two semicolons. This also applies when commenting
+out entire functions; when doing that use two semicolons as well.)
+
+Three semicolons are used for top-level sections, four for
+sub-sections, five for sub-sub-sections and so on.
+
+Typically libraries have at least four top-level sections. For
+example when the bodies of all of these sections are hidden:
@smallexample
-;;;; The kill ring
+@group
+;;; backquote.el --- implement the ` Lisp construct...
+;;; Commentary:...
+;;; Code:...
+;;; backquote.el ends here
+@end group
@end smallexample
-If you wish to have sub-headings under these heading, use more
-semicolons to nest these sub-headings.
+(In a sense the last line is not a section heading as it must
+never be followed by any text; after all it marks the end of the
+file.)
+
+For longer libraries it is advisable to split the code into multiple
+sections. This can be done by splitting the @samp{Code:} section into
+multiple sub-sections. Even though that was the only recommended
+approach for a long time, many people have chosen to use multiple
+top-level code sections instead. You may chose either style.
+
+Using multiple top-level code sections has the advanatage that it
+avoids introducing an additional nesting level but it also means that
+the section named @samp{Code} does not contain all the code, which is
+awkward. To avoid that, you should put no code at all inside that
+section; that way it can be considered a seperator instead of a
+section heading.
+
+Finally, we recommend that you don't end headings with a colon or any
+other punctuation for that matter. For historic reasons the
+@samp{Code:} and @samp{Commentary:} headings end with a colon, but we
+recommend that you don't do the same for other headings anyway.
+
@end table
@noindent
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index ae6fe3d..c1a66d0 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3378,8 +3378,8 @@ host. Example:
@end group
@end example
-@command{tail} command outputs continuously to the local buffer,
-named @code{shell-command-buffer-name-async}
+@command{tail} command outputs continuously to the local buffer whose
+name is the value of the variable @code{shell-command-buffer-name-async}.
@kbd{M-x auto-revert-tail-mode @key{RET}} runs similarly showing
continuous output.
@@ -3561,7 +3561,13 @@ which must be set to a non-@code{nil} value. Example:
@end group
@end lisp
-However, this approach has different limitations:
+Using direct asynchronous processes in @value{tramp} is not possible,
+if the remote host is connected via multiple hops
+(@pxref{Multi-hops}), or the @code{make-process} /
+@code{start-file-process} call uses a stderr stream. In this case,
+@value{tramp} falls back to its classical implementation.
+
+Furthermore, this approach has the following limitations:
@itemize
@item
@@ -3569,16 +3575,10 @@ It works only for connection methods defined in
@file{tramp-sh.el} and
@file{tramp-adb.el}.
@item
-It does not support multi-hop methods.
-
-@item
It does not support interactive user authentication, like password
handling.
@item
-It does not support a separated error stream.
-
-@item
It cannot be killed via @code{interrupt-process}.
@item
@@ -3594,7 +3594,10 @@ It does not set environment variable @env{INSIDE_EMACS}.
In order to gain even more performance, it is recommended to bind
@code{tramp-verbose} to 0 when running @code{make-process} or
-@code{start-file-process}.
+@code{start-file-process}. Furthermore, you might set
+@code{tramp-use-ssh-controlmaster-options} to @code{nil} in order to
+bypass @value{tramp}'s handling of the @code{ControlMaster} options,
+and use your own settings in @file{~/.ssh/config}.
@node Cleanup remote connections
diff --git a/etc/NEWS b/etc/NEWS
index 8118272..2be9743 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -81,9 +81,11 @@ useful on systems such as FreeBSD which ships only with
"etc/termcap".
* Changes in Emacs 28.1
+++
-** The new constants 'shell-command-buffer-name' and
+** New variables that hold default buffer names for shell output.
+The new constants 'shell-command-buffer-name' and
'shell-command-buffer-name-async' store the default buffer names
-for the output of shell commands.
+for the output of, respectively, synchronous and async shell
+commands.
** Support for '(box . SIZE)' 'cursor-type'.
By default, 'box' cursor always has a filled box shape. But if you
@@ -96,9 +98,20 @@ dimension.
Added a new Mozhi scheme. The inapplicable ITRANS scheme is now
deprecated. Errors in the Inscript method were corrected.
+---
+** Rudimentary support for the 'st' terminal emulator.
+Emacs now supports 256 color display on the 'st' terminal emulator.
+
* Editing Changes in Emacs 28.1
+---
+** 'eval-expression' now no longer signals an error on incomplete expressions.
+Previously, typing 'M-: ( RET' would result in Emacs saying "End of
+file during parsing" and dropping out of the minibuffer. The user
+would have to type 'M-: M-p' to edit and redo the expression. Now
+Emacs will echo the message and allow the user to continue editing.
+
+++
** New command 'undo-redo'.
It undoes previous undo commands, but doesn't record itself as an
@@ -201,13 +214,19 @@ as a data list rather than as a piece of code.
** Calendar
-*** New variable 'calendar-use-numeric-time-zones' to use numeric time zones.
-If non-nil, functions that display time zones (like the 'S' command in
-calendar mode that displays the sunrise time) will display time zones
-like "+0100" instead of "CET".
++++
+*** New user option 'calendar-time-zone-style'.
+If 'numeric, calendar functions (eg calendar-sunrise-sunset) that display
+time zones will use a form like "+0100" instead of "CET".
** Dired
++++
+*** New user option 'dired-copy-dereference'.
+If set, Dired will dereferences symbolic links when copying. This can
+be switched off on a per-usage basis by providing 'dired-do-copy' with
+a 'C-u' prefix.
+
*** New user option 'dired-mark-region' affects all Dired commands
that mark files. When non-nil and the region is active in Transient
Mark mode, then Dired commands operate only on files in the active
@@ -233,12 +252,12 @@ their 'default-directory' under VC.
Bookmark locations can refer to VC directory buffers.
---
-*** New user option 'vc-hg-create-bookmark' controls whether a bookmark
-or branch will be created when you invoke 'C-u C-x v s' ('vc-create-tag').
+*** New user option 'vc-hg-create-bookmark'.
+It controls whether a bookmark or branch will be created when you
+invoke 'C-u C-x v s' ('vc-create-tag').
---
-*** 'vc-hg' now uses 'hg summary' command to populate extra 'vc-dir'
-headers.
+*** 'vc-hg' now uses 'hg summary' to populate extra 'vc-dir' headers.
** Gnus
@@ -502,6 +521,14 @@ with a newline.
*** New user option 'texinfo-texi2dvi-options'.
This is used when invoking 'texi2dvi' from 'texinfo-tex-buffer'.
+---
+*** New commands for moving in and between environments.
+An "environment" is something that ends with @end. The commands are
+'C-c C-c C-f' (next end), 'C-c C-c C-b' (previous end),
+'C-c C-c C-n' (next start) and 'C-c C-c C-p' (previous start), as well
+as 'C-c .', which will alternate between the start end the end of the
+current environment.
+
** Rmail
---
@@ -515,6 +542,9 @@ prefix on the Subject line in various languages.
These new navigation commands are bound to 'n' and 'p' in
'apropos-mode'.
+*** New command 'apropos-function'.
+This works like 'C-u M-x apropos-command' but is more discoverable.
+
** CC Mode
*** Added support for Doxygen documentation style.
@@ -687,6 +717,10 @@ https://www.w3.org/TR/xml/#charsets). Now it rejects such
strings.
*** The /ignore command will now ask for a timeout to stop ignoring the user.
Allowed inputs are seconds or ISO8601-like periods like "1h" or "4h30m".
+---
+*** ERC now recognizes C-] for italic text.
+Italic text is displayed in the new 'erc-italic-face'.
+
** Battery
---
@@ -734,6 +768,15 @@ name.
** Recentf
The recentf files are no longer backed up.
+** Calc
+
+---
+*** The behaviour when doing forward-delete has been changed.
+Previously, using the 'C-d' command would delete the final number in
+the input field, no matter where point was. This has been changed to
+work more traditionally, with 'C-d' deleting the next character.
+Likewise, point isn't moved to the end of the string before inserting
+digits.
** Miscellaneous
@@ -751,6 +794,29 @@ never be narrower than 19 characters.
When the 'bookmark.el' library is loaded, a customize choice is added
to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list.
+
+** xwidget-webkit mode
+
+*** New xwidget functions
+'xwidget-webkit-uri' (return the current URL), 'xwidget-webkit-title'
+(return the current title), and 'xwidget-webkit-goto-history' (goto a
+point in history).
+
+*** Pixel-based scrolling
+The 'xwidget-webkit-scroll-up', 'xwidget-webkit-scroll-down' commands
+now supports scrolling arbitrary pixel values. It now treats the
+optional 2nd argument as the pixel values to scroll.
+
+*** New commands for scrolling
+The new commands 'xwidget-webkit-scroll-up-line',
+'xwidget-webkit-scroll-down-line', 'xwidget-webkit-scroll-forward',
+'xwidget-webkit-scroll-backward' can be used to scroll webkit by the
+height of lines or width of chars.
+
+*** New user option 'xwidget-webkit-bookmark-jump-new-session'.
+When non-nil, use a new xwidget webkit session after bookmark jump.
+Otherwise, it will use 'xwidget-webkit-last-session'.
+
* New Modes and Packages in Emacs 28.1
@@ -828,6 +894,10 @@ have now been removed.
* Lisp Changes in Emacs 28.1
++++
+** The 'count-lines' function now takes an optional parameter to
+ignore invisible lines.
+
---
** New function 'custom-add-choice'.
This function can be used by modes to add elements to the
@@ -914,6 +984,21 @@ convert them to a list '(R G B)' of primary color values.
* Changes in Emacs 28.1 on Non-Free Operating Systems
+---
+** On macOS, Xwidget is now supported.
+If Emacs was built with xwidget support, you can access the embedded
+webkit browser with 'M-x xwidget-webkit-browse-url'. Viewing two
+instances of xwidget webkit is not supported.
+
+*** Downloading files from xwidget-webkit is now supported.
+The new variable 'xwidget-webkit-download-dir' says where to download to.
+
+*** New functions for xwidget-webkit mode
+'xwidget-webkit-clone-and-split-below',
+'xwidget-webkit-clone-and-split-right'.
+
+*** New variable 'xwidget-webkit-enable-plugins'.
+
+++
** On macOS, Emacs can now load dynamic modules with a ".dylib" suffix.
'module-file-suffix' now has the value ".dylib" on macOS, but the
@@ -954,6 +1039,7 @@ GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
Local variables:
coding: utf-8
diff --git a/etc/emacs.service b/etc/emacs.service
index c99c677..0dc2418 100644
--- a/etc/emacs.service
+++ b/etc/emacs.service
@@ -8,7 +8,7 @@ Documentation=info:emacs man:emacs(1)
https://gnu.org/software/emacs/
[Service]
Type=notify
-ExecStart=emacs --fg-daemon
+ExecStart=@emacs emacsd --fg-daemon
ExecStop=emacsclient --eval "(kill-emacs)"
# The location of the SSH auth socket varies by distribution, and some
# set it from PAM, so don't override by default.
diff --git a/etc/emacsclient.desktop b/etc/emacsclient.desktop
new file mode 100644
index 0000000..3feb83c
--- /dev/null
+++ b/etc/emacsclient.desktop
@@ -0,0 +1,12 @@
+[Desktop Entry]
+Name=Emacs (Client)
+GenericName=Text Editor
+Comment=Edit text
+MimeType=text/english;text/plain;text/x-makefile;text/x-c++hdr;text/x-c++src;text/x-chdr;text/x-csrc;text/x-java;text/x-moc;text/x-pascal;text/x-tcl;text/x-tex;application/x-shellscript;text/x-c;text/x-c++;
+Exec=emacsclient -c %F
+Icon=emacs
+Type=Application
+Terminal=false
+Categories=Development;TextEditor;
+StartupWMClass=Emacsd
+Keywords=Text;Editor;
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 380be95..871fa7a 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -1504,11 +1504,17 @@ set_local_socket (char const *server_name)
"%s: (Be careful: XDG_RUNTIME_DIR is security-related.)\n"),
progname, sockdirname, progname);
}
- message (true,
- ("%s: can't find socket; have you started the server?\n"
- "%s: To start the server in Emacs,"
- " type \"M-x server-start\".\n"),
- progname, progname);
+
+ /* If there's an alternate editor and the user has requested
+ --quiet, don't output the warning. */
+ if (!quiet || !alternate_editor)
+ {
+ message (true,
+ ("%s: can't find socket; have you started the server?\n"
+ "%s: To start the server in Emacs,"
+ " type \"M-x server-start\".\n"),
+ progname, progname);
+ }
}
else
message (true, "%s: can't stat %s: %s\n",
diff --git a/lib/alloca.in.h b/lib/alloca.in.h
index 5686b08..c71e9bf 100644
--- a/lib/alloca.in.h
+++ b/lib/alloca.in.h
@@ -44,7 +44,7 @@
# endif
#endif
#ifndef alloca
-# ifdef __GNUC__
+# if defined __GNUC__ || (__clang_major__ >= 4)
# define alloca __builtin_alloca
# elif defined _AIX
# define alloca __alloca
diff --git a/lib/arg-nonnull.h b/lib/arg-nonnull.h
index ac26ca8..db9d9ae 100644
--- a/lib/arg-nonnull.h
+++ b/lib/arg-nonnull.h
@@ -18,7 +18,7 @@
that the values passed as arguments n, ..., m must be non-NULL pointers.
n = 1 stands for the first argument, n = 2 for the second argument etc. */
#ifndef _GL_ARG_NONNULL
-# if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || __GNUC__ > 3
+# if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || defined
__clang__
# define _GL_ARG_NONNULL(params) __attribute__ ((__nonnull__ params))
# else
# define _GL_ARG_NONNULL(params)
diff --git a/lib/binary-io.h b/lib/binary-io.h
index 477b4bf..d17af7c 100644
--- a/lib/binary-io.h
+++ b/lib/binary-io.h
@@ -56,7 +56,7 @@ __gl_setmode (int fd _GL_UNUSED, int mode _GL_UNUSED)
/* Set FD's mode to MODE, which should be either O_TEXT or O_BINARY.
Return the old mode if successful, -1 (setting errno) on failure.
Ordinarily this function would be called 'setmode', since that is
- its name on MS-Windows, but it is called 'set_binary_mode' here
+ its old name on MS-Windows, but it is called 'set_binary_mode' here
to avoid colliding with a BSD function of another name. */
#if defined __DJGPP__ || defined __EMX__
diff --git a/lib/c++defs.h b/lib/c++defs.h
index 182c2b3..90e6fd6 100644
--- a/lib/c++defs.h
+++ b/lib/c++defs.h
@@ -298,7 +298,7 @@
we enable the warning only when not optimizing. */
# if !(defined __GNUC__ && !defined __clang__ && __OPTIMIZE__)
# define
_GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \
- _GL_WARN_ON_USE_CXX (func, rettype, parameters_and_attributes, \
+ _GL_WARN_ON_USE_CXX (func, rettype, rettype, parameters_and_attributes, \
"The symbol ::" #func " refers to the system
function. " \
"Use " #namespace "::" #func " instead.")
# else
diff --git a/lib/cdefs.h b/lib/cdefs.h
index f6c447a..4f89f4e 100644
--- a/lib/cdefs.h
+++ b/lib/cdefs.h
@@ -34,7 +34,34 @@
#undef __P
#undef __PMT
-#ifdef __GNUC__
+/* Compilers that are not clang may object to
+ #if defined __clang__ && __has_attribute(...)
+ even though they do not need to evaluate the right-hand side of the &&. */
+#if defined __clang__ && defined __has_attribute
+# define __glibc_clang_has_attribute(name) __has_attribute (name)
+#else
+# define __glibc_clang_has_attribute(name) 0
+#endif
+
+/* Compilers that are not clang may object to
+ #if defined __clang__ && __has_builtin(...)
+ even though they do not need to evaluate the right-hand side of the &&. */
+#if defined __clang__ && defined __has_builtin
+# define __glibc_clang_has_builtin(name) __has_builtin (name)
+#else
+# define __glibc_clang_has_builtin(name) 0
+#endif
+
+/* Compilers that are not clang may object to
+ #if defined __clang__ && __has_extension(...)
+ even though they do not need to evaluate the right-hand side of the &&. */
+#if defined __clang__ && defined __has_extension
+# define __glibc_clang_has_extension(ext) __has_extension (ext)
+#else
+# define __glibc_clang_has_extension(ext) 0
+#endif
+
+#if defined __GNUC__ || defined __clang__
/* All functions, except those with callbacks or those that
synchronize memory, are leaf functions. */
@@ -51,7 +78,8 @@
gcc 2.8.x and egcs. For gcc 3.2 and up we even mark C functions
as non-throwing using a function attribute since programs can use
the -fexceptions options for C code as well. */
-# if !defined __cplusplus && __GNUC_PREREQ (3, 3)
+# if !defined __cplusplus \
+ && (__GNUC_PREREQ (3, 3) || __glibc_clang_has_attribute (__nothrow__))
# define __THROW __attribute__ ((__nothrow__ __LEAF))
# define __THROWNL __attribute__ ((__nothrow__))
# define __NTH(fct) __attribute__ ((__nothrow__ __LEAF)) fct
@@ -70,7 +98,7 @@
# endif
# endif
-#else /* Not GCC. */
+#else /* Not GCC or clang. */
# if (defined __cplusplus \
|| (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L))
@@ -83,16 +111,7 @@
# define __THROWNL
# define __NTH(fct) fct
-#endif /* GCC. */
-
-/* Compilers that are not clang may object to
- #if defined __clang__ && __has_extension(...)
- even though they do not need to evaluate the right-hand side of the &&. */
-#if defined __clang__ && defined __has_extension
-# define __glibc_clang_has_extension(ext) __has_extension (ext)
-#else
-# define __glibc_clang_has_extension(ext) 0
-#endif
+#endif /* GCC || clang. */
/* These two macros are not used in glibc anymore. They are kept here
only because some other projects expect the macros to be defined. */
@@ -129,6 +148,12 @@
# define __warnattr(msg) __attribute__((__warning__ (msg)))
# define __errordecl(name, msg) \
extern void name (void) __attribute__((__error__ (msg)))
+#elif __glibc_clang_has_attribute (__diagnose_if__)
+# define __warndecl(name, msg) \
+ extern void name (void) __attribute__((__diagnose_if__ (1, msg, "warning")))
+# define __warnattr(msg) __attribute__((__diagnose_if__ (1, msg, "warning")))
+# define __errordecl(name, msg) \
+ extern void name (void) __attribute__((__diagnose_if__ (1, msg, "error")))
#else
# define __warndecl(name, msg) extern void name (void)
# define __warnattr(msg)
@@ -142,8 +167,8 @@
#if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L && !defined __HP_cc
# define __flexarr []
# define __glibc_c99_flexarr_available 1
-#elif __GNUC_PREREQ (2,97)
-/* GCC 2.97 supports C99 flexible array members as an extension,
+#elif __GNUC_PREREQ (2,97) || defined __clang__
+/* GCC 2.97 and clang support C99 flexible array members as an extension,
even when in C89 mode or compiling C++ (any version). */
# define __flexarr []
# define __glibc_c99_flexarr_available 1
@@ -194,17 +219,17 @@
*/
#endif
-/* GCC has various useful declarations that can be made with the
- `__attribute__' syntax. All of the ways we use this do fine if
- they are omitted for compilers that don't understand it. */
-#if !defined __GNUC__ || __GNUC__ < 2
+/* GCC and clang have various useful declarations that can be made with
+ the '__attribute__' syntax. All of the ways we use this do fine if
+ they are omitted for compilers that don't understand it. */
+#if !(defined __GNUC__ || defined __clang__)
# define __attribute__(xyz) /* Ignore */
#endif
/* At some point during the gcc 2.96 development the `malloc' attribute
for functions was introduced. We don't want to use it unconditionally
(although this would be possible) since it generates warnings. */
-#if __GNUC_PREREQ (2,96)
+#if __GNUC_PREREQ (2,96) || __glibc_clang_has_attribute (__malloc__)
# define __attribute_malloc__ __attribute__ ((__malloc__))
#else
# define __attribute_malloc__ /* Ignore */
@@ -222,14 +247,14 @@
/* At some point during the gcc 2.96 development the `pure' attribute
for functions was introduced. We don't want to use it unconditionally
(although this would be possible) since it generates warnings. */
-#if __GNUC_PREREQ (2,96)
+#if __GNUC_PREREQ (2,96) || __glibc_clang_has_attribute (__pure__)
# define __attribute_pure__ __attribute__ ((__pure__))
#else
# define __attribute_pure__ /* Ignore */
#endif
/* This declaration tells the compiler that the value is constant. */
-#if __GNUC_PREREQ (2,5)
+#if __GNUC_PREREQ (2,5) || __glibc_clang_has_attribute (__const__)
# define __attribute_const__ __attribute__ ((__const__))
#else
# define __attribute_const__ /* Ignore */
@@ -238,7 +263,7 @@
/* At some point during the gcc 3.1 development the `used' attribute
for functions was introduced. We don't want to use it unconditionally
(although this would be possible) since it generates warnings. */
-#if __GNUC_PREREQ (3,1)
+#if __GNUC_PREREQ (3,1) || __glibc_clang_has_attribute (__used__)
# define __attribute_used__ __attribute__ ((__used__))
# define __attribute_noinline__ __attribute__ ((__noinline__))
#else
@@ -247,7 +272,7 @@
#endif
/* Since version 3.2, gcc allows marking deprecated functions. */
-#if __GNUC_PREREQ (3,2)
+#if __GNUC_PREREQ (3,2) || __glibc_clang_has_attribute (__deprecated__)
# define __attribute_deprecated__ __attribute__ ((__deprecated__))
#else
# define __attribute_deprecated__ /* Ignore */
@@ -270,7 +295,7 @@
If several `format_arg' attributes are given for the same function, in
gcc-3.0 and older, all but the last one are ignored. In newer gccs,
all designated arguments are considered. */
-#if __GNUC_PREREQ (2,8)
+#if __GNUC_PREREQ (2,8) || __glibc_clang_has_attribute (__format_arg__)
# define __attribute_format_arg__(x) __attribute__ ((__format_arg__ (x)))
#else
# define __attribute_format_arg__(x) /* Ignore */
@@ -280,7 +305,7 @@
attribute for functions was introduced. We don't want to use it
unconditionally (although this would be possible) since it
generates warnings. */
-#if __GNUC_PREREQ (2,97)
+#if __GNUC_PREREQ (2,97) || __glibc_clang_has_attribute (__format__)
# define __attribute_format_strfmon__(a,b) \
__attribute__ ((__format__ (__strfmon__, a, b)))
#else
@@ -291,7 +316,7 @@
must not be NULL. Do not define __nonnull if it is already defined,
for portability when this file is used in Gnulib. */
#ifndef __nonnull
-# if __GNUC_PREREQ (3,3)
+# if __GNUC_PREREQ (3,3) || __glibc_clang_has_attribute (__nonnull__)
# define __nonnull(params) __attribute__ ((__nonnull__ params))
# else
# define __nonnull(params)
@@ -300,7 +325,7 @@
/* If fortification mode, we warn about unused results of certain
function calls which can lead to problems. */
-#if __GNUC_PREREQ (3,4)
+#if __GNUC_PREREQ (3,4) || __glibc_clang_has_attribute (__warn_unused_result__)
# define __attribute_warn_unused_result__ \
__attribute__ ((__warn_unused_result__))
# if defined __USE_FORTIFY_LEVEL && __USE_FORTIFY_LEVEL > 0
@@ -314,7 +339,7 @@
#endif
/* Forces a function to be always inlined. */
-#if __GNUC_PREREQ (3,2)
+#if __GNUC_PREREQ (3,2) || __glibc_clang_has_attribute (__always_inline__)
/* The Linux kernel defines __always_inline in stddef.h (283d7573), and
it conflicts with this definition. Therefore undefine it first to
allow either header to be included first. */
@@ -327,7 +352,7 @@
/* Associate error messages with the source location of the call site rather
than with the source location inside the function. */
-#if __GNUC_PREREQ (4,3)
+#if __GNUC_PREREQ (4,3) || __glibc_clang_has_attribute (__artificial__)
# define __attribute_artificial__ __attribute__ ((__artificial__))
#else
# define __attribute_artificial__ /* Ignore */
@@ -370,12 +395,14 @@
run in pedantic mode if the uses are carefully marked using the
`__extension__' keyword. But this is not generally available before
version 2.8. */
-#if !__GNUC_PREREQ (2,8)
+#if !(__GNUC_PREREQ (2,8) || defined __clang__)
# define __extension__ /* Ignore */
#endif
-/* __restrict is known in EGCS 1.2 and above. */
-#if !__GNUC_PREREQ (2,92)
+/* __restrict is known in EGCS 1.2 and above, and in clang.
+ It works also in C++ mode (outside of arrays), but only when spelled
+ as '__restrict', not 'restrict'. */
+#if !(__GNUC_PREREQ (2,92) || __clang_major__ >= 3)
# if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L
# define __restrict restrict
# else
@@ -385,8 +412,9 @@
/* ISO C99 also allows to declare arrays as non-overlapping. The syntax is
array_name[restrict]
- GCC 3.1 supports this. */
-#if __GNUC_PREREQ (3,1) && !defined __GNUG__
+ GCC 3.1 and clang support this.
+ This syntax is not usable in C++ mode. */
+#if (__GNUC_PREREQ (3,1) || __clang_major__ >= 3) && !defined __cplusplus
# define __restrict_arr __restrict
#else
# ifdef __GNUC__
@@ -401,7 +429,7 @@
# endif
#endif
-#if (__GNUC__ >= 3) || (__clang_major__ >= 4)
+#if (__GNUC__ >= 3) || __glibc_clang_has_builtin (__builtin_expect)
# define __glibc_unlikely(cond) __builtin_expect ((cond), 0)
# define __glibc_likely(cond) __builtin_expect ((cond), 1)
#else
@@ -417,7 +445,8 @@
#if (!defined _Noreturn \
&& (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) < 201112 \
- && !__GNUC_PREREQ (4,7))
+ && !(__GNUC_PREREQ (4,7) \
+ || (3 < __clang_major__ + (5 <= __clang_minor__))))
# if __GNUC_PREREQ (2,8)
# define _Noreturn __attribute__ ((__noreturn__))
# else
diff --git a/lib/count-one-bits.h b/lib/count-one-bits.h
index 6c5b757..a9e166a 100644
--- a/lib/count-one-bits.h
+++ b/lib/count-one-bits.h
@@ -38,7 +38,8 @@ extern "C" {
expand to code that computes the number of 1-bits of the local
variable 'x' of type TYPE (an unsigned integer type) and return it
from the current function. */
-#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
+#if (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) \
+ || (__clang_major__ >= 4)
# define COUNT_ONE_BITS(GCC_BUILTIN, MSC_BUILTIN, TYPE) \
return GCC_BUILTIN (x)
#else
diff --git a/lib/dirent.in.h b/lib/dirent.in.h
index 6fa44f0..23c4e05 100644
--- a/lib/dirent.in.h
+++ b/lib/dirent.in.h
@@ -58,7 +58,7 @@ typedef struct gl_directory DIR;
/* The __attribute__ feature is available in gcc versions 2.5 and later.
The attribute __pure__ was added in gcc 2.96. */
#ifndef _GL_ATTRIBUTE_PURE
-# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
+# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) || defined
__clang__
# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
# else
# define _GL_ATTRIBUTE_PURE /* empty */
diff --git a/lib/fcntl.c b/lib/fcntl.c
index 6b9927e..8cd1531 100644
--- a/lib/fcntl.c
+++ b/lib/fcntl.c
@@ -70,14 +70,14 @@ dupfd (int oldfd, int newfd, int flags)
return -1;
}
if (old_handle == INVALID_HANDLE_VALUE
- || (mode = setmode (oldfd, O_BINARY)) == -1)
+ || (mode = _setmode (oldfd, O_BINARY)) == -1)
{
/* oldfd is not open, or is an unassigned standard file
descriptor. */
errno = EBADF;
return -1;
}
- setmode (oldfd, mode);
+ _setmode (oldfd, mode);
flags |= mode;
for (;;)
diff --git a/lib/ignore-value.h b/lib/ignore-value.h
index 7a92226..ec3288f 100644
--- a/lib/ignore-value.h
+++ b/lib/ignore-value.h
@@ -39,8 +39,9 @@
versions 3.4 and newer have __attribute__ ((__warn_unused_result__))
which may cause unwanted diagnostics in that case. Use __typeof__
and __extension__ to work around the problem, if the workaround is
- known to be needed. */
-#if 3 < __GNUC__ + (4 <= __GNUC_MINOR__)
+ known to be needed.
+ The workaround is not needed with clang. */
+#if (3 < __GNUC__ + (4 <= __GNUC_MINOR__)) && !defined __clang__
# define ignore_value(x) \
(__extension__ ({ __typeof__ (x) __x = (x); (void) __x; }))
#else
diff --git a/lib/intprops.h b/lib/intprops.h
index dfbcaae..220f532 100644
--- a/lib/intprops.h
+++ b/lib/intprops.h
@@ -86,6 +86,7 @@
/* Does the __typeof__ keyword work? This could be done by
'configure', but for now it's easier to do it by hand. */
#if (2 <= __GNUC__ \
+ || (4 <= __clang_major__) \
|| (1210 <= __IBMC__ && defined __IBM__TYPEOF__) \
|| (0x5110 <= __SUNPRO_C && !__STDC__))
# define _GL_HAVE___TYPEOF__ 1
@@ -239,7 +240,7 @@
#endif
/* True if __builtin_add_overflow_p (A, B, C) works, and similarly for
- __builtin_mul_overflow_p and __builtin_mul_overflow_p. */
+ __builtin_sub_overflow_p and __builtin_mul_overflow_p. */
#define _GL_HAS_BUILTIN_OVERFLOW_P (7 <= __GNUC__)
/* The _GL*_OVERFLOW macros have the same restrictions as the
diff --git a/lib/malloca.h b/lib/malloca.h
index cfcd4de..ccc485a 100644
--- a/lib/malloca.h
+++ b/lib/malloca.h
@@ -89,7 +89,7 @@ extern void freea (void *p);
/* ------------------- Auxiliary, non-public definitions ------------------- */
/* Determine the alignment of a type at compile time. */
-#if defined __GNUC__ || defined __IBM__ALIGNOF__
+#if defined __GNUC__ || defined __clang__ || defined __IBM__ALIGNOF__
# define sa_alignof __alignof__
#elif defined __cplusplus
template <class type> struct sa_alignof_helper { char __slot1; type __slot2;
};
diff --git a/lib/regex.h b/lib/regex.h
index 610f139..306521a 100644
--- a/lib/regex.h
+++ b/lib/regex.h
@@ -612,7 +612,9 @@ extern int re_exec (const char *);
'configure' might #define 'restrict' to those words, so pick a
different name. */
#ifndef _Restrict_
-# if defined __restrict || 2 < __GNUC__ + (95 <= __GNUC_MINOR__)
+# if defined __restrict \
+ || 2 < __GNUC__ + (95 <= __GNUC_MINOR__) \
+ || __clang_major__ >= 3
# define _Restrict_ __restrict
# elif 199901L <= __STDC_VERSION__ || defined restrict
# define _Restrict_ restrict
@@ -620,13 +622,18 @@ extern int re_exec (const char *);
# define _Restrict_
# endif
#endif
-/* For [restrict], use glibc's __restrict_arr if available.
- Otherwise, GCC 3.1 (not in C++ mode) and C99 support [restrict]. */
+/* For the ISO C99 syntax
+ array_name[restrict]
+ use glibc's __restrict_arr if available.
+ Otherwise, GCC 3.1 and clang support this syntax (but not in C++ mode).
+ Other ISO C99 compilers support it as well. */
#ifndef _Restrict_arr_
# ifdef __restrict_arr
# define _Restrict_arr_ __restrict_arr
-# elif ((199901L <= __STDC_VERSION__ || 3 < __GNUC__ + (1 <= __GNUC_MINOR__)) \
- && !defined __GNUG__)
+# elif ((199901L <= __STDC_VERSION__ \
+ || 3 < __GNUC__ + (1 <= __GNUC_MINOR__) \
+ || __clang_major__ >= 3) \
+ && !defined __cplusplus)
# define _Restrict_arr_ _Restrict_
# else
# define _Restrict_arr_
diff --git a/lib/regex_internal.h b/lib/regex_internal.h
index f6ebfb0..9a0c2ed 100644
--- a/lib/regex_internal.h
+++ b/lib/regex_internal.h
@@ -841,10 +841,10 @@ re_string_elem_size_at (const re_string_t *pstr, Idx idx)
#endif /* RE_ENABLE_I18N */
#ifndef FALLTHROUGH
-# if __GNUC__ < 7
-# define FALLTHROUGH ((void) 0)
-# else
+# if (__GNUC__ >= 7) || (__clang_major__ >= 10)
# define FALLTHROUGH __attribute__ ((__fallthrough__))
+# else
+# define FALLTHROUGH ((void) 0)
# endif
#endif
diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h
index cd786be..e4809b4 100644
--- a/lib/stdalign.in.h
+++ b/lib/stdalign.in.h
@@ -34,11 +34,12 @@
requirement of a structure member (i.e., slot or field) that is of
type TYPE, as an integer constant expression.
- This differs from GCC's __alignof__ operator, which can yield a
- better-performing alignment for an object of that type. For
- example, on x86 with GCC, __alignof__ (double) and __alignof__
- (long long) are 8, whereas alignof (double) and alignof (long long)
- are 4 unless the option '-malign-double' is used.
+ This differs from GCC's and clang's __alignof__ operator, which can
+ yield a better-performing alignment for an object of that type. For
+ example, on x86 with GCC and on Linux/x86 with clang,
+ __alignof__ (double) and __alignof__ (long long) are 8, whereas
+ alignof (double) and alignof (long long) are 4 unless the option
+ '-malign-double' is used.
The result cannot be used as a value for an 'enum' constant, if you
want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc.
@@ -55,7 +56,8 @@
/* GCC releases before GCC 4.9 had a bug in _Alignof. See GCC bug 52023
<https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. */
#if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \
- || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9)))
+ || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9) \
+ && !defined __clang__))
# ifdef __cplusplus
# if 201103 <= __cplusplus
# define _Alignof(type) alignof (type)
@@ -102,8 +104,9 @@
# define _Alignas(a) alignas (a)
# elif ((defined __APPLE__ && defined __MACH__ \
? 4 < __GNUC__ + (1 <= __GNUC_MINOR__) \
- : __GNUC__ && !defined __ibmxl__) \
- || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \
+ : __GNUC__ && !defined __ibmxl__) \
+ || (4 <= __clang_major__) \
+ || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \
|| __ICC || 0x590 <= __SUNPRO_C || 0x0600 <= __xlC__)
# define _Alignas(a) __attribute__ ((__aligned__ (a)))
# elif 1300 <= _MSC_VER
diff --git a/lib/stddef.in.h b/lib/stddef.in.h
index 2e50a1f..87b46d5 100644
--- a/lib/stddef.in.h
+++ b/lib/stddef.in.h
@@ -97,7 +97,7 @@
and the C11 standard allows this. Work around this problem by
using __alignof__ (which returns 8 for double) rather than _Alignof
(which returns 4), and align each union member accordingly. */
-# ifdef __GNUC__
+# if defined __GNUC__ || (__clang_major__ >= 4)
# define _GL_STDDEF_ALIGNAS(type) \
__attribute__ ((__aligned__ (__alignof__ (type))))
# else
diff --git a/lib/stdint.in.h b/lib/stdint.in.h
index 994c0c7..63fa1aa 100644
--- a/lib/stdint.in.h
+++ b/lib/stdint.in.h
@@ -302,12 +302,11 @@ typedef gl_uint_fast32_t gl_uint_fast16_t;
/* kLIBC's <stdint.h> defines _INTPTR_T_DECLARED and needs its own
definitions of intptr_t and uintptr_t (which use int and unsigned)
to avoid clashes with declarations of system functions like sbrk.
- Similarly, mingw 5.22 <crtdefs.h> defines _INTPTR_T_DEFINED and
- _UINTPTR_T_DEFINED and needs its own definitions of intptr_t and
+ Similarly, MinGW WSL-5.4.1 <stdint.h> needs its own intptr_t and
uintptr_t to avoid conflicting declarations of system functions like
_findclose in <io.h>. */
# if !((defined __KLIBC__ && defined _INTPTR_T_DECLARED) \
- || (defined __MINGW32__ && defined _INTPTR_T_DEFINED && defined
_UINTPTR_T_DEFINED))
+ || defined __MINGW32__)
# undef intptr_t
# undef uintptr_t
# ifdef _WIN64
diff --git a/lib/stdio.in.h b/lib/stdio.in.h
index 6c338dd..cbebc84 100644
--- a/lib/stdio.in.h
+++ b/lib/stdio.in.h
@@ -63,7 +63,7 @@
gnulib and libintl do '#define printf __printf__' when they override
the 'printf' function. */
#ifndef _GL_ATTRIBUTE_FORMAT
-# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
+# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7) || defined
__clang__
# define _GL_ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
# else
# define _GL_ATTRIBUTE_FORMAT(spec) /* empty */
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
index 59f9e6c..5c598a2 100644
--- a/lib/stdlib.in.h
+++ b/lib/stdlib.in.h
@@ -102,7 +102,7 @@ struct random_data
/* The __attribute__ feature is available in gcc versions 2.5 and later.
The attribute __pure__ was added in gcc 2.96. */
#ifndef _GL_ATTRIBUTE_PURE
-# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
+# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) || defined
__clang__
# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
# else
# define _GL_ATTRIBUTE_PURE /* empty */
diff --git a/lib/string.in.h b/lib/string.in.h
index aa98027..c0c1a54 100644
--- a/lib/string.in.h
+++ b/lib/string.in.h
@@ -55,7 +55,7 @@
/* The __attribute__ feature is available in gcc versions 2.5 and later.
The attribute __pure__ was added in gcc 2.96. */
#ifndef _GL_ATTRIBUTE_PURE
-# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
+# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) || defined
__clang__
# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
# else
# define _GL_ATTRIBUTE_PURE /* empty */
@@ -329,7 +329,8 @@ _GL_WARN_ON_USE (stpncpy, "stpncpy is unportable - "
GB18030 and the character to be searched is a digit. */
# undef strchr
/* Assume strchr is always declared. */
-_GL_WARN_ON_USE_CXX (strchr, const char *, (const char *, int),
+_GL_WARN_ON_USE_CXX (strchr,
+ const char *, char *, (const char *, int),
"strchr cannot work correctly on character strings "
"in some multibyte locales - "
"use mbschr if you care about internationalization");
@@ -524,7 +525,8 @@ _GL_CXXALIASWARN (strpbrk);
locale encoding is GB18030 and one of the characters to be searched is a
digit. */
# undef strpbrk
-_GL_WARN_ON_USE_CXX (strpbrk, const char *, (const char *, const char *),
+_GL_WARN_ON_USE_CXX (strpbrk,
+ const char *, char *, (const char *, const char *),
"strpbrk cannot work correctly on character strings "
"in multibyte locales - "
"use mbspbrk if you care about internationalization");
@@ -532,7 +534,8 @@ _GL_WARN_ON_USE_CXX (strpbrk, const char *, (const char *,
const char *),
#elif defined GNULIB_POSIXCHECK
# undef strpbrk
# if HAVE_RAW_DECL_STRPBRK
-_GL_WARN_ON_USE_CXX (strpbrk, const char *, (const char *, const char *),
+_GL_WARN_ON_USE_CXX (strpbrk,
+ const char *, char *, (const char *, const char *),
"strpbrk is unportable - "
"use gnulib module strpbrk for portability");
# endif
@@ -553,7 +556,8 @@ _GL_WARN_ON_USE (strspn, "strspn cannot work correctly on
character strings "
GB18030 and the character to be searched is a digit. */
# undef strrchr
/* Assume strrchr is always declared. */
-_GL_WARN_ON_USE_CXX (strrchr, const char *, (const char *, int),
+_GL_WARN_ON_USE_CXX (strrchr,
+ const char *, char *, (const char *, int),
"strrchr cannot work correctly on character strings "
"in some multibyte locales - "
"use mbsrchr if you care about internationalization");
diff --git a/lib/verify.h b/lib/verify.h
index f109761..58172f3 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -233,6 +233,13 @@ template <int w>
/* @assert.h omit start@ */
+#if defined __has_builtin
+/* <https://clang.llvm.org/docs/LanguageExtensions.html#builtin-functions> */
+# define _GL_HAS_BUILTIN_ASSUME __has_builtin (__builtin_assume)
+#else
+# define _GL_HAS_BUILTIN_ASSUME 0
+#endif
+
#if 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__))
# define _GL_HAS_BUILTIN_TRAP 1
#elif defined __has_builtin
@@ -294,7 +301,9 @@ template <int w>
diagnostics, performance can suffer if R uses hard-to-optimize
features such as function calls not inlined by the compiler. */
-#if _GL_HAS_BUILTIN_UNREACHABLE
+#if _GL_HAS_BUILTIN_ASSUME
+# define assume(R) __builtin_assume (R)
+#elif _GL_HAS_BUILTIN_UNREACHABLE
# define assume(R) ((R) ? (void) 0 : __builtin_unreachable ())
#elif 1200 <= _MSC_VER
# define assume(R) __assume (R)
diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h
index 23c10fd..3f728d1 100644
--- a/lib/warn-on-use.h
+++ b/lib/warn-on-use.h
@@ -87,6 +87,13 @@
extern __typeof__ (function) function __attribute__ ((__warning__ (message)))
# define _GL_WARN_ON_USE_ATTRIBUTE(message) \
__attribute__ ((__warning__ (message)))
+# elif __clang_major__ >= 4
+/* Another compiler attribute is available in clang. */
+# define _GL_WARN_ON_USE(function, message) \
+extern __typeof__ (function) function \
+ __attribute__ ((__diagnose_if__ (1, message, "warning")))
+# define _GL_WARN_ON_USE_ATTRIBUTE(message) \
+ __attribute__ ((__diagnose_if__ (1, message, "warning")))
# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING
/* Verify the existence of the function. */
# define _GL_WARN_ON_USE(function, message) \
@@ -99,27 +106,33 @@ _GL_WARN_EXTERN_C int _gl_warn_on_use
# endif
#endif
-/* _GL_WARN_ON_USE_CXX (function, rettype, parameters_and_attributes, "string")
- is like _GL_WARN_ON_USE (function, "string"), except that in C++ mode the
+/* _GL_WARN_ON_USE_CXX (function, rettype_gcc, rettype_clang,
parameters_and_attributes, "message")
+ is like _GL_WARN_ON_USE (function, "message"), except that in C++ mode the
function is declared with the given prototype, consisting of return type,
parameters, and attributes.
This variant is useful for overloaded functions in C++. _GL_WARN_ON_USE does
not work in this case. */
#ifndef _GL_WARN_ON_USE_CXX
# if !defined __cplusplus
-# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \
+# define
_GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg)
\
_GL_WARN_ON_USE (function, msg)
# else
# if 4 < __GNUC__ || (__GNUC__ == 4 && 3 <= __GNUC_MINOR__)
-# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg)
\
-extern rettype function parameters_and_attributes \
- __attribute__ ((__warning__ (msg)))
+/* A compiler attribute is available in gcc versions 4.3.0 and later. */
+# define
_GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg)
\
+extern rettype_gcc function parameters_and_attributes \
+ __attribute__ ((__warning__ (msg)))
+# elif __clang_major__ >= 4
+/* Another compiler attribute is available in clang. */
+# define
_GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg)
\
+extern rettype_clang function parameters_and_attributes \
+ __attribute__ ((__diagnose_if__ (1, msg, "warning")))
# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING
/* Verify the existence of the function. */
-# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg)
\
-extern rettype function parameters_and_attributes
+# define
_GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg)
\
+extern rettype_gcc function parameters_and_attributes
# else /* Unsupported. */
-# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg)
\
+# define
_GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg)
\
_GL_WARN_EXTERN_C int _gl_warn_on_use
# endif
# endif
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index 2a8dced..03fc3e2 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -207,6 +207,7 @@ See `allout-widgets-mode' for allout widgets mode features."
:version "24.1"
:type 'plist
:group 'allout-widgets)
+(make-obsolete-variable 'allout-widgets-item-image-properties-xemacs nil
"28.1")
;;;_ . Developer
;;;_ = allout-widgets-run-unit-tests-on-load
(defcustom allout-widgets-run-unit-tests-on-load nil
@@ -323,8 +324,7 @@ In addition, you can invoked `allout-widgets-mode'
allout-mode
buffers where this is set to enable and disable widget
enhancements, directly.")
;;;###autoload
-(put 'allout-widgets-mode-inhibit 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-widgets-mode-inhibit 'safe-local-variable 'booleanp)
(make-variable-buffer-local 'allout-widgets-mode-inhibit)
;;;_ = allout-inhibit-body-modification-hook
(defvar allout-inhibit-body-modification-hook nil
@@ -1510,8 +1510,7 @@ recursive operation."
;; the actual location of the item text:
:location 'allout-item-location
- :button-keymap allout-item-icon-keymap ; XEmacs
- :keymap allout-item-icon-keymap ; Emacs
+ :keymap allout-item-icon-keymap
;; Element regions:
:guides-span nil
@@ -2329,15 +2328,13 @@ We use a caching strategy, so the caller doesn't need
to do so."
(allout-widgets-copy-list (cadr got))
(while (and types (not got))
(setq got
- (allout-find-image
+ (find-image
(list (append (list :type (car types)
:file (concat use-dir
(symbol-name name)
"." (symbol-name
(car types))))
- (if (featurep 'xemacs)
- allout-widgets-item-image-properties-xemacs
- allout-widgets-item-image-properties-emacs)
+ allout-widgets-item-image-properties-emacs
))))
(setq types (cdr types)))
(if got
@@ -2358,11 +2355,7 @@ We use a caching strategy, so the caller doesn't need to
do so."
'frame-property)
(t nil)))
;;;_ > allout-find-image (specs)
-(defalias 'allout-find-image
- (if (fboundp 'find-image)
- 'find-image
- nil) ; aka, not-yet-implemented for xemacs.
-)
+(define-obsolete-function-alias 'allout-find-image #'find-image "28.1")
;;;_ > allout-widgets-copy-list (list)
(defun allout-widgets-copy-list (list)
;; duplicated from cl.el 'copy-list' as of 2008-08-17
diff --git a/lisp/allout.el b/lisp/allout.el
index dedad45..05d9153 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -410,8 +410,7 @@ where auto-fill occurs."
:group 'allout)
(make-variable-buffer-local 'allout-use-hanging-indents)
;;;###autoload
-(put 'allout-use-hanging-indents 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-use-hanging-indents 'safe-local-variable 'booleanp)
;;;_ = allout-reindent-bodies
(defcustom allout-reindent-bodies (if allout-use-hanging-indents
'text)
@@ -440,8 +439,7 @@ just the header."
:group 'allout)
(make-variable-buffer-local 'allout-show-bodies)
;;;###autoload
-(put 'allout-show-bodies 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-show-bodies 'safe-local-variable 'booleanp)
;;;_ = allout-beginning-of-line-cycles
(defcustom allout-beginning-of-line-cycles t
@@ -662,8 +660,7 @@ are always respected by the topic maneuvering functions."
:group 'allout)
(make-variable-buffer-local 'allout-old-style-prefixes)
;;;###autoload
-(put 'allout-old-style-prefixes 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-old-style-prefixes 'safe-local-variable 'booleanp)
;;;_ = allout-stylish-prefixes -- alternating bullets
(defcustom allout-stylish-prefixes t
"Do fancy stuff with topic prefix bullets according to level, etc.
@@ -711,8 +708,7 @@ is non-nil."
:group 'allout)
(make-variable-buffer-local 'allout-stylish-prefixes)
;;;###autoload
-(put 'allout-stylish-prefixes 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-stylish-prefixes 'safe-local-variable 'booleanp)
;;;_ = allout-numbered-bullet
(defcustom allout-numbered-bullet "#"
@@ -726,10 +722,7 @@ disables numbering maintenance."
:group 'allout)
(make-variable-buffer-local 'allout-numbered-bullet)
;;;###autoload
-(put 'allout-numbered-bullet 'safe-local-variable
- (if (fboundp 'string-or-null-p)
- 'string-or-null-p
- (lambda (x) (or (stringp x) (null x)))))
+(put 'allout-numbered-bullet 'safe-local-variable 'string-or-null-p)
;;;_ = allout-file-xref-bullet
(defcustom allout-file-xref-bullet "@"
"Bullet signifying file cross-references, for `allout-resolve-xref'.
@@ -738,10 +731,7 @@ Set this var to the bullet you want to use for file
cross-references."
:type '(choice (const nil) string)
:group 'allout)
;;;###autoload
-(put 'allout-file-xref-bullet 'safe-local-variable
- (if (fboundp 'string-or-null-p)
- 'string-or-null-p
- (lambda (x) (or (stringp x) (null x)))))
+(put 'allout-file-xref-bullet 'safe-local-variable 'string-or-null-p)
;;;_ = allout-presentation-padding
(defcustom allout-presentation-padding 2
"Presentation-format white-space padding factor, for greater indent."
@@ -2484,20 +2474,16 @@ Outermost is first."
(allout-back-to-current-heading)
(allout-end-of-current-line))
(t
- (if (not (allout-mark-active-p))
+ (if (not mark-active)
(push-mark))
(allout-end-of-entry))))))
+
;;;_ > allout-mark-active-p ()
(defun allout-mark-active-p ()
"True if the mark is currently or always active."
- ;; `(cond (boundp...))' (or `(if ...)') invokes special byte-compiler
- ;; provisions, at least in GNU Emacs to prevent warnings about lack of,
- ;; eg, region-active-p.
- (cond ((boundp 'mark-active)
- mark-active)
- ((fboundp 'region-active-p)
- (region-active-p))
- (t)))
+ (declare (obsolete nil "28.1"))
+ mark-active)
+
;;;_ > allout-next-heading ()
(defsubst allout-next-heading ()
"Move to the heading for the topic (possibly invisible) after this one.
@@ -5452,11 +5438,9 @@ header and body. The elements of that list are:
(cdr format)))))))
;; Put the list with first at front, to last at back:
(nreverse result))))
-;;;_ > allout-region-active-p ()
-(defmacro allout-region-active-p ()
- (cond ((fboundp 'use-region-p) '(use-region-p))
- ((fboundp 'region-active-p) '(region-active-p))
- (t 'mark-active)))
+
+(define-obsolete-function-alias 'allout-region-active-p 'region-active-p
"28.1")
+
;;_ > allout-process-exposed (&optional func from to frombuf
;;; tobuf format)
(defun allout-process-exposed (&optional func from to frombuf tobuf
@@ -5489,7 +5473,7 @@ Defaults:
; defaulting if necessary:
(if (not func) (setq func 'allout-insert-listified))
(if (not (and from to))
- (if (allout-region-active-p)
+ (if (region-active-p)
(setq from (region-beginning) to (region-end))
(setq from (point-min) to (point-max))))
(if frombuf
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 2566d44..6d8c784 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -543,6 +543,20 @@ will be buffer-local when set."
(and (local-variable-if-set-p symbol)
(get symbol 'variable-documentation)))))
+;;;###autoload
+(defun apropos-function (pattern)
+ "Show functions that match PATTERN.
+
+PATTERN can be a word, a list of words (separated by spaces),
+or a regexp (using some regexp special characters). If it is a word,
+search for matches for that word as a substring. If it is a list of words,
+search for matches for any two (or more) of those words.
+
+This is the same as running `apropos-command' with a \\[universal-argument]
prefix,
+or a non-nil `apropos-do-all' argument."
+ (interactive (list (apropos-read-pattern "function")))
+ (apropos-command pattern t))
+
;; For auld lang syne:
;;;###autoload
(defalias 'command-apropos 'apropos-command)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index fb293ad..36a361c 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -200,6 +200,7 @@ A non-nil value may result in truncated bookmark names."
(define-key map "f" 'bookmark-insert-location) ;"f"ind
(define-key map "r" 'bookmark-rename)
(define-key map "d" 'bookmark-delete)
+ (define-key map "D" 'bookmark-delete-all)
(define-key map "l" 'bookmark-load)
(define-key map "w" 'bookmark-write)
(define-key map "s" 'bookmark-save)
@@ -1374,6 +1375,23 @@ probably because we were called from there."
(bookmark-save)))
+;;;###autoload
+(defun bookmark-delete-all (&optional no-confirm)
+ "Permanently delete all bookmarks.
+If optional argument NO-CONFIRM is non-nil, don't ask for
+confirmation."
+ (interactive "P")
+ (when (or no-confirm
+ (yes-or-no-p "Permanently delete all bookmarks? "))
+ (bookmark-maybe-load-default-file)
+ (setq bookmark-alist-modification-count
+ (+ bookmark-alist-modification-count (length bookmark-alist)))
+ (setq bookmark-alist nil)
+ (bookmark-bmenu-surreptitiously-rebuild-list)
+ (when (bookmark-time-to-save-p)
+ (bookmark-save))))
+
+
(defun bookmark-time-to-save-p (&optional final-time)
"Return t if it is time to save bookmarks to disk, nil otherwise.
Optional argument FINAL-TIME means this is being called when Emacs
@@ -1600,12 +1618,15 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
(define-key map "\C-d" 'bookmark-bmenu-delete-backwards)
(define-key map "x" 'bookmark-bmenu-execute-deletions)
(define-key map "d" 'bookmark-bmenu-delete)
+ (define-key map "D" 'bookmark-bmenu-delete-all)
(define-key map " " 'next-line)
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
(define-key map "\177" 'bookmark-bmenu-backup-unmark)
(define-key map "u" 'bookmark-bmenu-unmark)
+ (define-key map "U" 'bookmark-bmenu-unmark-all)
(define-key map "m" 'bookmark-bmenu-mark)
+ (define-key map "M" 'bookmark-bmenu-mark-all)
(define-key map "l" 'bookmark-bmenu-load)
(define-key map "r" 'bookmark-bmenu-rename)
(define-key map "R" 'bookmark-bmenu-relocate)
@@ -1627,8 +1648,10 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
["Select Marked Bookmarks" bookmark-bmenu-select t]
"---"
["Mark Bookmark" bookmark-bmenu-mark t]
+ ["Mark all Bookmarks" bookmark-bmenu-mark-all t]
["Unmark Bookmark" bookmark-bmenu-unmark t]
["Unmark Backwards" bookmark-bmenu-backup-unmark t]
+ ["Unmark all Bookmarks" bookmark-bmenu-unmark-all t]
["Toggle Display of Filenames" bookmark-bmenu-toggle-filenames t]
["Display Location of Bookmark" bookmark-bmenu-locate t]
"---"
@@ -1636,6 +1659,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
["Rename Bookmark" bookmark-bmenu-rename t]
["Relocate Bookmark's File" bookmark-bmenu-relocate t]
["Mark Bookmark for Deletion" bookmark-bmenu-delete t]
+ ["Mark all Bookmarks for Deletion" bookmark-bmenu-delete-all t]
["Delete Marked Bookmarks" bookmark-bmenu-execute-deletions t])
("Annotations"
["Show Annotation for Current Bookmark" bookmark-bmenu-show-annotation t]
@@ -1761,6 +1785,7 @@ Letters do not insert themselves; instead, they are
commands.
Bookmark names preceded by a \"*\" have annotations.
\\<bookmark-bmenu-mode-map>
\\[bookmark-bmenu-mark] -- mark bookmark to be displayed.
+\\[bookmark-bmenu-mark-all] -- mark all listed bookmarks to be displayed.
\\[bookmark-bmenu-select] -- select bookmark of line point is on.
Also show bookmarks marked using m in other windows.
\\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they
may obscure long bookmark names).
@@ -1777,13 +1802,15 @@ Bookmark names preceded by a \"*\" have annotations.
\\[bookmark-bmenu-relocate] -- relocate this bookmark's file (prompts for new
file).
\\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
\\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and
move up.
-\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with
`\\[bookmark-bmenu-delete]'.
+\\[bookmark-bmenu-delete-all] -- mark all listed bookmarks as to be deleted.
+\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with
`\\[bookmark-bmenu-delete]' or `\\[bookmark-bmenu-delete-all]'.
\\[bookmark-bmenu-save] -- save the current bookmark list in the default file.
With a prefix arg, prompts for a file to save in.
\\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.)
\\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line.
With prefix argument, also move up one line.
\\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks.
+\\[bookmark-bmenu-unmark-all] -- remove all kinds of marks from all listed
bookmarks.
\\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for
the current bookmark
in another buffer.
\\[bookmark-bmenu-show-all-annotations] -- show the annotations of all
bookmarks in another buffer.
@@ -1950,9 +1977,23 @@ If the annotation does not exist, do nothing."
(bookmark-bmenu-ensure-position))))
+(defun bookmark-bmenu-mark-all ()
+ "Mark all listed bookmarks to be displayed by
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (with-buffer-modified-unmodified
+ (let ((inhibit-read-only t))
+ (while (not (eobp))
+ (delete-char 1)
+ (insert ?>)
+ (forward-line 1))))))
+
+
(defun bookmark-bmenu-select ()
"Select this line's bookmark; also display bookmarks marked with `>'.
-You can mark bookmarks with the
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] command."
+You can mark bookmarks with the
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] or
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark-all] commands."
(interactive)
(let ((bmrk (bookmark-bmenu-bookmark))
(menu (current-buffer))
@@ -2121,6 +2162,20 @@ Optional BACKUP means move up."
(bookmark-bmenu-ensure-position))
+(defun bookmark-bmenu-unmark-all ()
+ "Cancel all requested operations on all listed bookmarks."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (with-buffer-modified-unmodified
+ (let ((inhibit-read-only t))
+ (while (not (eobp))
+ (delete-char 1)
+ (insert " ")
+ (forward-line 1))))))
+
+
(defun bookmark-bmenu-delete ()
"Mark bookmark on this line to be deleted.
To carry out the deletions that you've marked, use
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
@@ -2146,6 +2201,22 @@ To carry out the deletions that you've marked, use
\\<bookmark-bmenu-mode-map>\\
(bookmark-bmenu-ensure-position))
+(defun bookmark-bmenu-delete-all ()
+ "Mark all listed bookmarks as to be deleted.
+To remove all deletion marks, use
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-unmark-all].
+To carry out the deletions that you've marked, use
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (with-buffer-modified-unmodified
+ (let ((inhibit-read-only t))
+ (while (not (eobp))
+ (delete-char 1)
+ (insert ?D)
+ (forward-line 1))))))
+
+
(defun bookmark-bmenu-execute-deletions ()
"Delete bookmarks flagged `D'."
(interactive)
@@ -2305,6 +2376,9 @@ strings returned are not."
(bindings--define-key map [delete]
'(menu-item "Delete Bookmark..." bookmark-delete
:help "Delete a bookmark from the bookmark list"))
+ (bindings--define-key map [delete-all]
+ '(menu-item "Delete all Bookmarks..." bookmark-delete-all
+ :help "Delete all bookmarks from the bookmark list"))
(bindings--define-key map [rename]
'(menu-item "Rename Bookmark..." bookmark-rename
:help "Change the name of a bookmark"))
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index f5150ca..690aaf2 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -150,34 +150,16 @@
;; otherwise it just parses the yanked string.
;; Modified to use Emacs 19 extended concept of kill-ring. -- daveg 12/15/96
;;;###autoload
-(defun calc-yank (radix)
- "Yank a value into the Calculator buffer.
-
-Valid numeric prefixes for RADIX: 0, 2, 6, 8
-No radix notation is prepended for any other numeric prefix.
-
-If RADIX is 2, prepend \"2#\" - Binary.
-If RADIX is 8, prepend \"8#\" - Octal.
-If RADIX is 0, prepend \"10#\" - Decimal.
-If RADIX is 6, prepend \"16#\" - Hexadecimal.
+(defun calc-yank-internal (radix thing-raw)
+ "Internal common implementation for yank functions.
-If RADIX is a non-nil list (created using \\[universal-argument]), the user
-will be prompted to enter the radix in the minibuffer.
-
-If RADIX is nil or if the yanked string already has a calc radix prefix, the
-yanked string will be passed on directly to the Calculator buffer without any
-alteration."
- (interactive "P")
+This function is used by both `calc-yank' and `calc-yank-mouse-primary'."
(calc-wrapper
(calc-pop-push-record-list
0 "yank"
(let* (radix-num
radix-notation
valid-num-regexp
- (thing-raw
- (if (fboundp 'current-kill)
- (current-kill 0 t)
- (car kill-ring-yank-pointer)))
(thing
(if (or (null radix)
;; Match examples: -2#10, 10\n(10#10,01)
@@ -232,6 +214,38 @@ alteration."
val))
val))))))))
+;;;###autoload
+(defun calc-yank-mouse-primary (radix)
+ "Yank the current primary selection into the Calculator buffer.
+See `calc-yank' for details about RADIX."
+ (interactive "P")
+ (if (or select-enable-primary
+ select-enable-clipboard)
+ (calc-yank-internal radix (gui-get-primary-selection))
+ ;; Yank from the kill ring.
+ (calc-yank radix)))
+
+;;;###autoload
+(defun calc-yank (radix)
+ "Yank a value into the Calculator buffer.
+
+Valid numeric prefixes for RADIX: 0, 2, 6, 8
+No radix notation is prepended for any other numeric prefix.
+
+If RADIX is 2, prepend \"2#\" - Binary.
+If RADIX is 8, prepend \"8#\" - Octal.
+If RADIX is 0, prepend \"10#\" - Decimal.
+If RADIX is 6, prepend \"16#\" - Hexadecimal.
+
+If RADIX is a non-nil list (created using \\[universal-argument]), the user
+will be prompted to enter the radix in the minibuffer.
+
+If RADIX is nil or if the yanked string already has a calc radix prefix, the
+yanked string will be passed on directly to the Calculator buffer without any
+alteration."
+ (interactive "P")
+ (calc-yank-internal radix (current-kill 0 t)))
+
;;; The Calc set- and get-register commands are modified versions of functions
;;; in register.el
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 09b4962..fb1287b 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1087,8 +1087,26 @@ Used by `calc-user-invocation'.")
(append (where-is-internal 'delete-backward-char global-map)
(where-is-internal 'backward-delete-char global-map)
(where-is-internal 'backward-delete-char-untabify global-map)
- '("\C-d"))
- '("\177" "\C-d")))
+ '("\177"))
+ '("\177")))
+
+(mapc (lambda (x)
+ (ignore-errors
+ (define-key calc-digit-map x 'calcDigit-delchar)
+ (define-key calc-mode-map x 'calc-pop)
+ (define-key calc-mode-map
+ (if (and (vectorp x) (featurep 'xemacs))
+ (if (= (length x) 1)
+ (vector (if (consp (aref x 0))
+ (cons 'meta (aref x 0))
+ (list 'meta (aref x 0))))
+ "\e\C-d")
+ (vconcat "\e" x))
+ 'calc-pop-above)))
+ (if calc-scan-for-dels
+ (append (where-is-internal 'delete-forward-char global-map)
+ '("\C-d"))
+ '("\C-d")))
(defvar calc-dispatch-map
(let ((map (make-keymap)))
@@ -2343,7 +2361,6 @@ the United States."
(defun calcDigit-key ()
(interactive)
- (goto-char (point-max))
(if (or (and (memq last-command-event '(?+ ?-))
(> (buffer-size) 0)
(/= (preceding-char) ?e))
@@ -2386,8 +2403,7 @@ the United States."
(delete-char 1))
(if (looking-at "-")
(delete-char 1)
- (insert "-")))
- (goto-char (point-max)))
+ (insert "-"))))
((eq last-command-event ?p)
(if (or (calc-minibuffer-contains ".*\\+/-.*")
(calc-minibuffer-contains ".*mod.*")
@@ -2440,17 +2456,9 @@ the United States."
(setq calc-prev-prev-char calc-prev-char
calc-prev-char last-command-event))
-
(defun calcDigit-backspace ()
(interactive)
- (goto-char (point-max))
- (cond ((calc-minibuffer-contains ".* \\+/- \\'")
- (backward-delete-char 5))
- ((calc-minibuffer-contains ".* mod \\'")
- (backward-delete-char 5))
- ((calc-minibuffer-contains ".* \\'")
- (backward-delete-char 2))
- ((eq last-command 'calcDigit-start)
+ (cond ((eq last-command 'calcDigit-start)
(erase-buffer))
(t (backward-delete-char 1)))
(if (= (calc-minibuffer-size) 0)
@@ -2925,6 +2933,20 @@ the United States."
(- (- (nth 2 a) (nth 2 b)) ldiff))))
+(defun calcDigit-delchar ()
+ (interactive)
+ (cond ((looking-at-p " \\+/- \\'")
+ (delete-char 5))
+ ((looking-at-p " mod \\'")
+ (delete-char 5))
+ ((looking-at-p " \\'")
+ (delete-char 2))
+ ((eq last-command 'calcDigit-start)
+ (erase-buffer))
+ (t (unless (eobp) (delete-char 1))))
+ (when (= (calc-minibuffer-size) 0)
+ (setq last-command-event 13)
+ (calcDigit-nondigit)))
(defvar math-comp-selected)
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index af6acaf..05768e1 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -350,7 +350,7 @@ If the locale never uses daylight saving time, set this to
0."
:group 'calendar-dst)
(defcustom calendar-standard-time-zone-name
- (if calendar-use-numeric-time-zones
+ (if (eq calendar-time-zone-style 'numeric)
(if calendar-current-time-zone-cache
(format-time-string
"%z" 0 (* 60 (car calendar-current-time-zone-cache)))
@@ -360,10 +360,11 @@ If the locale never uses daylight saving time, set this
to 0."
For example, \"EST\" in New York City, \"PST\" for Los Angeles."
:type 'string
:version "28.1"
+ :set-after '(calendar-time-zone-style)
:group 'calendar-dst)
(defcustom calendar-daylight-time-zone-name
- (if calendar-use-numeric-time-zones
+ (if (eq calendar-time-zone-style 'numeric)
(if calendar-current-time-zone-cache
(format-time-string
"%z" 0 (* 60 (cadr calendar-current-time-zone-cache)))
@@ -373,6 +374,7 @@ For example, \"EST\" in New York City, \"PST\" for Los
Angeles."
For example, \"EDT\" in New York City, \"PDT\" for Los Angeles."
:type 'string
:version "28.1"
+ :set-after '(calendar-time-zone-style)
:group 'calendar-dst)
(defcustom calendar-daylight-savings-starts-time
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 0efb2bc..5742614 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1061,10 +1061,12 @@ calendar."
:type 'boolean
:group 'holidays)
-(defcustom calendar-use-numeric-time-zones nil
- "If nil, use symbolic time zones like \"CET\" when displaying dates.
-If non-nil, use numeric time zones like \"+0100\"."
- :type 'boolean
+;; fixme should have a :set that changes calendar-standard-time-zone-name etc.
+(defcustom calendar-time-zone-style 'symbolic
+ "Your preferred style for time zones.
+If 'numeric, use numeric time zones like \"+0100\".
+Otherwise, use symbolic time zones like \"CET\"."
+ :type '(choice (const numeric) (other symbolic))
:version "28.1"
:group 'calendar)
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 635bdd8..05bb316 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -840,8 +840,8 @@ This function is suitable for execution in an init file."
(calendar-standard-time-zone-name
(if (< arg 16) calendar-standard-time-zone-name
(cond ((zerop calendar-time-zone)
- (if calendar-use-numeric-time-zones
- "+0100" "UTC"))
+ (if (eq calendar-time-zone-style 'numeric)
+ "+0000" "UTC"))
((< calendar-time-zone 0)
(format "UTC%dmin" calendar-time-zone))
(t (format "UTC+%dmin" calendar-time-zone)))))
@@ -1016,7 +1016,7 @@ Requires floating point."
(calendar-standard-time-zone-name
(cond
(calendar-time-zone calendar-standard-time-zone-name)
- (calendar-use-numeric-time-zones "+0100")
+ ((eq calendar-time-zone-style 'numeric) "+0000")
(t "UTC")))
(calendar-daylight-savings-starts
(if calendar-time-zone calendar-daylight-savings-starts))
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index 7a1273d..e347c99 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -68,13 +68,11 @@
;; Since Emacs 22 major mode functions should use `run-mode-hooks' to
;; run major mode hooks.
-(defalias 'semantic-run-mode-hooks
- (if (fboundp 'run-mode-hooks)
- 'run-mode-hooks
- 'run-hooks))
+(define-obsolete-function-alias 'semantic-run-mode-hooks 'run-mode-hooks
"28.1")
- ;; Fancy compat usage now handled in cedet-compat
-(defalias 'semantic-subst-char-in-string 'subst-char-in-string)
+;; Fancy compat usage now handled in cedet-compat
+(define-obsolete-function-alias 'semantic-subst-char-in-string
+ 'subst-char-in-string "28.1")
(defun semantic-delete-overlay-maybe (overlay)
"Delete OVERLAY if it is a semantic token overlay."
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 1ed1833..6cd4832 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -1251,6 +1251,7 @@ common grammar menu."
"Setup an XEmacs grammar menu in variable SYMBOL.
MODE-MENU is an optional specific menu whose items are appended to the
common grammar menu."
+ (declare (obsolete nil "28.1"))
(let ((items (make-symbol "items"))
(path (make-symbol "path")))
`(progn
diff --git a/lisp/comint.el b/lisp/comint.el
index 4b3b583..c3cb439 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -249,6 +249,10 @@ to set this in a mode hook, rather than customize the
default value."
file)
:group 'comint)
+(defvar comint-input-ring-file-prefix nil
+ "The prefix to skip when parsing the input ring file.
+This is useful in Zsh when the extended_history option is on.")
+
(defcustom comint-scroll-to-bottom-on-input nil
"Controls whether input to interpreter causes window to scroll.
If nil, then do not scroll. If t or `all', scroll all windows showing buffer.
@@ -731,7 +735,7 @@ contents are sent to the process as its initial input.
If PROGRAM is a string, any more args are arguments to PROGRAM.
Return the (possibly newly created) process buffer."
- (or (fboundp 'start-file-process)
+ (or (fboundp 'make-process)
(error "Multi-processing is not supported for this system"))
(setq buffer (get-buffer-create (or buffer (concat "*" name "*"))))
;; If no process, or nuked process, crank up a new one and put buffer in
@@ -987,8 +991,20 @@ See also `comint-input-ignoredups' and
`comint-write-input-ring'."
(setq end (match-beginning 0)))
(setq start
(if (re-search-backward ring-separator nil t)
- (match-end 0)
- (point-min)))
+ (progn
+ (when (and comint-input-ring-file-prefix
+ (looking-at
+ comint-input-ring-file-prefix))
+ ;; Skip zsh extended_history stamps
+ (goto-char (match-end 0)))
+ (match-end 0))
+ (progn
+ (goto-char (point-min))
+ (when (and comint-input-ring-file-prefix
+ (looking-at
+ comint-input-ring-file-prefix))
+ (goto-char (match-end 0)))
+ (point))))
(setq history (buffer-substring start end))
(goto-char start)
(when (and (not (string-match history-ignore history))
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 84d8c36..c197ed0 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -688,7 +688,7 @@ are executed in the background on each file sequentially
waiting
for each command to terminate before running the next command.
In shell syntax this means separating the individual commands with `;'.
-The output appears in the buffer `shell-command-buffer-name-async'."
+The output appears in the buffer named by `shell-command-buffer-name-async'."
(interactive
(let ((files (dired-get-marked-files t current-prefix-arg nil nil t)))
(list
@@ -726,16 +726,16 @@ it, write `*\"\"' in place of just `*'. This is
equivalent to just
`*' in the shell, but avoids Dired's special handling.
If COMMAND ends in `&', `;', or `;&', it is executed in the
-background asynchronously, and the output appears in the buffer
-`shell-command-buffer-name-async'. When operating on multiple files and
COMMAND
-ends in `&', the shell command is executed on each file in parallel.
-However, when COMMAND ends in `;' or `;&' then commands are executed
-in the background on each file sequentially waiting for each command
-to terminate before running the next command. You can also use
-`dired-do-async-shell-command' that automatically adds `&'.
+background asynchronously, and the output appears in the buffer named
+by `shell-command-buffer-name-async'. When operating on multiple files
+and COMMAND ends in `&', the shell command is executed on each file
+in parallel. However, when COMMAND ends in `;' or `;&', then commands
+are executed in the background on each file sequentially waiting for
+each command to terminate before running the next command. You can
+also use `dired-do-async-shell-command' that automatically adds `&'.
Otherwise, COMMAND is executed synchronously, and the output
-appears in the buffer `shell-command-buffer-name'.
+appears in the buffer named by `shell-command-buffer-name'.
This feature does not try to redisplay Dired buffers afterward, as
there's no telling what files COMMAND may have changed.
@@ -1604,7 +1604,7 @@ Special value `always' suppresses confirmation."
(defun dired-copy-file (from to ok-flag)
(dired-handle-overwrite to)
(dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t
- dired-recursive-copies))
+ dired-recursive-copies dired-copy-dereference))
(declare-function make-symbolic-link "fileio.c")
@@ -1627,7 +1627,8 @@ If `ask', ask for user confirmation."
(dired-create-directory dir))))
(defun dired-copy-file-recursive (from to ok-flag &optional
- preserve-time top recursive)
+ preserve-time top recursive
+ dereference)
(when (and (eq t (file-attribute-type (file-attributes from)))
(file-in-directory-p to from))
(error "Cannot copy `%s' into its subdirectory `%s'" from to))
@@ -1639,7 +1640,8 @@ If `ask', ask for user confirmation."
(copy-directory from to preserve-time)
(or top (dired-handle-overwrite to))
(condition-case err
- (if (stringp (file-attribute-type attrs))
+ (if (and (not dereference)
+ (stringp (file-attribute-type attrs)))
;; It is a symlink
(make-symbolic-link (file-attribute-type attrs) to ok-flag)
(dired-maybe-create-dirs (file-name-directory to))
@@ -2165,6 +2167,9 @@ See HOW-TO argument for `dired-do-create-files'.")
;;;###autoload
(defun dired-do-copy (&optional arg)
"Copy all marked (or next ARG) files, or copy the current file.
+ARG has to be numeric for above functionality. See
+`dired-get-marked-files' for more details.
+
When operating on just the current file, prompt for the new name.
When operating on multiple or marked files, prompt for a target
@@ -2178,10 +2183,18 @@ If `dired-copy-preserve-time' is non-nil, this command
preserves
the modification time of each old file in the copy, similar to
the \"-p\" option for the \"cp\" shell command.
-This command copies symbolic links by creating new ones, similar
-to the \"-d\" option for the \"cp\" shell command."
+This command copies symbolic links by creating new ones,
+similar to the \"-d\" option for the \"cp\" shell command.
+But if `dired-copy-dereference' is non-nil, the symbolic
+links are dereferenced and then copied, similar to the \"-L\"
+option for the \"cp\" shell command. If ARG is a cons with
+element 4 (`\\[universal-argument]'), the inverted value of
+`dired-copy-dereference' will be used."
(interactive "P")
- (let ((dired-recursive-copies dired-recursive-copies))
+ (let ((dired-recursive-copies dired-recursive-copies)
+ (dired-copy-dereference (if (equal arg '(4))
+ (not dired-copy-dereference)
+ dired-copy-dereference)))
(dired-do-create-files 'copy #'dired-copy-file
"Copy"
arg dired-keep-marker-copy
diff --git a/lisp/dired.el b/lisp/dired.el
index d19d6d1..77bb6cf 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -216,6 +216,12 @@ The target is used in the prompt for file copy, rename
etc."
:type 'boolean
:group 'dired)
+(defcustom dired-copy-dereference nil
+ "If non-nil, Dired dereferences symlinks when copying them.
+This is similar to the \"-L\" option for the \"cp\" shell command."
+ :type 'boolean
+ :group 'dired)
+ ;
; These variables were deleted and the replacements are on files.el.
; We leave aliases behind for back-compatibility.
(define-obsolete-variable-alias 'dired-free-space-program
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 05eb0ac..592f1b6 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -1,4 +1,4 @@
-;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t
-*-
+;;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t
-*-
;; Copyright (C) 1991-1997, 2001-2020 Free Software Foundation, Inc.
@@ -606,9 +606,8 @@ Don't try to split prefixes that are already longer than
that.")
prefix file dropped)
nil))))
prefixes)))
- `(if (fboundp 'register-definition-prefixes)
- (register-definition-prefixes ,file ',(sort (delq nil strings)
- 'string<)))))))
+ `(register-definition-prefixes ,file ',(sort (delq nil strings)
+ 'string<))))))
(defun autoload--setup-output (otherbuf outbuf absfile load-name)
(let ((outbuf
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index e4b8007..1029b52 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1249,13 +1249,8 @@ checking of documentation strings.
;;; Subst utils
;;
-(defsubst checkdoc-run-hooks (hookvar &rest args)
- "Run hooks in HOOKVAR with ARGS."
- (if (fboundp 'run-hook-with-args-until-success)
- (apply #'run-hook-with-args-until-success hookvar args)
- ;; This method was similar to above. We ignore the warning
- ;; since we will use the above for future Emacs versions
- (apply #'run-hook-with-args hookvar args)))
+(define-obsolete-function-alias 'checkdoc-run-hooks
+ #'run-hook-with-args-until-success "28.1")
(defsubst checkdoc-create-common-verbs-regexp ()
"Rebuild the contents of `checkdoc-common-verbs-regexp'."
@@ -1873,7 +1868,7 @@ Replace with \"%s\"? " original replace)
;; and reliance on the Ispell program.
(checkdoc-ispell-docstring-engine e take-notes)
;; User supplied checks
- (save-excursion (checkdoc-run-hooks 'checkdoc-style-functions fp e))
+ (save-excursion (run-hook-with-args-until-success
'checkdoc-style-functions fp e))
;; Done!
)))
@@ -2384,7 +2379,7 @@ Code:, and others referenced in the style guide."
err
(or
;; Generic Full-file checks (should be comment related)
- (checkdoc-run-hooks 'checkdoc-comment-style-functions)
+ (run-hook-with-args-until-success 'checkdoc-comment-style-functions)
err))
;; Done with full file comment checks
err)))
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 19b3bd7..4825b5c 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -289,13 +289,13 @@ Otherwise work like `message'."
(or (window-in-direction 'above (minibuffer-window))
(minibuffer-selected-window)
(get-largest-window)))
- (when mode-line-format
- (unless (and (listp mode-line-format)
- (assq 'eldoc-mode-line-string mode-line-format))
+ (when (and mode-line-format
+ (not (and (listp mode-line-format)
+ (assq 'eldoc-mode-line-string
mode-line-format))))
(setq mode-line-format
(list "" '(eldoc-mode-line-string
(" " eldoc-mode-line-string " "))
- mode-line-format))))
+ mode-line-format)))
(setq eldoc-mode-line-string
(when (stringp format-string)
(apply #'format-message format-string args)))
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 043cf01..8c18557 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -482,7 +482,8 @@ is called as a function to find the defun's end."
(if (looking-at "\\s<\\|\n")
(forward-line 1))))))
(funcall end-of-defun-function)
- (funcall skip)
+ (when (<= arg 1)
+ (funcall skip))
(cond
((> arg 0)
;; Moving forward.
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index ca7fcaf..77f1b29 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -466,24 +466,7 @@
(assoc major-mode viper-emacs-state-modifier-alist)))
(cdr
(assoc major-mode viper-emacs-state-modifier-alist))
- viper-empty-keymap))
- ))
-
- ;; This var is not local in Emacs, so we make it local. It must be local
- ;; because although the stack of minor modes can be the same for all buffers,
- ;; the associated *keymaps* can be different. In Viper,
- ;; viper-vi-local-user-map, viper-insert-local-user-map, and others can have
- ;; different keymaps for different buffers. Also, the keymaps associated
- ;; with viper-vi/insert-state-modifier-minor-mode can be different.
- ;; ***This is needed only in case emulation-mode-map-alists is not defined.
- ;; In emacs with emulation-mode-map-alists, nothing needs to be done
- (unless
- (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (set (make-local-variable 'minor-mode-map-alist)
- (viper-append-filter-alist
- (append viper--intercept-key-maps viper--key-maps)
- minor-mode-map-alist)))
- )
+ viper-empty-keymap)))))
@@ -893,16 +876,7 @@ LOAD-FILE is the name of the file where the specific minor
mode is defined.
Suffixes such as .el or .elc should be stripped."
(interactive "sEnter name of the load file: ")
-
- (eval-after-load load-file '(viper-normalize-minor-mode-map-alist))
-
- ;; Change the default for minor-mode-map-alist each time a harnessed minor
- ;; mode adds its own keymap to the a-list.
- (unless
- (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (eval-after-load
- load-file '(setq-default minor-mode-map-alist minor-mode-map-alist)))
- )
+ (eval-after-load load-file '(viper-normalize-minor-mode-map-alist)))
(defun viper-ESC (arg)
@@ -4721,8 +4695,7 @@ Please, specify your level now: "))
(interactive "cViper register to point: ")
(let ((val (get-register char)))
(cond
- ((and (fboundp 'frame-configuration-p)
- (frame-configuration-p val))
+ ((frame-configuration-p val)
(set-frame-configuration val))
((window-configuration-p val)
(set-window-configuration val))
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 8e7a34f..59ca629 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -695,9 +695,6 @@ It also can't undo some Viper settings."
'mark-even-if-inactive viper-saved-non-viper-variables))
;; Ideally, we would like to be able to de-localize local variables
- (unless
- (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (viper-delocalize-var 'minor-mode-map-alist))
(viper-delocalize-var 'require-final-newline)
;; deactivate all advices done by Viper.
@@ -705,11 +702,9 @@ It also can't undo some Viper settings."
(setq viper-mode nil)
- (when (and (fboundp 'add-to-ordered-list) (boundp
'emulation-mode-map-alists))
- (setq emulation-mode-map-alists
- (delq 'viper--intercept-key-maps
- (delq 'viper--key-maps emulation-mode-map-alists))
- ))
+ (setq emulation-mode-map-alists
+ (delq 'viper--intercept-key-maps
+ (delq 'viper--key-maps emulation-mode-map-alists)))
(viper-delocalize-var 'viper-vi-minibuffer-minor-mode)
(viper-delocalize-var 'viper-insert-minibuffer-minor-mode)
@@ -943,13 +938,11 @@ Two differences:
(setq viper-vi-state-cursor-color color-name)))
- (when (and (fboundp 'add-to-ordered-list) (boundp
'emulation-mode-map-alists))
- ;; needs to be as early as possible
- (add-to-ordered-list
- 'emulation-mode-map-alists 'viper--intercept-key-maps 100)
- ;; needs to be after cua-mode
- (add-to-ordered-list 'emulation-mode-map-alists 'viper--key-maps 500)
- )
+ ;; needs to be as early as possible
+ (add-to-ordered-list
+ 'emulation-mode-map-alists 'viper--intercept-key-maps 100)
+ ;; needs to be after cua-mode
+ (add-to-ordered-list 'emulation-mode-map-alists 'viper--key-maps 500)
;; Emacs shell, ange-ftp, and comint-based modes
(add-hook 'comint-mode-hook #'viper-comint-mode-hook) ; comint
@@ -1062,10 +1055,7 @@ This may be needed if the previous `:map' command
terminated abnormally."
(viper--advice-add 'add-minor-mode :after
(lambda (&rest _)
"Run viper-normalize-minor-mode-map-alist after adding a minor mode."
- (viper-normalize-minor-mode-map-alist)
- (unless
- (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (setq-default minor-mode-map-alist minor-mode-map-alist))))
+ (viper-normalize-minor-mode-map-alist)))
;; catch frame switching event
(if (viper-window-display-p)
@@ -1253,12 +1243,7 @@ These two lines must come in the order given."))
;; Without setting the default, new buffers that come up in emacs mode have
;; minor-mode-map-alist = nil, unless we call viper-change-state-*
(when (eq viper-current-state 'emacs-state)
- (viper-change-state-to-emacs)
- (unless
- (and (fboundp 'add-to-ordered-list)
- (boundp 'emulation-mode-map-alists))
- (setq-default minor-mode-map-alist minor-mode-map-alist))
- )
+ (viper-change-state-to-emacs))
(if (this-major-mode-requires-vi-state major-mode)
(viper-mode))
diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el
index 9269ea9..4ff1ba3 100644
--- a/lisp/epa-dired.el
+++ b/lisp/epa-dired.el
@@ -1,4 +1,5 @@
;;; epa-dired.el --- the EasyPG Assistant, dired extension -*-
lexical-binding: t -*-
+
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index bbd9279..3b0cc84 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -1,4 +1,5 @@
;;; epa-file.el --- the EasyPG Assistant, transparent file encryption -*-
lexical-binding: t -*-
+
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -21,10 +22,13 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Dependencies
(require 'epa)
(require 'epa-hook)
+;;; Options
+
(defcustom epa-file-cache-passphrase-for-symmetric-encryption nil
"If non-nil, cache passphrase for symmetric encryption.
@@ -49,6 +53,8 @@ encryption is used."
(const :tag "Don't ask" silent))
:group 'epa-file)
+;;; Other
+
(defvar epa-file-passphrase-alist nil)
(defun epa-file-passphrase-callback-function (context key-id file)
@@ -72,6 +78,8 @@ encryption is used."
passphrase))))
(epa-passphrase-callback-function context key-id file)))
+;;; File Handler
+
(defvar epa-inhibit nil
"Non-nil means don't try to decrypt .gpg files when operating on them.")
@@ -311,6 +319,8 @@ If no one is selected, symmetric encryption will be
performed. "
(message "Wrote %s" buffer-file-name))))
(put 'write-region 'epa-file 'epa-file-write-region)
+;;; Commands
+
(defun epa-file-select-keys ()
"Select recipients for encryption."
(interactive)
diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el
index a86f23e..6f12f8a 100644
--- a/lisp/epa-hook.el
+++ b/lisp/epa-hook.el
@@ -1,4 +1,5 @@
;;; epa-hook.el --- preloaded code to enable epa-file.el -*- lexical-binding:
t -*-
+
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index 6347525..6e6c0a4 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -1,4 +1,5 @@
;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer -*-
lexical-binding: t -*-
+
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -21,10 +22,13 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Dependencies
(require 'epa)
(require 'mail-utils)
+;;; Local Mode
+
(defvar epa-mail-mode-map
(let ((keymap (make-sparse-keymap)))
(define-key keymap "\C-c\C-ed" 'epa-mail-decrypt)
@@ -50,6 +54,8 @@
"A minor-mode for composing encrypted/clearsigned mails."
nil " epa-mail" epa-mail-mode-map)
+;;; Utilities
+
(defun epa-mail--find-usable-key (keys usage)
"Find a usable key from KEYS for USAGE.
USAGE would be `sign' or `encrypt'."
@@ -64,6 +70,8 @@ USAGE would be `sign' or `encrypt'."
(setq pointer (cdr pointer))))
(setq keys (cdr keys)))))
+;;; Commands
+
;;;###autoload
(defun epa-mail-decrypt ()
"Decrypt OpenPGP armors in the current buffer.
@@ -241,6 +249,8 @@ The buffer is expected to contain a mail message."
(interactive)
(epa-import-armor-in-region (point-min) (point-max)))
+;;; Global Mode
+
;;;###autoload
(define-minor-mode epa-global-mail-mode
"Minor mode to hook EasyPG into Mail mode."
diff --git a/lisp/epa.el b/lisp/epa.el
index 3c7dd83..d190824 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -21,6 +21,7 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Dependencies
(require 'epg)
(require 'font-lock)
@@ -30,6 +31,8 @@
(require 'wid-edit))
(require 'derived)
+;;; Options
+
(defgroup epa nil
"The EasyPG Assistant"
:version "23.1"
@@ -73,6 +76,8 @@ The command `epa-mail-encrypt' uses this."
:group 'epa
:version "24.4")
+;;; Faces
+
(defgroup epa-faces nil
"Faces for epa-mode."
:version "23.1"
@@ -146,6 +151,8 @@ The command `epa-mail-encrypt' uses this."
:type '(repeat (cons symbol face))
:group 'epa-faces)
+;;; Variables
+
(defvar epa-font-lock-keywords
'(("^\\*"
(0 'epa-mark))
@@ -252,6 +259,8 @@ You should bind this variable with `let', but do not set it
globally.")
(defvar epa-exit-buffer-function #'quit-window)
+;;; Key Widget
+
(define-widget 'epa-key 'push-button
"Button for representing an epg-key object."
:format "%[%v%]"
@@ -293,6 +302,8 @@ You should bind this variable with `let', but do not set it
globally.")
(epg-sub-key-id (car (epg-key-sub-key-list
(widget-get widget :value))))))
+;;; Modes
+
(define-derived-mode epa-key-list-mode special-mode "EPA Keys"
"Major mode for `epa-list-keys'."
(buffer-disable-undo)
@@ -316,6 +327,9 @@ You should bind this variable with `let', but do not set it
globally.")
(setq truncate-lines t
buffer-read-only t))
+;;; Commands
+;;;; Marking
+
(defun epa-mark-key (&optional arg)
"Mark a key on the current line.
If ARG is non-nil, unmark the key."
@@ -338,11 +352,15 @@ If ARG is non-nil, mark the key."
(interactive "P")
(epa-mark-key (not arg)))
+;;;; Quitting
+
(defun epa-exit-buffer ()
"Exit the current buffer using `epa-exit-buffer-function'."
(interactive)
(funcall epa-exit-buffer-function))
+;;;; Listing and Selecting
+
(defun epa--insert-keys (keys)
(save-excursion
(save-restriction
@@ -505,6 +523,8 @@ If SECRET is non-nil, list secret keys instead of public
keys."
(let ((keys (epg-list-keys context names secret)))
(epa--select-keys prompt keys)))
+;;;; Key Details
+
(defun epa-show-key ()
"Show a key on the current line."
(interactive)
@@ -591,6 +611,8 @@ If SECRET is non-nil, list secret keys instead of public
keys."
(goto-char (point-min))
(pop-to-buffer (current-buffer))))
+;;;; Encryption and Signatures
+
(defun epa-display-info (info)
(if epa-popup-info-window
(save-selected-window
@@ -1105,16 +1127,7 @@ If no one is selected, default secret key is used. "
'start-open t
'end-open t)))))
-(defalias 'epa--derived-mode-p
- (if (fboundp 'derived-mode-p)
- #'derived-mode-p
- (lambda (&rest modes)
- "Non-nil if the current major mode is derived from one of MODES.
-Uses the `derived-mode-parent' property of the symbol to trace backwards."
- (let ((parent major-mode))
- (while (and (not (memq parent modes))
- (setq parent (get parent 'derived-mode-parent))))
- parent))))
+(define-obsolete-function-alias 'epa--derived-mode-p 'derived-mode-p "28.1")
;;;###autoload
(defun epa-encrypt-region (start end recipients sign signers)
@@ -1191,6 +1204,8 @@ If no one is selected, symmetric encryption will be
performed. ")
'start-open t
'end-open t)))))
+;;;; Key Management
+
;;;###autoload
(defun epa-delete-keys (keys &optional allow-secret)
"Delete selected KEYS."
@@ -1227,7 +1242,7 @@ If no one is selected, symmetric encryption will be
performed. ")
(if (epg-context-result-for context 'import)
(epa-display-info (epg-import-result-to-string
(epg-context-result-for context 'import))))
- ;; FIXME: Why not use the (otherwise unused) epa--derived-mode-p?
+ ;; FIXME: Why not use the derived-mode-p?
(if (eq major-mode 'epa-key-list-mode)
(apply #'epa--list-keys epa-list-keys-arguments))))
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index 1c42924..9f0c7e4 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -22,6 +22,7 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Prelude
(eval-when-compile (require 'cl-lib))
@@ -34,6 +35,8 @@
(define-obsolete-variable-alias 'epg-bug-report-address
'report-emacs-bug-address "27.1")
+;;; Options
+
(defgroup epg ()
"Interface to the GNU Privacy Guard (GnuPG)."
:tag "EasyPG"
@@ -106,6 +109,8 @@ through the minibuffer, instead of external Pinentry
program."
Note that the buffer name starts with a space."
:type 'boolean)
+;;; Constants
+
(defconst epg-gpg-minimum-version "1.4.3")
(defconst epg-gpg2-minimum-version "2.1.6")
@@ -133,6 +138,8 @@ The first element of each entry is protocol symbol, which is
either `OpenPGP' or `CMS'. The second element is a function
which constructs a configuration object (actually a plist).")
+;;; "Configuration"
+
(defvar epg--configurations nil)
;;;###autoload
diff --git a/lisp/epg.el b/lisp/epg.el
index 5b90bc2..96af3ad 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1,4 +1,5 @@
;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*-
+
;; Copyright (C) 1999-2000, 2002-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -21,10 +22,15 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Prelude
(require 'epg-config)
(eval-when-compile (require 'cl-lib))
+(define-error 'epg-error "GPG error")
+
+;;; Variables
+
(defvar epg-user-id nil
"GnuPG ID of your default identity.")
@@ -41,6 +47,8 @@
(defvar epg-agent-file nil)
(defvar epg-agent-mtime nil)
+;;; Enums
+
;; from gnupg/common/openpgpdefs.h
(defconst epg-cipher-algorithm-alist
'((0 . "NONE")
@@ -123,7 +131,7 @@
(defconst epg-no-data-reason-alist
'((1 . "No armored data")
- (2 . "Expected a packet but did not found one")
+ (2 . "Expected a packet but did not find one")
(3 . "Invalid packet found, this may indicate a non OpenPGP message")
(4 . "Signature expected but not found")))
@@ -169,7 +177,8 @@
(defvar epg-prompt-alist nil)
-(define-error 'epg-error "GPG error")
+;;; Structs
+;;;; Data Struct
(cl-defstruct (epg-data
(:constructor nil)
@@ -180,6 +189,8 @@
(file nil :read-only t)
(string nil :read-only t))
+;;;; Context Struct
+
(cl-defstruct (epg-context
(:constructor nil)
(:constructor epg-context--make
@@ -218,6 +229,8 @@
(error-output "")
error-buffer)
+;;;; Context Methods
+
;; This is not an alias, just so we can mark it as autoloaded.
;;;###autoload
(defun epg-make-context (&optional protocol armor textmode include-certs
@@ -281,6 +294,8 @@ callback data (if any)."
(declare (obsolete setf "25.1"))
(setf (epg-context-signers context) signers))
+;;;; Other Structs
+
(cl-defstruct (epg-signature
(:constructor nil)
(:constructor epg-make-signature
@@ -385,6 +400,8 @@ callback data (if any)."
secret-unchanged not-imported
imports)
+;;; Functions
+
(defun epg-context-result-for (context name)
"Return the result of CONTEXT associated with NAME."
(cdr (assq name (epg-context-result context))))
@@ -404,37 +421,28 @@ callback data (if any)."
(pubkey-algorithm (epg-signature-pubkey-algorithm signature))
(key-id (epg-signature-key-id signature)))
(concat
- (cond ((eq (epg-signature-status signature) 'good)
- "Good signature from ")
- ((eq (epg-signature-status signature) 'bad)
- "Bad signature from ")
- ((eq (epg-signature-status signature) 'expired)
- "Expired signature from ")
- ((eq (epg-signature-status signature) 'expired-key)
- "Signature made by expired key ")
- ((eq (epg-signature-status signature) 'revoked-key)
- "Signature made by revoked key ")
- ((eq (epg-signature-status signature) 'no-pubkey)
- "No public key for "))
+ (cl-case (epg-signature-status signature)
+ (good "Good signature from ")
+ (bad "Bad signature from ")
+ (expired "Expired signature from ")
+ (expired-key "Signature made by expired key ")
+ (revoked-key "Signature made by revoked key ")
+ (no-pubkey "No public key for "))
key-id
- (if user-id
- (concat " "
- (if (stringp user-id)
- (epg--decode-percent-escape-as-utf-8 user-id)
- (epg-decode-dn user-id)))
- "")
- (if (epg-signature-validity signature)
- (format " (trust %s)" (epg-signature-validity signature))
- "")
- (if (epg-signature-creation-time signature)
- (format-time-string " created at %Y-%m-%dT%T%z"
- (epg-signature-creation-time signature))
- "")
- (if pubkey-algorithm
- (concat " using "
- (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist))
- (format "(unknown algorithm %d)" pubkey-algorithm)))
- ""))))
+ (and user-id
+ (concat " "
+ (if (stringp user-id)
+ (epg--decode-percent-escape-as-utf-8 user-id)
+ (epg-decode-dn user-id))))
+ (and (epg-signature-validity signature)
+ (format " (trust %s)" (epg-signature-validity signature)))
+ (and (epg-signature-creation-time signature)
+ (format-time-string " created at %Y-%m-%dT%T%z"
+ (epg-signature-creation-time signature)))
+ (and pubkey-algorithm
+ (concat " using "
+ (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist))
+ (format "(unknown algorithm %d)" pubkey-algorithm)))))))
(defun epg-verify-result-to-string (verify-result)
"Convert VERIFY-RESULT to a human readable string."
@@ -859,6 +867,8 @@ callback data (if any)."
(format "Untrusted key %s %s. Use anyway? " key-id user-id))
"Use untrusted key anyway? ")))
+;;; Status Functions
+
(defun epg--status-GET_BOOL (context string)
(let (inhibit-quit)
(condition-case nil
@@ -1234,6 +1244,8 @@ callback data (if any)."
(epg-context-result-for context 'import-status)))
(epg-context-set-result-for context 'import-status nil)))
+;;; Functions
+
(defun epg-passphrase-callback-function (context key-id _handback)
(declare (obsolete epa-passphrase-callback-function "23.1"))
(if (eq key-id 'SYM)
@@ -1303,6 +1315,8 @@ callback data (if any)."
(if (aref line 6)
(epg--time-from-seconds (aref line 6)))))
+;;; Public Functions
+
(defun epg-list-keys (context &optional name mode)
"Return a list of epg-key objects matched with NAME.
If MODE is nil or `public', only public keyring should be searched.
@@ -2032,6 +2046,8 @@ If you are unsure, use synchronous version of this
function
(epg-errors-to-string errors))))))
(epg-reset context)))
+;;; Decode Functions
+
(defun epg--decode-percent-escape (string)
(setq string (encode-coding-string string 'raw-text))
(let ((index 0))
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 94d5de2..ff7a77f 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -232,6 +232,10 @@ The value `erc-interpret-controls-p' must also be t for
this to work."
"ERC bold face."
:group 'erc-faces)
+(defface erc-italic-face '((t :slant italic))
+ "ERC italic face."
+ :group 'erc-faces)
+
(defface erc-inverse-face
'((t :foreground "White" :background "Black"))
"ERC inverse face."
@@ -383,6 +387,7 @@ See `erc-interpret-controls-p' and
`erc-interpret-mirc-color' for options."
(erc-controls-strip s))
(erc-interpret-controls-p
(let ((boldp nil)
+ (italicp nil)
(inversep nil)
(underlinep nil)
(fg nil)
@@ -401,6 +406,8 @@ See `erc-interpret-controls-p' and
`erc-interpret-mirc-color' for options."
(setq bg bg-color))
((string= control "\C-b")
(setq boldp (not boldp)))
+ ((string= control "\C-]")
+ (setq italicp (not italicp)))
((string= control "\C-v")
(setq inversep (not inversep)))
((string= control "\C-_")
@@ -413,13 +420,14 @@ See `erc-interpret-controls-p' and
`erc-interpret-mirc-color' for options."
(ding)))
((string= control "\C-o")
(setq boldp nil
+ italicp nil
inversep nil
underlinep nil
fg nil
bg nil))
(t nil))
(erc-controls-propertize
- start end boldp inversep underlinep fg bg s)))
+ start end boldp italicp inversep underlinep fg bg s)))
s))
(t s)))))
@@ -432,13 +440,13 @@ See `erc-interpret-controls-p' and
`erc-interpret-mirc-color' for options."
s)))
(defvar erc-controls-remove-regexp
- "\C-b\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?"
+
"\C-b\\|\C-]\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?"
"Regular expression which matches control characters to remove.")
(defvar erc-controls-highlight-regexp
- (concat "\\(\C-b\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|"
+ (concat "\\(\C-b\\|\C-]\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|"
"\C-c\\([0-9][0-9]?\\)?\\(,\\([0-9][0-9]?\\)\\)?\\)"
- "\\([^\C-b\C-v\C-_\C-c\C-g\C-o\n]*\\)")
+ "\\([^\C-b\C-]\C-v\C-_\C-c\C-g\C-o\n]*\\)")
"Regular expression which matches control chars and the text to highlight.")
(defun erc-controls-highlight ()
@@ -451,6 +459,7 @@ Also see `erc-interpret-controls-p' and
`erc-interpret-mirc-color'."
(replace-match "")))
(erc-interpret-controls-p
(let ((boldp nil)
+ (italicp nil)
(inversep nil)
(underlinep nil)
(fg nil)
@@ -467,6 +476,8 @@ Also see `erc-interpret-controls-p' and
`erc-interpret-mirc-color'."
(setq bg bg-color))
((string= control "\C-b")
(setq boldp (not boldp)))
+ ((string= control "\C-]")
+ (setq italicp (not italicp)))
((string= control "\C-v")
(setq inversep (not inversep)))
((string= control "\C-_")
@@ -479,16 +490,17 @@ Also see `erc-interpret-controls-p' and
`erc-interpret-mirc-color'."
(ding)))
((string= control "\C-o")
(setq boldp nil
+ italicp nil
inversep nil
underlinep nil
fg nil
bg nil))
(t nil))
(erc-controls-propertize start end
- boldp inversep underlinep fg bg)))))
+ boldp italicp inversep underlinep fg
bg)))))
(t nil)))
-(defun erc-controls-propertize (from to boldp inversep underlinep fg bg
+(defun erc-controls-propertize (from to boldp italicp inversep underlinep fg bg
&optional str)
"Prepend properties from IRC control characters between FROM and TO.
If optional argument STR is provided, apply to STR, otherwise prepend
properties
@@ -500,6 +512,9 @@ to a region in the current buffer."
(append (if boldp
'(erc-bold-face)
nil)
+ (if italicp
+ '(erc-italic-face)
+ nil)
(if inversep
'(erc-inverse-face)
nil)
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el
index e4faf6b..79c1110 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -153,18 +153,20 @@ This function is run from `erc-nickserv-identified-hook'."
'erc-autojoin-channels-delayed
server nick (current-buffer))))
;; `erc-autojoin-timing' is `connect':
- (dolist (l erc-autojoin-channels-alist)
- (when (string-match (car l) server)
- (let ((server (or erc-session-server erc-server-announced-name)))
+ (let ((server (or erc-session-server erc-server-announced-name)))
+ (dolist (l erc-autojoin-channels-alist)
+ (when (string-match-p (car l) server)
(dolist (chan (cdr l))
- (let ((buffer (erc-get-buffer chan)))
- ;; Only auto-join the channels that we aren't already in
- ;; using a different nick.
+ (let ((buffer
+ (car (erc-buffer-filter
+ (lambda ()
+ (let ((current (erc-default-target)))
+ (and (stringp current)
+ (string-match-p (car l)
+ (or erc-session-server
erc-server-announced-name))
+ (string-equal (erc-downcase chan)
+ (erc-downcase current)))))))))
(when (or (not buffer)
- ;; If the same channel is joined on another
- ;; server the best-effort is to just join
- (not (string-match (car l)
- (process-name erc-server-process)))
(not (with-current-buffer buffer
(erc-server-process-alive))))
(erc-server-join-channel server chan))))))))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 404a4c0..41d7516 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1608,36 +1608,47 @@ symbol, it may have these values:
(defun erc-generate-new-buffer-name (server port target)
"Create a new buffer name based on the arguments."
(when (numberp port) (setq port (number-to-string port)))
- (let ((buf-name (or target
- (or (let ((name (concat server ":" port)))
- (when (> (length name) 1)
- name))
- ;; This fallback should in fact never happen
- "*erc-server-buffer*")))
- buffer-name)
+ (let* ((buf-name (or target
+ (let ((name (concat server ":" port)))
+ (when (> (length name) 1)
+ name))
+ ;; This fallback should in fact never happen.
+ "*erc-server-buffer*"))
+ (full-buf-name (concat buf-name "/" server))
+ (dup-buf-name (buffer-name (car (erc-channel-list nil))))
+ buffer-name)
;; Reuse existing buffers, but not if the buffer is a connected server
;; buffer and not if its associated with a different server than the
;; current ERC buffer.
- ;; if buf-name is taken by a different connection (or by something !erc)
- ;; then see if "buf-name/server" meets the same criteria
- (dolist (candidate (list buf-name (concat buf-name "/" server)))
- (if (and (not buffer-name)
- erc-reuse-buffers
- (or (not (get-buffer candidate))
- ;; Looking for a server buffer, so there's no target.
- (and (not target)
- (with-current-buffer (get-buffer candidate)
- (and (erc-server-buffer-p)
- (not (erc-server-process-alive)))))
- ;; Channel buffer; check that it's from the right server.
- (and target
- (with-current-buffer (get-buffer candidate)
- (and (string= erc-session-server server)
- (erc-port-equal erc-session-port port))))))
- (setq buffer-name candidate)))
- ;; if buffer-name is unset, neither candidate worked out for us,
+ ;; If buf-name is taken by a different connection (or by something !erc)
+ ;; then see if "buf-name/server" meets the same criteria.
+ (if (and dup-buf-name (string-match-p (concat buf-name "/") dup-buf-name))
+ (setq buffer-name full-buf-name) ; ERC buffer with full name already
exists.
+ (dolist (candidate (list buf-name full-buf-name))
+ (if (and (not buffer-name)
+ erc-reuse-buffers
+ (or (not (get-buffer candidate))
+ ;; Looking for a server buffer, so there's no target.
+ (and (not target)
+ (with-current-buffer (get-buffer candidate)
+ (and (erc-server-buffer-p)
+ (not (erc-server-process-alive)))))
+ ;; Channel buffer; check that it's from the right server.
+ (and target
+ (with-current-buffer (get-buffer candidate)
+ (and (string= erc-session-server server)
+ (erc-port-equal erc-session-port port))))))
+ (setq buffer-name candidate)
+ (when (and (not buffer-name) (get-buffer buf-name) erc-reuse-buffers)
+ ;; A new buffer will be created with the name buf-name/server,
rename
+ ;; the existing name-duplicated buffer with the same format as
well.
+ (with-current-buffer (get-buffer buf-name)
+ (when (derived-mode-p 'erc-mode) ; ensure it's an erc buffer
+ (rename-buffer
+ (concat buf-name "/" (or erc-session-server
erc-server-announced-name)))))))))
+ ;; If buffer-name is unset, neither candidate worked out for us,
;; fallback to the old <N> uniquification method:
- (or buffer-name (generate-new-buffer-name (concat buf-name "/" server)))))
+ (or buffer-name (generate-new-buffer-name full-buf-name))))
(defun erc-get-buffer-create (server port target)
"Create a new buffer based on the arguments."
@@ -3153,16 +3164,18 @@ were most recently invited. See also `invitation'."
(setq chnl (erc-ensure-channel-name channel)))
(when chnl
;; Prevent double joining of same channel on same server.
- (let ((joined-channels
- (mapcar #'(lambda (chanbuf)
- (with-current-buffer chanbuf (erc-default-target)))
- (erc-channel-list erc-server-process))))
- (if (erc-member-ignore-case chnl joined-channels)
- (switch-to-buffer (car (erc-member-ignore-case chnl
- joined-channels)))
- (let ((server (with-current-buffer (process-buffer erc-server-process)
- (or erc-session-server erc-server-announced-name))))
- (erc-server-join-channel server chnl key))))))
+ (let* ((joined-channels
+ (mapcar #'(lambda (chanbuf)
+ (with-current-buffer chanbuf (erc-default-target)))
+ (erc-channel-list erc-server-process)))
+ (server (with-current-buffer (process-buffer erc-server-process)
+ (or erc-session-server erc-server-announced-name)))
+ (chnl-name (car (erc-member-ignore-case chnl joined-channels))))
+ (if chnl-name
+ (switch-to-buffer (if (get-buffer chnl-name)
+ chnl-name
+ (concat chnl-name "/" server)))
+ (erc-server-join-channel server chnl key)))))
t)
(defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN)
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index d2c17fe..db1b258 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -295,7 +295,7 @@ See `eshell-needs-pipe'."
(process-environment (eshell-environment-variables))
proc decoding encoding changed)
(cond
- ((fboundp 'start-file-process)
+ ((fboundp 'make-process)
(setq proc
(let ((process-connection-type
(unless (eshell-needs-pipe-p command)
diff --git a/lisp/files.el b/lisp/files.el
index 1909669..9270f33 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -752,10 +752,16 @@ resulting list of directory names. For an empty path
element (i.e.,
a leading or trailing separator, or two adjacent separators), return
nil (meaning `default-directory') as the associated list element."
(when (stringp search-path)
- (mapcar (lambda (f)
- (if (equal "" f) nil
- (substitute-in-file-name (file-name-as-directory f))))
- (split-string search-path path-separator))))
+ (let ((spath (substitute-env-vars search-path)))
+ (mapcar (lambda (f)
+ (if (equal "" f) nil
+ (let ((dir (expand-file-name (file-name-as-directory f))))
+ ;; Previous implementation used `substitute-in-file-name'
+ ;; which collapse multiple "/" in front. Do the same for
+ ;; backward compatibility.
+ (if (string-match "\\`/+" dir)
+ (substring dir (1- (match-end 0))) dir))))
+ (split-string spath path-separator)))))
(defun cd-absolute (dir)
"Change current directory to given absolute file name DIR."
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 5cda4a6..c633877 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -51,7 +51,7 @@
;; also the variable `font-lock-maximum-size'. Support modes for Font Lock
;; mode can be used to speed up Font Lock mode. See `font-lock-support-mode'.
-;;; How Font Lock mode fontifies:
+;;;; How Font Lock mode fontifies:
;; When Font Lock mode is turned on in a buffer, it (a) fontifies the entire
;; buffer and (b) installs one of its fontification functions on one of the
@@ -96,7 +96,7 @@
;; some syntactic parsers for common languages and a son-of-font-lock.el could
;; use them rather then relying so heavily on the keyword (regexp) pass.
-;;; How Font Lock mode supports modes or is supported by modes:
+;;;; How Font Lock mode supports modes or is supported by modes:
;; Modes that support Font Lock mode do so by defining one or more variables
;; whose values specify the fontification. Font Lock mode knows of these
@@ -112,7 +112,7 @@
;; Font Lock mode fontification behavior can be modified in a number of ways.
;; See the below comments and the comments distributed throughout this file.
-;;; Constructing patterns:
+;;;; Constructing patterns:
;; See the documentation for the variable `font-lock-keywords'.
;;
@@ -120,7 +120,7 @@
;; `font-lock-syntactic-keywords' can be generated via the function
;; `regexp-opt'.
-;;; Adding patterns for modes that already support Font Lock:
+;;;; Adding patterns for modes that already support Font Lock:
;; Though Font Lock highlighting patterns already exist for many modes, it's
;; likely there's something that you want fontified that currently isn't, even
@@ -135,7 +135,7 @@
;; other variables. For example, additional C types can be specified via the
;; variable `c-font-lock-extra-types'.
-;;; Adding patterns for modes that do not support Font Lock:
+;;;; Adding patterns for modes that do not support Font Lock:
;; Not all modes support Font Lock mode. If you (as a user of the mode) add
;; patterns for a new mode, you must define in your ~/.emacs a variable or
@@ -155,7 +155,7 @@
;; (set (make-local-variable 'font-lock-defaults)
;; '(foo-font-lock-keywords t))))
-;;; Adding Font Lock support for modes:
+;;;; Adding Font Lock support for modes:
;; Of course, it would be better that the mode already supports Font Lock mode.
;; The package author would do something similar to above. The mode must
@@ -986,7 +986,7 @@ The value of this variable is used when Font Lock mode is
turned on."
((bound-and-true-p lazy-lock-mode)
(lazy-lock-after-unfontify-buffer))))
-;;; End of Font Lock Support mode.
+;; End of Font Lock Support mode.
;;; Fontification functions.
@@ -1393,7 +1393,7 @@ delimit the region to fontify."
(font-lock-fontify-region (point) (mark)))
((error quit) (message "Fontifying block...%s" error-data)))))))
-;;; End of Fontification functions.
+;; End of Fontification functions.
;;; Additional text property functions.
@@ -1485,7 +1485,7 @@ Optional argument OBJECT is the string or buffer
containing the text."
(put-text-property start next prop new object))))))
(setq start (text-property-not-all next end prop nil object)))))
-;;; End of Additional text property functions.
+;; End of Additional text property functions.
;;; Syntactic regexp fontification functions.
@@ -1591,7 +1591,7 @@ START should be at the beginning of a line."
(setq highlights (cdr highlights))))
(setq keywords (cdr keywords)))))
-;;; End of Syntactic regexp fontification functions.
+;; End of Syntactic regexp fontification functions.
;;; Syntactic fontification functions.
@@ -1650,7 +1650,7 @@ START should be at the beginning of a line."
(setq state (parse-partial-sexp (point) end nil nil state
'syntax-table))))))
-;;; End of Syntactic fontification functions.
+;; End of Syntactic fontification functions.
;;; Keyword regexp fontification functions.
@@ -1784,9 +1784,9 @@ LOUDLY, if non-nil, allows progress-meter bar."
(setq keywords (cdr keywords)))
(set-marker pos nil)))
-;;; End of Keyword regexp fontification functions.
+;; End of Keyword regexp fontification functions.
-;; Various functions.
+;;; Various functions.
(defun font-lock-compile-keywords (keywords &optional syntactic-keywords)
"Compile KEYWORDS into the form (t KEYWORDS COMPILED...)
@@ -2102,7 +2102,7 @@ Sets various variables using `font-lock-defaults' and
"Font Lock mode face used to highlight grouping constructs in Lisp regexps."
:group 'font-lock-faces)
-;;; End of Color etc. support.
+;; End of Color etc. support.
;;; Menu support.
@@ -2204,7 +2204,7 @@ Sets various variables using `font-lock-defaults' and
;; ;; Deactivate less/more fontification entries.
;; (setq font-lock-fontify-level nil))
-;;; End of Menu support.
+;; End of Menu support.
;;; Various regexp information shared by several modes.
;; ;; Information specific to a single mode should go in its load library.
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index abe546b..4876715 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -455,9 +455,7 @@ displayed in the echo area."
(> message-log-max 0)
(/= (length str) 0))
(setq time (current-time))
- (with-current-buffer (if (fboundp 'messages-buffer)
- (messages-buffer)
- (get-buffer-create "*Messages*"))
+ (with-current-buffer (messages-buffer)
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert ,timestamp str "\n")
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index ae4517e..b416094 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1029,8 +1029,7 @@ Check the NNTPSERVER environment variable and the
;; `M-x customize-variable RET gnus-select-method RET' should work without
;; starting or even loading Gnus.
-;;;###autoload(when (fboundp 'custom-autoload)
-;;;###autoload (custom-autoload 'gnus-select-method "gnus"))
+;;;###autoload(custom-autoload 'gnus-select-method "gnus")
(defcustom gnus-select-method
(list 'nntp (or (gnus-getenv-nntpserver)
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 7629d5c..2824657 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -131,10 +131,6 @@ is not available."
(cond
((null charset)
charset)
- ;; Running in a non-MULE environment.
- ((or (null (mm-get-coding-system-list))
- (not (fboundp 'coding-system-get)))
- charset)
;; Check override list quite early. Should only used for decoding, not for
;; encoding!
((and allow-override
@@ -295,77 +291,16 @@ superset of iso-8859-1."
(defvar mm-universal-coding-system mm-auto-save-coding-system
"The universal coding system.")
-;; Fixme: some of the cars here aren't valid MIME charsets. That
-;; should only matter with XEmacs, though.
(defvar mm-mime-mule-charset-alist
- '((us-ascii ascii)
- (iso-8859-1 latin-iso8859-1)
- (iso-8859-2 latin-iso8859-2)
- (iso-8859-3 latin-iso8859-3)
- (iso-8859-4 latin-iso8859-4)
- (iso-8859-5 cyrillic-iso8859-5)
- ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters.
- ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default
- ;; charset is koi8-r, not iso-8859-5.
- (koi8-r cyrillic-iso8859-5 gnus-koi8-r)
- (iso-8859-6 arabic-iso8859-6)
- (iso-8859-7 greek-iso8859-7)
- (iso-8859-8 hebrew-iso8859-8)
- (iso-8859-9 latin-iso8859-9)
- (iso-8859-14 latin-iso8859-14)
- (iso-8859-15 latin-iso8859-15)
- (viscii vietnamese-viscii-lower)
- (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978)
- (euc-kr korean-ksc5601)
- (gb2312 chinese-gb2312)
- (gbk chinese-gbk)
- (gb18030 gb18030-2-byte
- gb18030-4-byte-bmp gb18030-4-byte-smp
- gb18030-4-byte-ext-1 gb18030-4-byte-ext-2)
- (big5 chinese-big5-1 chinese-big5-2)
- (tibetan tibetan)
- (thai-tis620 thai-tis620)
- (windows-1251 cyrillic-iso8859-5)
- (iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
- (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212)
- (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2)
- (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2
- cyrillic-iso8859-5 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2
- chinese-cns11643-3 chinese-cns11643-4
- chinese-cns11643-5 chinese-cns11643-6
- chinese-cns11643-7)
- (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
- japanese-jisx0213-1 japanese-jisx0213-2)
- (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208)
- (utf-8))
- "Alist of MIME-charset/MULE-charsets.")
-
-;; Correct by construction, but should be unnecessary for Emacs:
-(when (and (fboundp 'coding-system-list)
- (fboundp 'sort-coding-systems))
- (let ((css (sort-coding-systems (coding-system-list 'base-only)))
- cs mime mule alist)
- (while css
- (setq cs (pop css)
- mime (or (coding-system-get cs :mime-charset) ; Emacs 23 (unicode)
- (coding-system-get cs 'mime-charset)))
+ (let (mime mule alist)
+ (dolist (cs (sort-coding-systems (coding-system-list 'base-only)))
+ (setq mime (coding-system-get cs 'mime-charset))
(when (and mime
- (not (eq t (setq mule
- (coding-system-get cs 'safe-charsets))))
+ (not (eq t (setq mule (coding-system-get cs 'safe-charsets))))
(not (assq mime alist)))
(push (cons mime (delq 'ascii mule)) alist)))
- (setq mm-mime-mule-charset-alist (nreverse alist))))
+ (nreverse alist))
+ "Alist of MIME-charset/MULE-charsets.")
(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2)
"A list of special charsets.
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index d40b928..afca2cd 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -371,6 +371,7 @@ suitable file is found, return nil."
(help-C-file-name type 'subr)
'C-source))
((and (not file-name) (symbolp object)
+ (eq type 'defvar)
(integerp (get object 'variable-documentation)))
;; A variable defined in C. The form is from `describe-variable'.
(if (get-buffer " *DOC*")
diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el
index 7f2a99a..1888c8f 100644
--- a/lisp/language/burmese.el
+++ b/lisp/language/burmese.el
@@ -23,7 +23,6 @@
;;; Commentary:
-;; Aung San Suu Kyi says to call her country "Burma".
;; The murderous generals say to call it "Myanmar".
;; We will call it "Burma". -- rms, Chief GNUisance.
diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el
index a3a6f3f..ce60d1a 100644
--- a/lisp/language/cyril-util.el
+++ b/lisp/language/cyril-util.el
@@ -47,7 +47,7 @@
;;;###autoload
(defun standard-display-cyrillic-translit (&optional cyrillic-language)
- "Display a cyrillic buffer using a transliteration.
+ "Display a Cyrillic buffer using a transliteration.
For readability, the table is slightly
different from the one used for the input method `cyrillic-translit'.
diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el
index 19cba91..f38dead 100644
--- a/lisp/language/hanja-util.el
+++ b/lisp/language/hanja-util.el
@@ -22,7 +22,7 @@
;;; Commentary:
-;; This file defines korean hanja table and symbol table.
+;; This file defines the Korean Hanja table and symbol table.
;;; Code:
@@ -31,7 +31,7 @@
(defvar hanja-table nil
"A char table for Hanja characters.
-It maps a hangul character to a list of the corresponding Hanja characters.
+It maps a Hangul character to a list of the corresponding Hanja characters.
Each element of the list has the form CHAR or (CHAR . STRING)
where CHAR is a Hanja character and STRING is the meaning of that
character. This variable is initialized by `hanja-init-load'.")
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index eb882c8..657ad69 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -25,7 +25,7 @@
;;; Commentary:
;; This file contains definitions of Indian language environments, and
-;; setups for displaying the scrtipts used there.
+;; setups for displaying the scripts used there.
;;; Code:
diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el
index 78ffca9..6a2508b 100644
--- a/lisp/leim/quail/latin-ltx.el
+++ b/lisp/leim/quail/latin-ltx.el
@@ -242,12 +242,14 @@ system, including many technical ones. Examples:
((lambda (name char)
;; "GREEK SMALL LETTER PHI" (which is \phi) and "GREEK PHI SYMBOL"
;; (which is \varphi) are reversed in `ucs-names', so we define
- ;; them manually.
- (unless (string-match-p "\\<PHI\\>" name)
+ ;; them manually. Also ignore "GREEK SMALL LETTER EPSILON" and
+ ;; add the correct value for \epsilon manually.
+ (unless (string-match-p "\\<\\(?:PHI\\|GREEK SMALL LETTER EPSILON\\)\\>"
name)
(concat "\\" (funcall (if (match-end 1) #' capitalize #'downcase)
(match-string 2 name)))))
"\\`GREEK \\(?:SMALL\\|CAPITA\\(L\\)\\) LETTER \\([^- ]+\\)\\'")
+ ("\\epsilon" ?ϵ)
("\\phi" ?ϕ)
("\\Box" ?□)
("\\Bumpeq" ?≎)
@@ -641,6 +643,7 @@ system, including many technical ones. Examples:
(concat "\\var" (downcase (match-string 1 name)))))
"\\`GREEK \\([^- ]+\\) SYMBOL\\'")
+ ("\\varepsilon" ?ε)
("\\varphi" ?φ)
("\\varprime" ?′)
("\\varpropto" ?∝)
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index f5c9432..666395e 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -53,6 +53,7 @@
;; See http://www.ietf.org/rfc/rfc2554.txt
;;; Code:
+;;; Dependencies
(require 'sendmail)
(require 'auth-source)
@@ -61,12 +62,12 @@
(autoload 'message-make-message-id "message")
(autoload 'rfc2104-hash "rfc2104")
-;;;
+;;; Options
+
(defgroup smtpmail nil
"SMTP protocol for sending mail."
:group 'mail)
-
(defcustom smtpmail-default-smtp-server nil
"Specify default SMTP server.
This only has effect if you specify it before loading the smtpmail library."
@@ -172,8 +173,7 @@ mean \"try again\"."
:type 'integer
:version "27.1")
-;; End of customizable variables.
-
+;;; Variables
(defvar smtpmail-address-buffer)
(defvar smtpmail-recipient-address-list)
@@ -192,6 +192,8 @@ for `smtpmail-try-auth-method'.")
(defvar smtpmail-mail-address nil
"Value to use for envelope-from address for mail from ambient buffer.")
+;;; Functions
+
;;;###autoload
(defun smtpmail-send-it ()
(let ((errbuf (if mail-interactive
diff --git a/lisp/man.el b/lisp/man.el
index e1dd503..da8a15f 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -836,9 +836,10 @@ POS defaults to `point'."
;; ======================================================================
;; Top level command and background process sentinel
-;; For compatibility with older versions.
+;; This alias was originally for compatibility with older versions.
+;; Some users got used to having it, so we will not remove it.
;;;###autoload
-(define-obsolete-function-alias 'manual-entry 'man "28.1")
+(defalias 'manual-entry 'man)
(defvar Man-completion-cache nil
;; On my machine, "man -k" is so fast that a cache makes no sense,
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index c3c2943..c368cd7 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -316,8 +316,6 @@ If TCP-P, the first two bytes of the packet will be the
length field."
"Return false if we need to recheck the list of DNS servers."
(and dns-servers
(or (eq dns-servers-valid-for-interfaces t)
- ;; `network-interface-list' was introduced in Emacs 22.1.
- (not (fboundp 'network-interface-list))
(equal dns-servers-valid-for-interfaces
(network-interface-list)))))
@@ -339,8 +337,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
(when (re-search-forward
"^Address:[
\t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\|[[:xdigit:]:]*\\)" nil t)
(setq dns-servers (list (match-string 1)))))))
- (when (fboundp 'network-interface-list)
- (setq dns-servers-valid-for-interfaces (network-interface-list))))
+ (setq dns-servers-valid-for-interfaces (network-interface-list)))
(defun dns-read-txt (string)
(if (> (length string) 1)
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 20a5c5f..56ea033 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -71,7 +71,7 @@
`("EUDC Sound Menu"
["---" nil nil]
["Play sound" eudc-bob-play-sound-at-point
- (fboundp 'play-sound)]
+ (fboundp 'play-sound-internal)]
,@(cdr (cdr eudc-bob-generic-menu))))
(defun eudc-jump-to-event (event)
@@ -197,7 +197,7 @@ display a button."
(let (sound)
(if (null (setq sound (eudc-bob-get-overlay-prop 'object-data)))
(error "No sound data available here")
- (unless (fboundp 'play-sound)
+ (unless (fboundp 'play-sound-internal)
(error "Playing sounds not supported on this system"))
(play-sound (list 'sound :data sound)))))
@@ -214,8 +214,7 @@ display a button."
(let ((data (eudc-bob-get-overlay-prop 'object-data))
(buffer (generate-new-buffer "*eudc-tmp*")))
(save-excursion
- (if (fboundp 'set-buffer-file-coding-system)
- (set-buffer-file-coding-system 'binary))
+ (set-buffer-file-coding-system 'binary)
(set-buffer buffer)
(set-buffer-multibyte nil)
(insert data)
@@ -231,8 +230,7 @@ display a button."
viewer)
(condition-case nil
(save-excursion
- (if (fboundp 'set-buffer-file-coding-system)
- (set-buffer-file-coding-system 'binary))
+ (set-buffer-file-coding-system 'binary)
(set-buffer buffer)
(insert data)
(setq program (completing-read "Viewer: " eudc-external-viewers))
diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el
index f258d5c..e2d10e3 100644
--- a/lisp/net/eudcb-macos-contacts.el
+++ b/lisp/net/eudcb-macos-contacts.el
@@ -1,19 +1,23 @@
;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend
-;; Copyright (C) 2020 condition-alpha.com
+;; Copyright (C) 2020 Free Software Foundation, Inc.
-;; This program is free software: you can redistribute it and/or modify
+;; Author: Alexander Adolf
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
+
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
-;;
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library provides an interface to the macOS Contacts app as
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index a492dc8..22b5908 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -134,6 +134,7 @@
;;
;;; Code:
+;;; Dependencies
(eval-when-compile (require 'cl-lib))
(require 'utf7)
@@ -145,7 +146,7 @@
(declare-function digest-md5-digest-uri "ext:digest-md5")
(declare-function digest-md5-challenge "ext:digest-md5")
-;; User variables.
+;;; User variables
(defgroup imap nil
"Low-level IMAP issues."
@@ -257,7 +258,7 @@ Shorter values mean quicker response, but is more CPU
intensive."
:group 'imap
:type 'boolean)
-;; Various variables.
+;;; Various variables
(defvar imap-fetch-data-hook nil
"Hooks called after receiving each FETCH response.")
@@ -316,7 +317,9 @@ the value of this variable will be bound to a certain value
to which
an application program that uses this module specifies on a per-server
basis.")
-;; Internal constants. Change these and die.
+;;; Internal constants
+
+;; Change these and die.
(defconst imap-default-port 143)
(defconst imap-default-ssl-port 993)
@@ -348,7 +351,7 @@ basis.")
(defconst imap-log-buffer "*imap-log*")
(defconst imap-debug-buffer "*imap-debug*")
-;; Internal variables.
+;;; Internal variables
(defvar imap-stream nil)
(defvar imap-auth nil)
@@ -437,7 +440,7 @@ This variable is set to t automatically per server if the
canonical form fails.")
-;; Utility functions:
+;;; Utility functions
(defun imap-remassoc (key alist)
"Delete by side effect any elements of ALIST whose car is `equal' to KEY.
@@ -489,7 +492,8 @@ sure of changing the value of `foo'."
(nth 3 (car imap-failed-tags))))
-;; Server functions; stream stuff:
+;;; Server functions
+;;;; Stream functions
(defun imap-log (string-or-buffer)
(when imap-log
@@ -747,7 +751,7 @@ sure of changing the value of `foo'."
(message "imap: Connecting with STARTTLS...%s" (if done "done" "failed"))
done))
-;; Server functions; authenticator stuff:
+;;;; Authenticator functions
(defun imap-interactive-login (buffer loginfunc)
"Login to server in BUFFER.
@@ -871,7 +875,7 @@ t if it successfully authenticates, nil otherwise."
(concat "LOGIN anonymous \"" (concat (user-login-name) "@"
(system-name)) "\"")))))
-;;; Compiler directives.
+;;; Compiler directives
(defvar imap-sasl-client)
(defvar imap-sasl-step)
@@ -969,7 +973,7 @@ t if it successfully authenticates, nil otherwise."
(imap-send-command-1 "")
(imap-ok-p (imap-wait-for-tag tag)))))))
-;; Server functions:
+;;; Server functions
(defun imap-open-1 (buffer)
(with-current-buffer buffer
@@ -1228,7 +1232,7 @@ If BUFFER is nil, the current buffer is assumed."
(imap-send-command-wait "LOGOUT" buffer)))
-;; Mailbox functions:
+;;; Mailbox functions
(defun imap-mailbox-put (propname value &optional mailbox buffer)
(with-current-buffer (or buffer (current-buffer))
@@ -1520,7 +1524,7 @@ or `unseen'. The IMAP command tag is returned."
identifier))))))
-;; Message functions:
+;;; Message functions
(defun imap-current-message (&optional buffer)
(with-current-buffer (or buffer (current-buffer))
@@ -1832,7 +1836,7 @@ on failure."
(if (aref from 0) ">"))))
-;; Internal functions.
+;;; Internal functions
(defun imap-add-callback (tag func)
(setq imap-callbacks (append (list (cons tag func)) imap-callbacks)))
@@ -1969,7 +1973,7 @@ Return nil if no complete line has arrived."
(delete-region (point-min) (point-max)))))))))
-;; Imap parser.
+;;; Imap parser
(defsubst imap-forward ()
(or (eobp) (forward-char)))
@@ -2850,6 +2854,8 @@ Return nil if no complete line has arrived."
(imap-forward)
(nreverse body)))))
+;;; Debug
+
(when imap-debug ; (untrace-all)
(require 'trace)
(buffer-disable-undo (get-buffer-create imap-debug-buffer))
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 86f9d2b..f01a5de 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -269,11 +269,6 @@ is consulted."
(viewer . "display %s")
(type . "image/*")
(test . (eq window-system 'x))
- ("needsx11"))
- (".*"
- (viewer . "ee %s")
- (type . "image/*")
- (test . (eq window-system 'x))
("needsx11")))
("text"
("plain"
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 88f5c29..49ecaa5 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -890,8 +890,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
"Like `make-process' for Tramp files.
If connection property \"direct-async-process\" is non-nil, an
alternative implementation will be used."
- (if (tramp-get-connection-property
- (tramp-dissect-file-name default-directory) "direct-async-process" nil)
+ (if (tramp-direct-async-process-p args)
(apply #'tramp-handle-make-process args)
(when args
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 3e2eb02..ca43475 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2790,8 +2790,7 @@ the result will be a local, non-Tramp, file name."
STDERR can also be a file name. If connection property
\"direct-async-process\" is non-nil, an alternative
implementation will be used."
- (if (tramp-get-connection-property
- (tramp-dissect-file-name default-directory) "direct-async-process" nil)
+ (if (tramp-direct-async-process-p args)
(apply #'tramp-handle-make-process args)
(when args
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index fdf26f6..ab52bec 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3633,18 +3633,29 @@ User is always nil."
(load local-copy noerror t nosuffix must-suffix)
(delete-file local-copy)))))
t)))
+
+(defun tramp-direct-async-process-p (&rest args)
+ "Whether direct async `make-process' can be called."
+ (let ((v (tramp-dissect-file-name default-directory)))
+ (and (tramp-get-connection-property v"direct-async-process" nil)
+ (not (tramp-multi-hop-p v))
+ (not (plist-get args :stderr)))))
+
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
;; connection has been setup.
(defun tramp-handle-make-process (&rest args)
- "An alternative `make-process' implementation for Tramp files."
+ "An alternative `make-process' implementation for Tramp files.
+It does not support `:stderr'."
(when args
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let ((name (plist-get args :name))
(buffer (plist-get args :buffer))
(command (plist-get args :command))
+ ;; FIXME: `:coding' shall be used.
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
+ ;; FIXME: `:connection-type' shall be used.
(connection-type (plist-get args :connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
@@ -3667,11 +3678,12 @@ User is always nil."
(signal 'wrong-type-argument (list #'functionp filter)))
(unless (or (null sentinel) (functionp sentinel))
(signal 'wrong-type-argument (list #'functionp sentinel)))
- (unless (or (null stderr) (bufferp stderr) (stringp stderr))
- (signal 'wrong-type-argument (list #'stringp stderr)))
- (when (and (stringp stderr) (tramp-tramp-file-p stderr)
- (not (tramp-equal-remote default-directory stderr)))
- (signal 'file-error (list "Wrong stderr" stderr)))
+ (when stderr
+ (signal
+ 'user-error
+ (list
+ "Stderr not supported for direct remote asynchronous processes"
+ stderr)))
(let* ((buffer
(if buffer
@@ -3698,9 +3710,12 @@ User is always nil."
(tramp-set-connection-property v "process-name" name)
(tramp-set-connection-property v "process-buffer" buffer)
+ ;; Check for `tramp-sh-file-name-handler', because something
+ ;; is different between tramp-adb.el and tramp-sh.el.
(with-current-buffer (tramp-get-connection-buffer v)
(unwind-protect
- (let* ((login-program
+ (let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v))
+ (login-program
(tramp-get-method-parameter v 'tramp-login-program))
(login-args
(tramp-get-method-parameter v 'tramp-login-args))
@@ -3716,12 +3731,12 @@ User is always nil."
;; in the main connection process, therefore
;; we cannot use `tramp-get-connection-process'.
(tmpfile
- (when (tramp-sh-file-name-handler-p v)
+ (when sh-file-name-handler-p
(with-tramp-connection-property
(tramp-get-process v) "temp-file"
(tramp-compat-make-temp-name))))
(options
- (when (tramp-sh-file-name-handler-p v)
+ (when sh-file-name-handler-p
(tramp-compat-funcall
'tramp-ssh-controlmaster-options v)))
spec)
@@ -3814,9 +3829,12 @@ support symbolic links."
(setq current-buffer-p t)
(current-buffer))
(t (get-buffer-create
+ ;; These variables have been introduced with Emacs 28.1.
(if asynchronous
- shell-command-buffer-name-async
- shell-command-buffer-name)))))
+ (or (bound-and-true-p shell-command-buffer-name-async)
+ "*Async Shell Command*")
+ (or (bound-and-true-p shell-command-buffer-name)
+ "*Shell Command Output*"))))))
(error-buffer
(cond
((bufferp error-buffer) error-buffer)
diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el
index 2fba49f..cbe453a 100644
--- a/lisp/obsolete/longlines.el
+++ b/lisp/obsolete/longlines.el
@@ -37,6 +37,7 @@
;; Special thanks to Rod Smith for many useful bug reports.
;;; Code:
+;;; Options
(defgroup longlines nil
"Automatic wrapping of long lines when loading files."
@@ -76,7 +77,7 @@ This is used when `longlines-show-hard-newlines' is on."
:group 'longlines
:type 'string)
-;; Internal variables
+;;; Internal variables
(defvar longlines-wrap-beg nil)
(defvar longlines-wrap-end nil)
@@ -90,7 +91,7 @@ This is used when `longlines-show-hard-newlines' is on."
(make-variable-buffer-local 'longlines-showing)
(make-variable-buffer-local 'longlines-decoded)
-;; Mode
+;;; Mode
(defvar message-indent-citation-function)
@@ -210,7 +211,7 @@ This function exists to be called by
`change-major-mode-hook' when the
major mode changes."
(longlines-mode 0))
-;; Showing the effect of hard newlines in the buffer
+;;; Showing the effect of hard newlines in the buffer
(defun longlines-show-hard-newlines (&optional arg)
"Make hard newlines visible by adding a face.
@@ -252,7 +253,7 @@ With optional argument ARG, make the hard newlines
invisible again."
(setq pos (text-property-not-all (1+ pos) (point-max) 'hard nil)))
(restore-buffer-modified-p mod)))
-;; Wrapping the paragraphs.
+;;; Wrapping the paragraphs
(defun longlines-wrap-region (beg end)
"Wrap each successive line, starting with the line before BEG.
@@ -402,7 +403,7 @@ Hard newlines are left intact."
(setq pos (string-match "\n" str (1+ pos))))
str))
-;; Auto wrap
+;;; Auto wrap
(defun longlines-auto-wrap (&optional arg)
"Toggle automatic line wrapping.
@@ -457,7 +458,7 @@ This is called by `window-configuration-change-hook'."
(setq fill-column (- (window-width) dw))
(longlines-wrap-region (point-min) (point-max)))))
-;; Isearch
+;;; Isearch
(defun longlines-search-function ()
(cond
@@ -477,7 +478,7 @@ This is called by `window-configuration-change-hook'."
(let ((search-spaces-regexp " *[ \n]"))
(re-search-forward string bound noerror count)))
-;; Loading and saving
+;;; Loading and saving
(defun longlines-before-revert-hook ()
(add-hook 'after-revert-hook 'longlines-after-revert-hook nil t)
@@ -492,7 +493,7 @@ This is called by `window-configuration-change-hook'."
(list 'longlines "Automatically wrap long lines." nil nil
'longlines-encode-region t nil))
-;; Unloading
+;;; Unloading
(defun longlines-unload-function ()
"Unload the longlines library."
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index e598257..903c068 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -976,16 +976,14 @@ Set `bubbles--col-offset' and `bubbles--row-offset'."
(* image-vert-size (bubbles--grid-height)))
2)))))
-(defun bubbles--remove-overlays ()
- "Remove all overlays."
- (if (fboundp 'remove-overlays)
- (remove-overlays)))
+(define-obsolete-function-alias 'bubbles--remove-overlays
+ 'remove-overlays "28.1")
(defun bubbles--initialize ()
"Initialize Bubbles game."
(bubbles--initialize-faces)
(bubbles--initialize-images)
- (bubbles--remove-overlays)
+ (remove-overlays)
(switch-to-buffer (get-buffer-create "*bubbles*"))
(bubbles--compute-offsets)
@@ -1409,7 +1407,7 @@ Return t if new char is non-empty."
(defun bubbles--show-images ()
"Update images in the bubbles buffer."
- (bubbles--remove-overlays)
+ (remove-overlays)
(if (and (display-images-p)
bubbles--images-ok
(not (eq bubbles-graphics-theme 'ascii)))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index a76a3c4..0b9f417 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -2373,12 +2373,10 @@ and runs `compilation-filter-hook'."
(set-marker min nil)
(set-marker max nil))))))
-;;; test if a buffer is a compilation buffer, assuming we're in the buffer
(defsubst compilation-buffer-internal-p ()
"Test if inside a compilation buffer."
(local-variable-p 'compilation-locs))
-;;; test if a buffer is a compilation buffer, using
compilation-buffer-internal-p
(defsubst compilation-buffer-p (buffer)
"Test if BUFFER is a compilation buffer."
(with-current-buffer buffer
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index 6770fbe..f875915 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -2745,7 +2745,7 @@ Runs to the last statement and then steps 1 statement.
Use the .out command."
;; event. mouse-drag-track does so.
(if drag-track 'mouse-drag-track 'mouse-drag-region)))
(funcall tracker event)
- (idlwave-shell-print (if (idlwave-region-active-p) '(4) nil)
+ (idlwave-shell-print (if (region-active-p) '(4) nil)
,help ,ev))))
;; Begin terrible hack section -- XEmacs tests for button2 explicitly
@@ -2830,7 +2830,7 @@ from `idlwave-shell-examine-alist' via mini-buffer
shortcut key."
(cond
((equal arg '(16))
(setq expr (read-string "Expression: ")))
- ((and (or arg (idlwave-region-active-p))
+ ((and (or arg (region-active-p))
(< (- (region-end) (region-beginning)) 2000))
(setq beg (region-beginning)
end (region-end)))
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 3092d4c..f7e53ec 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -154,21 +154,6 @@
(eval-when-compile (require 'cl-lib))
(require 'idlw-help)
-;; For XEmacs
-(unless (fboundp 'line-beginning-position)
- (defalias 'line-beginning-position 'point-at-bol))
-(unless (fboundp 'line-end-position)
- (defalias 'line-end-position 'point-at-eol))
-(unless (fboundp 'char-valid-p)
- (defalias 'char-valid-p 'characterp))
-(unless (fboundp 'match-string-no-properties)
- (defalias 'match-string-no-properties 'match-string))
-
-(if (not (fboundp 'cancel-timer))
- (condition-case nil
- (require 'timer)
- (error nil)))
-
(declare-function idlwave-shell-get-path-info "idlw-shell")
(declare-function idlwave-shell-temp-file "idlw-shell")
(declare-function idlwave-shell-is-running "idlw-shell")
@@ -2092,11 +2077,7 @@ Returns point if comment found and nil otherwise."
(backward-char 1)
(point)))))
-(defun idlwave-region-active-p ()
- "Should we operate on an active region?"
- (if (fboundp 'use-region-p)
- (use-region-p)
- (region-active-p)))
+(define-obsolete-function-alias 'idlwave-region-active-p 'use-region-p "28.1")
(defun idlwave-show-matching-quote ()
"Insert quote and show matching quote if this is end of a string."
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 99b5735..a209d21 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -271,10 +271,6 @@
(require 'easymenu)
(require 'align)
-(eval-when-compile
- (or (fboundp 'use-region-p)
- (defsubst use-region-p () (region-exists-p))))
-
(defgroup prolog nil
"Editing and running Prolog and Mercury files."
:group 'languages)
@@ -2752,20 +2748,6 @@ When called with prefix argument ARG, disable zipping
instead."
(nth 1 state)))
))))
-;; For backward compatibility. Stolen from custom.el.
-(or (fboundp 'match-string)
- ;; Introduced in Emacs 19.29.
- (defun match-string (num &optional string)
- "Return string of text matched by last search.
-NUM specifies which parenthesized expression in the last regexp.
- Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
-Zero means the entire text matched by the whole regexp or whole string.
-STRING should be given if the last search was by `string-match' on STRING."
- (if (match-beginning num)
- (if string
- (substring string (match-beginning num) (match-end num))
- (buffer-substring (match-beginning num) (match-end num))))))
-
(defun prolog-pred-start ()
"Return the starting point of the first clause of the current predicate."
;; FIXME: Use SMIE.
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index a70b5ed..e554b2b 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -455,7 +455,7 @@ file. Since that is a plaintext file, this could be
dangerous."
:prompt-regexp "^mysql> "
:prompt-length 6
:prompt-cont-regexp "^ -> "
- :syntax-alist ((?# . "< b"))
+ :syntax-alist ((?# . "< b") (?\\ . "\\"))
:input-filter sql-remove-tabs-filter)
(oracle
@@ -1508,22 +1508,6 @@ Based on `comint-mode-map'.")
table)
"Syntax table used in `sql-mode' and `sql-interactive-mode'.")
-;;; Syntax Properties
-
-;; `sql--syntax-propertize-escaped-apostrophe', as follows, was
-;; (analysed and) adapted from `pascal--syntax-propertize' in
-;; pascal.el because basic syntax parsing cannot handle the SQL ''
-;; construct within strings.
-
-(defconst sql--syntax-propertize-escaped-apostrophe
- (syntax-propertize-rules
- ("''"
- (0
- (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0))))
- (string-to-syntax ".")
- (forward-char -1)
- nil)))))
-
;; Font lock support
(defvar sql-mode-font-lock-object-name
@@ -4203,7 +4187,7 @@ must tell Emacs. Here's how to do that in your init file:
\(add-hook \\='sql-mode-hook
(lambda ()
- (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))"
+ (modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))"
:abbrev-table sql-mode-abbrev-table
(if sql-mode-menu
@@ -4226,10 +4210,18 @@ must tell Emacs. Here's how to do that in your init
file:
(setq-local abbrev-all-caps 1)
;; Contains the name of database objects
(set (make-local-variable 'sql-contains-names) t)
- ;; Activate punctuation syntax table property for
- ;; escaped apostrophes within strings:
(setq-local syntax-propertize-function
- sql--syntax-propertize-escaped-apostrophe)
+ (syntax-propertize-rules
+ ;; Handle escaped apostrophes within strings.
+ ("''"
+ (0
+ (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0))))
+ (string-to-syntax ".")
+ (forward-char -1)
+ nil)))
+ ;; Propertize rules to not have /- and -* start comments.
+ ("\\(/-\\)" (1 "."))
+ ("\\(-\\*\\)" (1 "."))))
;; Set syntax and font-face highlighting
;; Catch changes to sql-product and highlight accordingly
(sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591
diff --git a/lisp/ps-def.el b/lisp/ps-def.el
index 49d72d3..f532511 100644
--- a/lisp/ps-def.el
+++ b/lisp/ps-def.el
@@ -55,7 +55,7 @@
(face-background face nil t))
-(defalias 'ps-frame-parameter 'frame-parameter)
+(define-obsolete-function-alias 'ps-frame-parameter #'frame-parameter "28.1")
;; Return t if the device (which can be changed during an emacs session) can
;; handle colors. This function is not yet implemented for GNU emacs.
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index ace3001..17b486b 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -5761,7 +5761,7 @@ XSTART YSTART are the relative position for the first
page in a sheet.")
(eq genfunc 'ps-generate-postscript))
nil)
((eq ps-default-bg 'frame-parameter)
- (ps-frame-parameter nil 'background-color))
+ (frame-parameter nil 'background-color))
((eq ps-default-bg t)
(ps-face-background-name 'default))
(t
@@ -5775,7 +5775,7 @@ XSTART YSTART are the relative position for the first
page in a sheet.")
(eq genfunc 'ps-generate-postscript))
nil)
((eq ps-default-fg 'frame-parameter)
- (ps-frame-parameter nil 'foreground-color))
+ (frame-parameter nil 'foreground-color))
((eq ps-default-fg t)
(ps-face-foreground-name 'default))
(t
diff --git a/lisp/server.el b/lisp/server.el
index 1861218..9934e1c 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -274,10 +274,11 @@ the \"-f\" switch otherwise."
(if internal--daemon-sockname
(file-name-directory internal--daemon-sockname)
(and (featurep 'make-network-process '(:family local))
- (let ((xdg_runtime_dir (getenv "XDG_RUNTIME_DIR")))
- (if xdg_runtime_dir
- (format "%s/emacs" xdg_runtime_dir)
- (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid))))))
+ (let ((runtime-dir (getenv "XDG_RUNTIME_DIR")))
+ (if runtime-dir
+ (expand-file-name "emacs" runtime-dir)
+ (expand-file-name (format "emacs%d" (user-uid))
+ (or (getenv "TMPDIR") "/tmp"))))))
"The directory in which to place the server socket.
If local sockets are not supported, this is nil.")
diff --git a/lisp/shell.el b/lisp/shell.el
index dc52841..f5e18bb 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -619,7 +619,12 @@ buffer."
;; Bypass a bug in certain versions of bash.
(when (string-equal shell "bash")
(add-hook 'comint-preoutput-filter-functions
- #'shell-filter-ctrl-a-ctrl-b nil t)))
+ #'shell-filter-ctrl-a-ctrl-b nil t))
+
+ ;; Skip extended history for zsh.
+ (when (string-equal shell "zsh")
+ (setq-local comint-input-ring-file-prefix
+ ": [[:digit:]]+:[[:digit:]]+;")))
(comint-read-input-ring t)))
(defun shell-apply-ansi-color (beg end face)
diff --git a/lisp/simple.el b/lisp/simple.el
index 6c9584a..6f72c3b 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1366,28 +1366,47 @@ END, without printing any message."
(message "line %d (narrowed line %d)"
(+ n (line-number-at-pos start) -1) n))))))
-(defun count-lines (start end)
+(defun count-lines (start end &optional ignore-invisible-lines)
"Return number of lines between START and END.
-This is usually the number of newlines between them,
-but can be one more if START is not equal to END
-and the greater of them is not at the start of a line."
+This is usually the number of newlines between them, but can be
+one more if START is not equal to END and the greater of them is
+not at the start of a line.
+
+When IGNORE-INVISIBLE-LINES is non-nil, invisible lines are not
+included in the count."
(save-excursion
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
- (if (eq selective-display t)
- (save-match-data
- (let ((done 0))
- (while (re-search-forward "[\n\C-m]" nil t 40)
- (setq done (+ 40 done)))
- (while (re-search-forward "[\n\C-m]" nil t 1)
- (setq done (+ 1 done)))
- (goto-char (point-max))
- (if (and (/= start end)
- (not (bolp)))
- (1+ done)
- done)))
- (- (buffer-size) (forward-line (buffer-size)))))))
+ (cond ((and (not ignore-invisible-lines)
+ (eq selective-display t))
+ (save-match-data
+ (let ((done 0))
+ (while (re-search-forward "\n\\|\r[^\n]" nil t 40)
+ (setq done (+ 40 done)))
+ (while (re-search-forward "\n\\|\r[^\n]" nil t 1)
+ (setq done (+ 1 done)))
+ (goto-char (point-max))
+ (if (and (/= start end)
+ (not (bolp)))
+ (1+ done)
+ done))))
+ (ignore-invisible-lines
+ (save-match-data
+ (- (buffer-size)
+ (forward-line (buffer-size))
+ (let ((invisible-count 0)
+ prop)
+ (goto-char (point-min))
+ (while (re-search-forward "\n\\|\r[^\n]" nil t)
+ (setq prop (get-char-property (1- (point)) 'invisible))
+ (if (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))
+ (setq invisible-count (1+ invisible-count))))
+ invisible-count))))
+ (t (- (buffer-size) (forward-line (buffer-size))))))))
(defun line-number-at-pos (&optional pos absolute)
"Return buffer line number at position POS.
@@ -1619,6 +1638,10 @@ display the result of expression evaluation."
"Hook run by `eval-expression' when entering the minibuffer.")
(defun read--expression (prompt &optional initial-contents)
+ "Read an Emacs Lisp expression from the minibuffer.
+
+PROMPT and optional argument INITIAL-CONTENTS do the same as in
+function `read-from-minibuffer'."
(let ((minibuffer-completing-symbol t))
(minibuffer-with-setup-hook
(lambda ()
@@ -1629,11 +1652,52 @@ display the result of expression evaluation."
(set-syntax-table emacs-lisp-mode-syntax-table)
(add-hook 'completion-at-point-functions
#'elisp-completion-at-point nil t)
+ (local-set-key "\r" 'read--expression-try-read)
+ (local-set-key "\n" 'read--expression-try-read)
(run-hooks 'eval-expression-minibuffer-setup-hook))
(read-from-minibuffer prompt initial-contents
read-expression-map t
'read-expression-history))))
+(defun read--expression-try-read ()
+ "Try to read an Emacs Lisp expression in the minibuffer.
+
+Exit the minibuffer if successful, else report the error to the
+user and move point to the location of the error. If point is
+not already at the location of the error, push a mark before
+moving point."
+ (interactive)
+ (unless (> (minibuffer-depth) 0)
+ (error "Minibuffer must be active"))
+ (if (let* ((contents (minibuffer-contents))
+ (error-point nil))
+ (with-temp-buffer
+ (condition-case err
+ (progn
+ (insert contents)
+ (goto-char (point-min))
+ ;; `read' will signal errors like "End of file during
+ ;; parsing" and "Invalid read syntax".
+ (read (current-buffer))
+ ;; Since `read' does not signal the "Trailing garbage
+ ;; following expression" error, we check for trailing
+ ;; garbage ourselves.
+ (or (progn
+ ;; This check is similar to what `string_to_object'
+ ;; does in minibuf.c.
+ (skip-chars-forward " \t\n")
+ (= (point) (point-max)))
+ (error "Trailing garbage following expression")))
+ (error
+ (setq error-point (+ (length (minibuffer-prompt)) (point)))
+ (with-current-buffer (window-buffer (minibuffer-window))
+ (unless (= (point) error-point)
+ (push-mark))
+ (goto-char error-point)
+ (minibuffer-message (error-message-string err)))
+ nil))))
+ (exit-minibuffer)))
+
(defun eval-expression-get-print-arguments (prefix-argument)
"Get arguments for commands that print an expression result.
Returns a list (INSERT-VALUE NO-TRUNCATE CHAR-PRINT-LIMIT)
@@ -3441,8 +3505,9 @@ to `shell-command-history'."
(defcustom async-shell-command-buffer 'confirm-new-buffer
"What to do when the output buffer is used by another shell command.
This option specifies how to resolve the conflict where a new command
-wants to direct its output to the buffer `shell-command-buffer-name-async',
-but this buffer is already taken by another running shell command.
+wants to direct its output to the buffer whose name is stored
+in `shell-command-buffer-name-async', but that buffer is already
+taken by another running shell command.
The value `confirm-kill-process' is used to ask for confirmation before
killing the already running process and running a new process
@@ -3593,14 +3658,18 @@ whose `car' is BUFFER."
Like `shell-command', but adds `&' at the end of COMMAND
to execute it asynchronously.
-The output appears in the buffer `shell-command-buffer-name-async'.
-That buffer is in shell mode.
+The output appears in the buffer whose name is stored in the
+variable `shell-command-buffer-name-async'. That buffer is in
+shell mode.
You can configure `async-shell-command-buffer' to specify what to do
-when the `shell-command-buffer-name-async' buffer is already taken by another
-running shell command. To run COMMAND without displaying the output
-in a window you can configure `display-buffer-alist' to use the action
-`display-buffer-no-window' for the buffer `shell-command-buffer-name-async'.
+when the buffer specified by `shell-command-buffer-name-async' is
+already taken by another running shell command.
+
+To run COMMAND without displaying the output in a window you can
+configure `display-buffer-alist' to use the action
+`display-buffer-no-window' for the buffer given by
+`shell-command-buffer-name-async'.
In Elisp, you will often be better served by calling `start-process'
directly, since it offers more control and does not impose the use of
@@ -3636,16 +3705,18 @@ If `shell-command-prompt-show-cwd' is non-nil, show the
current
directory in the prompt.
If COMMAND ends in `&', execute it asynchronously.
-The output appears in the buffer `shell-command-buffer-name-async'.
-That buffer is in shell mode. You can also use
-`async-shell-command' that automatically adds `&'.
+The output appears in the buffer whose name is specified
+by `shell-command-buffer-name-async'. That buffer is in shell
+mode. You can also use `async-shell-command' that automatically
+adds `&'.
Otherwise, COMMAND is executed synchronously. The output appears in
-the buffer `shell-command-buffer-name'. If the output is short enough to
-display in the echo area (which is determined by the variables
-`resize-mini-windows' and `max-mini-window-height'), it is shown
-there, but it is nonetheless available in buffer `*Shell Command
-Output*' even though that buffer is not automatically displayed.
+the buffer named by `shell-command-buffer-name'. If the output is
+short enough to display in the echo area (which is determined by the
+variables `resize-mini-windows' and `max-mini-window-height'), it is
+shown there, but it is nonetheless available in buffer named by
+`shell-command-buffer-name' even though that buffer is not
+automatically displayed.
To specify a coding system for converting non-ASCII characters
in the shell command output, use \\[universal-coding-system-argument] \
@@ -3916,9 +3987,9 @@ and are used only if a pop-up buffer is displayed."
error-buffer display-error-buffer
region-noncontiguous-p)
"Execute string COMMAND in inferior shell with region as input.
-Normally display output (if any) in temp buffer `shell-command-buffer-name';
-Prefix arg means replace the region with it. Return the exit code of
-COMMAND.
+Normally display output (if any) in temp buffer specified
+by `shell-command-buffer-name'; prefix arg means replace the region
+with it. Return the exit code of COMMAND.
To specify a coding system for converting non-ASCII characters
in the input and output to the shell command, use
\\[universal-coding-system-argument]
@@ -3935,7 +4006,7 @@ in the echo area or in a buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
`resize-mini-windows' is non-nil), it is shown there.
-Otherwise it is displayed in the buffer `shell-command-buffer-name'.
+Otherwise it is displayed in the buffer named by `shell-command-buffer-name'.
The output is available in that buffer in both cases.
If there is output and an error, a message about the error
@@ -3945,7 +4016,7 @@ Optional fourth arg OUTPUT-BUFFER specifies where to put
the
command's output. If the value is a buffer or buffer name,
erase that buffer and insert the output there; a non-nil value of
`shell-command-dont-erase-buffer' prevent to erase the buffer.
-If the value is nil, use the buffer `shell-command-buffer-name'.
+If the value is nil, use the buffer specified by `shell-command-buffer-name'.
Any other non-nil value means to insert the output in the
current buffer after START.
diff --git a/lisp/term/st.el b/lisp/term/st.el
new file mode 100644
index 0000000..617664b
--- /dev/null
+++ b/lisp/term/st.el
@@ -0,0 +1,20 @@
+;;; st.el --- terminal initialization for st -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;;; Commentary:
+
+;; Support for the st terminal emulator.
+;; https://st.suckless.org/
+
+;;; Code:
+
+(require 'term/xterm)
+
+(defun terminal-init-st ()
+ "Terminal initialization function for st."
+ (tty-run-terminal-initialization (selected-frame) "xterm"))
+
+(provide 'term/st)
+
+;; st.el ends here
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index e22e3f4..b097529 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -371,33 +371,50 @@ See `forward-paragraph' for more information."
(defun mark-paragraph (&optional arg allow-extend)
"Put point at beginning of this paragraph, mark at end.
-The paragraph marked is the one that contains point or follows point.
+The paragraph marked is the one that contains point or follows
+point.
-With argument ARG, puts mark at end of a following paragraph, so that
-the number of paragraphs marked equals ARG.
+With argument ARG, puts mark at the end of this or a following
+paragraph, so that the number of paragraphs marked equals ARG.
-If ARG is negative, point is put at end of this paragraph, mark is put
-at beginning of this or a previous paragraph.
+If ARG is negative, point is put at the end of this paragraph,
+mark is put at the beginning of this or a previous paragraph.
Interactively (or if ALLOW-EXTEND is non-nil), if this command is
-repeated or (in Transient Mark mode) if the mark is active,
-it marks the next ARG paragraphs after the ones already marked."
- (interactive "p\np")
- (unless arg (setq arg 1))
- (when (zerop arg)
- (error "Cannot mark zero paragraphs"))
- (cond ((and allow-extend
- (or (and (eq last-command this-command) (mark t))
- (and transient-mark-mode mark-active)))
- (set-mark
- (save-excursion
- (goto-char (mark))
- (forward-paragraph arg)
- (point))))
- (t
- (forward-paragraph arg)
- (push-mark nil t t)
- (backward-paragraph arg))))
+repeated or (in Transient Mark mode) if the mark is active, it
+marks the next ARG paragraphs after the region already marked.
+This also means when activating the mark immediately before using
+this command, the current paragraph is only marked from point."
+ (interactive "P\np")
+ (let ((numeric-arg (prefix-numeric-value arg)))
+ (cond ((zerop numeric-arg))
+ ((and allow-extend
+ (or (and (eq last-command this-command) mark-active)
+ (region-active-p)))
+ (if arg
+ (setq arg numeric-arg)
+ (if (< (mark) (point))
+ (setq arg -1)
+ (setq arg 1)))
+ (set-mark
+ (save-excursion
+ (goto-char (mark))
+ (forward-paragraph arg)
+ (point))))
+ ;; don't activate the mark when at eob
+ ((and (eobp) (> numeric-arg 0)))
+ (t
+ (unless (save-excursion
+ (forward-line 0)
+ (looking-at paragraph-start))
+ (backward-paragraph (cond ((> numeric-arg 0) 1)
+ ((< numeric-arg 0) -1)
+ (t 0))))
+ (push-mark
+ (save-excursion
+ (forward-paragraph numeric-arg)
+ (point))
+ t t)))))
(defun kill-paragraph (arg)
"Kill forward to end of paragraph.
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index e3d5759..a905d14 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -593,7 +593,7 @@ An alternative value is \" . \", if you use a font with a
narrow period."
;; Miscellany.
(slash "\\\\")
(opt " *\\(\\[[^]]*\\] *\\)*")
- (args "\\(\\(?:[^{}&\\]+\\|\\\\.\\|{[^}]*}\\)+\\)")
+ (args "\\(\\(?:[^${}&\\]+\\|\\\\.\\|{[^}]*}\\)+\\)")
(arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)"))
(list
;;
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 66378cb..b3bc634 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -482,6 +482,13 @@ Subexpression 1 is what goes into the corresponding `@end'
statement.")
(define-key map "\C-c\C-ce" 'texinfo-insert-@end)
(define-key map "\C-c\C-cd" 'texinfo-insert-@dfn)
(define-key map "\C-c\C-cc" 'texinfo-insert-@code)
+
+ ;; bindings for environment movement
+ (define-key map "\C-c." 'texinfo-to-environment-bounds)
+ (define-key map "\C-c\C-c\C-f" 'texinfo-next-environment-end)
+ (define-key map "\C-c\C-c\C-b" 'texinfo-previous-environment-end)
+ (define-key map "\C-c\C-c\C-n" 'texinfo-next-environment-start)
+ (define-key map "\C-c\C-c\C-p" 'texinfo-previous-environment-start)
map))
(easy-menu-define texinfo-mode-menu
@@ -1072,6 +1079,70 @@ You are prompted for the job number (use a number shown
by a previous
;; job-number"\n"))
(tex-recenter-output-buffer nil))
+(defun texinfo-to-environment-bounds ()
+ "Move point alternately to the start and end of a Texinfo environment.
+Do nothing when outside of an environment. This command does not
+handle nested environments."
+ (interactive)
+ (cond ((save-excursion
+ (forward-line 0)
+ (looking-at texinfo-environment-regexp))
+ (if (save-excursion
+ (forward-line 0)
+ (looking-at "^@end"))
+ (texinfo-previous-environment-start)
+ (texinfo-next-environment-end)))
+ ((save-excursion
+ (and (re-search-backward texinfo-environment-regexp nil t)
+ (not (looking-at "^@end"))))
+ (texinfo-previous-environment-start))
+ ;; Otherwise, point is outside of an environment, so do nothing.
+ ))
+
+(defun texinfo-next-environment-start ()
+ "Move forward to the beginning of a Texinfo environment."
+ (interactive)
+ (if (looking-at texinfo-environment-regexp)
+ (forward-line 1))
+ (while (and (re-search-forward texinfo-environment-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (looking-at "@end"))))
+ (if (save-excursion
+ (forward-line 0)
+ (looking-at texinfo-environment-regexp))
+ (forward-line 0)))
+
+(defun texinfo-previous-environment-start ()
+ "Move back to the beginning of the previous Texinfo environment."
+ (interactive)
+ (while (and (re-search-backward texinfo-environment-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (looking-at "@end")))))
+
+(defun texinfo-next-environment-end ()
+ "Move forward to the beginning of the next @end line of an environment."
+ (interactive)
+ (if (looking-at "^@end")
+ (forward-line 1))
+ (while (and (re-search-forward texinfo-environment-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (not (looking-at "^@end")))))
+ (if (save-excursion
+ (forward-line 0)
+ (looking-at "^@end"))
+ (forward-line 0)))
+
+(defun texinfo-previous-environment-end ()
+ "Move backward to the beginning of the next @end line of an environment."
+ (interactive)
+ (while (and (re-search-backward texinfo-environment-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (not (looking-at "@end"))))))
+
(provide 'texinfo)
;;; texinfo.el ends here
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 3311528..1c3607b 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -339,8 +339,7 @@ if it had been inserted from a file named URL."
(decode-coding-inserted-region (point-min) (point) url
visit beg end replace))
(let ((inserted (car size-and-charset)))
- (list url (or (and (fboundp 'after-insert-file-set-coding)
- (after-insert-file-set-coding inserted visit))
+ (list url (or (after-insert-file-set-coding inserted visit)
inserted))))))
;;;###autoload
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index da6509b..f5177bc 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -1513,21 +1513,6 @@ This default should work without changes."
(defsubst ediff-nonempty-string-p (string)
(and (stringp string) (not (string= string ""))))
-(unless (fboundp 'subst-char-in-string)
- (defun subst-char-in-string (fromchar tochar string &optional inplace)
- "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
-Unless optional argument INPLACE is non-nil, return a new string."
- (let ((i (length string))
- (newstr (if inplace string (copy-sequence string))))
- (while (> i 0)
- (setq i (1- i))
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr)))
-
-(unless (fboundp 'format-message)
- (defalias 'format-message 'format))
-
(defun ediff-abbrev-jobname (jobname)
(cond ((eq jobname 'ediff-directories)
"Compare two directories")
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index e0cf9e7..78a2fa0 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -243,7 +243,7 @@ toggle display of the entire list."
;; path specs.
;; See also: http://marc.info/?l=git&m=125787684318129&w=2
(name (file-relative-name file dir))
- (str (ignore-errors
+ (str (with-demoted-errors "Error: %S"
(cd dir)
(vc-git--out-ok "ls-files" "-c" "-z" "--" name)
;; If result is empty, use ls-tree to check for deleted
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index db127ee..4eb6389 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -146,6 +146,20 @@ For a description of possible values, see
`vc-check-master-templates'."
(progn
(defun vc-src-registered (f) (vc-default-registered 'src f)))
+(defun vc-src--parse-state (out)
+ (when (null (string-match "does not exist or is unreadable" out))
+ (let ((state (aref out 0)))
+ (cond
+ ;; FIXME: What to do about L code?
+ ((eq state ?.) 'up-to-date)
+ ((eq state ?A) 'added)
+ ((eq state ?M) 'edited)
+ ((eq state ?I) 'ignored)
+ ((eq state ?R) 'removed)
+ ((eq state ?!) 'missing)
+ ((eq state ??) 'unregistered)
+ (t 'up-to-date)))))
+
(defun vc-src-state (file)
"SRC-specific version of `vc-state'."
(let*
@@ -163,32 +177,41 @@ For a description of possible values, see
`vc-check-master-templates'."
"status" "-a" (file-relative-name file))
(error nil)))))))
(when (eq 0 status)
- (when (null (string-match "does not exist or is unreadable" out))
- (let ((state (aref out 0)))
- (cond
- ;; FIXME: What to do about A and L codes?
- ((eq state ?.) 'up-to-date)
- ((eq state ?A) 'added)
- ((eq state ?M) 'edited)
- ((eq state ?I) 'ignored)
- ((eq state ?R) 'removed)
- ((eq state ?!) 'missing)
- ((eq state ??) 'unregistered)
- (t 'up-to-date)))))))
+ (vc-src--parse-state out))))
(autoload 'vc-expand-dirs "vc")
(defun vc-src-dir-status-files (dir files update-function)
- ;; FIXME: Use one src status -a call for this
- (if (not files) (setq files (vc-expand-dirs (list dir) 'SRC)))
- (let ((result nil))
- (dolist (file files)
- (let ((state (vc-state file))
- (frel (file-relative-name file)))
- (when (and (eq (vc-backend file) 'SRC)
- (not (eq state 'up-to-date)))
- (push (list frel state) result))))
- (funcall update-function result)))
+ (let* ((result nil)
+ (status nil)
+ (default-directory (or dir default-directory))
+ (out
+ (with-output-to-string
+ (with-current-buffer standard-output
+ (setq status
+ (ignore-errors
+ (apply
+ #'process-file vc-src-program nil t nil
+ "status" "-a"
+ (mapcar #'file-relative-name files)))))))
+ dlist)
+ (when (eq 0 status)
+ (dolist (line (split-string out "[\n\r]" t))
+ (let* ((pair (split-string line "[\t]" t))
+ (state (vc-src--parse-state (car pair)))
+ (frel (cadr pair)))
+ (if (file-directory-p frel)
+ (push frel dlist)
+ (when (not (eq state 'up-to-date))
+ (push (list frel state) result)))))
+ (dolist (drel dlist)
+ (let ((dresult (vc-src-dir-status-files
+ (expand-file-name drel) nil #'identity)))
+ (dolist (dres dresult)
+ (push (list (concat (file-name-as-directory drel) (car dres))
+ (cadr dres))
+ result))))
+ (funcall update-function result))))
(defun vc-src-command (buffer file-or-list &rest flags)
"A wrapper around `vc-do-command' for use in vc-src.el.
diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el
index 7552fbb..1e81dd2 100644
--- a/lisp/vt100-led.el
+++ b/lisp/vt100-led.el
@@ -1,4 +1,4 @@
-;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones
+;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones
-*- lexical-binding:t -*-
;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 42c4b61..8a1bb8a 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -262,7 +262,7 @@
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; code:
+;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index aed6c09..0743208 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -41,7 +41,10 @@
(declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height))
(declare-function xwidget-webkit-execute-script "xwidget.c"
(xwidget script &optional callback))
+(declare-function xwidget-webkit-uri "xwidget.c" (xwidget))
+(declare-function xwidget-webkit-title "xwidget.c" (xwidget))
(declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri))
+(declare-function xwidget-webkit-goto-history "xwidget.c" (xwidget rel-pos))
(declare-function xwidget-webkit-zoom "xwidget.c" (xwidget factor))
(declare-function xwidget-plist "xwidget.c" (xwidget))
(declare-function set-xwidget-plist "xwidget.c" (xwidget plist))
@@ -51,6 +54,10 @@
(declare-function get-buffer-xwidgets "xwidget.c" (buffer))
(declare-function xwidget-query-on-exit-flag "xwidget.c" (xwidget))
+(defgroup xwidget nil
+ "Displaying native widgets in Emacs buffers."
+ :group 'widgets)
+
(defun xwidget-insert (pos type title width height &optional args)
"Insert an xwidget at position POS.
Supply the xwidget's TYPE, TITLE, WIDTH, and HEIGHT.
@@ -78,6 +85,8 @@ This returns the result of `make-xwidget'."
;;; webkit support
(require 'browse-url)
(require 'image-mode);;for some image-mode alike functionality
+(require 'seq)
+(require 'url-handlers)
;;;###autoload
(defun xwidget-webkit-browse-url (url &optional new-session)
@@ -99,6 +108,24 @@ Interactively, URL defaults to the string looking like a
url around point."
(xwidget-webkit-new-session url)
(xwidget-webkit-goto-url url))))
+(defun xwidget-webkit-clone-and-split-below ()
+ "Clone current URL into a new widget place in new window below.
+Get the URL of current session, then browse to the URL
+in `split-window-below' with a new xwidget webkit session."
+ (interactive)
+ (let ((url (xwidget-webkit-current-url)))
+ (with-selected-window (split-window-below)
+ (xwidget-webkit-new-session url))))
+
+(defun xwidget-webkit-clone-and-split-right ()
+ "Clone current URL into a new widget place in new window right.
+Get the URL of current session, then browse to the URL
+in `split-window-right' with a new xwidget webkit session."
+ (interactive)
+ (let ((url (xwidget-webkit-current-url)))
+ (with-selected-window (split-window-right)
+ (xwidget-webkit-new-session url))))
+
;;todo.
;; - check that the webkit support is compiled in
(defvar xwidget-webkit-mode-map
@@ -106,6 +133,7 @@ Interactively, URL defaults to the string looking like a
url around point."
(define-key map "g" 'xwidget-webkit-browse-url)
(define-key map "a" 'xwidget-webkit-adjust-size-dispatch)
(define-key map "b" 'xwidget-webkit-back)
+ (define-key map "f" 'xwidget-webkit-forward)
(define-key map "r" 'xwidget-webkit-reload)
(define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!?
(define-key map "\C-m" 'xwidget-webkit-insert-string)
@@ -115,20 +143,21 @@ Interactively, URL defaults to the string looking like a
url around point."
;;similar to image mode bindings
(define-key map (kbd "SPC") 'xwidget-webkit-scroll-up)
+ (define-key map (kbd "S-SPC") 'xwidget-webkit-scroll-down)
(define-key map (kbd "DEL") 'xwidget-webkit-scroll-down)
- (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up)
+ (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up-line)
(define-key map [remap scroll-up-command] 'xwidget-webkit-scroll-up)
- (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down)
+ (define-key map [remap scroll-down]
'xwidget-webkit-scroll-down-line)
(define-key map [remap scroll-down-command] 'xwidget-webkit-scroll-down)
(define-key map [remap forward-char] 'xwidget-webkit-scroll-forward)
(define-key map [remap backward-char]
'xwidget-webkit-scroll-backward)
(define-key map [remap right-char] 'xwidget-webkit-scroll-forward)
(define-key map [remap left-char]
'xwidget-webkit-scroll-backward)
- (define-key map [remap previous-line] 'xwidget-webkit-scroll-down)
- (define-key map [remap next-line] 'xwidget-webkit-scroll-up)
+ (define-key map [remap previous-line]
'xwidget-webkit-scroll-down-line)
+ (define-key map [remap next-line] 'xwidget-webkit-scroll-up-line)
;; (define-key map [remap move-beginning-of-line] 'image-bol)
;; (define-key map [remap move-end-of-line] 'image-eol)
@@ -147,33 +176,63 @@ Interactively, URL defaults to the string looking like a
url around point."
(interactive)
(xwidget-webkit-zoom (xwidget-webkit-current-session) -0.1))
-(defun xwidget-webkit-scroll-up ()
- "Scroll webkit up."
- (interactive)
+(defun xwidget-webkit-scroll-up (&optional arg)
+ "Scroll webkit up by ARG pixels; or full window height if no ARG.
+Stop if bottom of page is reached.
+Interactively, ARG is the prefix numeric argument.
+Negative ARG scrolls down."
+ (interactive "P")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollBy(0, 50);"))
-
-(defun xwidget-webkit-scroll-down ()
- "Scroll webkit down."
- (interactive)
+ (format "window.scrollBy(0, %d);"
+ (or arg (xwidget-window-inside-pixel-height (selected-window))))))
+
+(defun xwidget-webkit-scroll-down (&optional arg)
+ "Scroll webkit down by ARG pixels; or full window height if no ARG.
+Stop if top of page is reached.
+Interactively, ARG is the prefix numeric argument.
+Negative ARG scrolls up."
+ (interactive "P")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollBy(0, -50);"))
-
-(defun xwidget-webkit-scroll-forward ()
- "Scroll webkit forwards."
- (interactive)
+ (format "window.scrollBy(0, -%d);"
+ (or arg (xwidget-window-inside-pixel-height (selected-window))))))
+
+(defun xwidget-webkit-scroll-up-line (&optional n)
+ "Scroll webkit up by N lines.
+The height of line is calculated with `window-font-height'.
+Stop if the bottom edge of the page is reached.
+If N is omitted or nil, scroll up by one line."
+ (interactive "p")
+ (xwidget-webkit-scroll-up (* n (window-font-height))))
+
+(defun xwidget-webkit-scroll-down-line (&optional n)
+ "Scroll webkit down by N lines.
+The height of line is calculated with `window-font-height'.
+Stop if the top edge of the page is reached.
+If N is omitted or nil, scroll down by one line."
+ (interactive "p")
+ (xwidget-webkit-scroll-down (* n (window-font-height))))
+
+(defun xwidget-webkit-scroll-forward (&optional n)
+ "Scroll webkit horizontally by N chars.
+The width of char is calculated with `window-font-width'.
+If N is ommited or nil, scroll forwards by one char."
+ (interactive "p")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollBy(50, 0);"))
-
-(defun xwidget-webkit-scroll-backward ()
- "Scroll webkit backwards."
- (interactive)
+ (format "window.scrollBy(%d, 0);"
+ (* n (window-font-width)))))
+
+(defun xwidget-webkit-scroll-backward (&optional n)
+ "Scroll webkit back by N chars.
+The width of char is calculated with `window-font-width'.
+If N is ommited or nil, scroll backwards by one char."
+ (interactive "p")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollBy(-50, 0);"))
+ (format "window.scrollBy(-%d, 0);"
+ (* n (window-font-width)))))
(defun xwidget-webkit-scroll-top ()
"Scroll webkit to the very top."
@@ -187,7 +246,7 @@ Interactively, URL defaults to the string looking like a
url around point."
(interactive)
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollTo(pageXOffset, window.document.body.clientHeight);"))
+ "window.scrollTo(pageXOffset, window.document.body.scrollHeight);"))
;; The xwidget event needs to go into a higher level handler
;; since the xwidget can generate an event even if it's offscreen.
@@ -207,12 +266,8 @@ Interactively, URL defaults to the string looking like a
url around point."
(let*
((xwidget-event-type (nth 1 last-input-event))
(xwidget (nth 2 last-input-event))
- ;;(xwidget-callback (xwidget-get xwidget 'callback))
- ;;TODO stopped working for some reason
- )
- ;;(funcall xwidget-callback xwidget xwidget-event-type)
- (message "xw callback %s" xwidget)
- (funcall 'xwidget-webkit-callback xwidget xwidget-event-type)))
+ (xwidget-callback (xwidget-get xwidget 'callback)))
+ (funcall xwidget-callback xwidget xwidget-event-type)))
(defun xwidget-webkit-callback (xwidget xwidget-event-type)
"Callback for xwidgets.
@@ -222,21 +277,23 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the
originating xwidget."
"error: callback called for xwidget with dead buffer")
(with-current-buffer (xwidget-buffer xwidget)
(cond ((eq xwidget-event-type 'load-changed)
- (xwidget-webkit-execute-script
- xwidget "document.title"
- (lambda (title)
- (xwidget-log "webkit finished loading: '%s'" title)
- ;;TODO - check the native/internal scroll
- ;;(xwidget-adjust-size-to-content xwidget)
- (xwidget-webkit-adjust-size-to-window xwidget)
- (rename-buffer (format "*xwidget webkit: %s *" title))))
- (pop-to-buffer (current-buffer)))
+ (let ((title (xwidget-webkit-title xwidget)))
+ (xwidget-log "webkit finished loading: %s" title)
+ ;; Do not adjust webkit size to window here, the selected window
+ ;; can be the mini-buffer window unwantedly.
+ (rename-buffer (format "*xwidget webkit: %s *" title) t)))
((eq xwidget-event-type 'decide-policy)
(let ((strarg (nth 3 last-input-event)))
(if (string-match ".*#\\(.*\\)" strarg)
(xwidget-webkit-show-id-or-named-element
xwidget
(match-string 1 strarg)))))
+ ;; TODO: Response handling other than download.
+ ((eq xwidget-event-type 'download-callback)
+ (let ((url (nth 3 last-input-event))
+ (mime-type (nth 4 last-input-event))
+ (file-name (nth 5 last-input-event)))
+ (xwidget-webkit-save-as-file url mime-type file-name)))
((eq xwidget-event-type 'javascript-callback)
(let ((proc (nth 3 last-input-event))
(arg (nth 4 last-input-event)))
@@ -244,21 +301,66 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the
originating xwidget."
(t (xwidget-log "unhandled event:%s" xwidget-event-type))))))
(defvar bookmark-make-record-function)
+(when (memq window-system '(mac ns))
+ (defvar xwidget-webkit-enable-plugins nil
+ "Enable plugins for xwidget webkit.
+If non-nil, plugins are enabled. Otherwise, disabled."))
+
(define-derived-mode xwidget-webkit-mode
- special-mode "xwidget-webkit" "Xwidget webkit view mode."
- (setq buffer-read-only t)
- (setq-local bookmark-make-record-function
- #'xwidget-webkit-bookmark-make-record)
- ;; Keep track of [vh]scroll when switching buffers
- (image-mode-setup-winprops))
+ special-mode "xwidget-webkit" "Xwidget webkit view mode."
+ (setq buffer-read-only t)
+ (setq-local bookmark-make-record-function
+ #'xwidget-webkit-bookmark-make-record)
+ ;; Keep track of [vh]scroll when switching buffers
+ (image-mode-setup-winprops))
+
+;;; Download, save as file.
+
+(defcustom xwidget-webkit-download-dir "~/Downloads/"
+ "Directory where download file saved."
+ :version "27.1"
+ :type 'file)
+
+(defun xwidget-webkit-save-as-file (url mime-type file-name)
+ "For XWIDGET webkit, save URL of MIME-TYPE to location specified by user.
+FILE-NAME combined with `xwidget-webkit-download-dir' is the default file name
+of the prompt when reading. When the file name the user specified is a
+directory, URL is saved at the specified directory as FILE-NAME."
+ (let ((save-name (read-file-name
+ (format "Save URL `%s' of type `%s' in file/directory: "
+ url mime-type)
+ xwidget-webkit-download-dir
+ (when file-name
+ (expand-file-name
+ file-name
+ xwidget-webkit-download-dir)))))
+ (if (file-directory-p save-name)
+ (setq save-name
+ (expand-file-name (file-name-nondirectory file-name) save-name)))
+ (setq xwidget-webkit-download-dir (file-name-directory save-name))
+ (url-copy-file url save-name t)))
+
+;;; Bookmarks integration
+
+(defcustom xwidget-webkit-bookmark-jump-new-session nil
+ "Control bookmark jump to use new session or not.
+If non-nil, use a new xwidget webkit session after bookmark jump.
+Otherwise, it will use `xwidget-webkit-last-session'.
+When you set this variable to nil, consider further customization with
+`xwidget-webkit-last-session-buffer'."
+ :version "27.1"
+ :type 'boolean)
(defun xwidget-webkit-bookmark-make-record ()
- "Integrate Emacs bookmarks with the webkit xwidget."
+ "Create bookmark record in webkit xwidget."
(nconc (bookmark-make-record-default t t)
- `((page . ,(xwidget-webkit-current-url))
- (handler . (lambda (bmk) (browse-url
- (bookmark-prop-get bmk 'page)))))))
+ `((page . ,(xwidget-webkit-uri (xwidget-webkit-current-session)))
+ (handler . (lambda (bmk)
+ (xwidget-webkit-browse-url
+ (bookmark-prop-get bmk 'page)
+ xwidget-webkit-bookmark-jump-new-session))))))
+;;; xwidget webkit session
(defvar xwidget-webkit-last-session-buffer nil)
@@ -306,7 +408,7 @@ function findactiveelement(doc){
"
- "javascript that finds the active element."
+ "Javascript that finds the active element."
;; Yes it's ugly, because:
;; - there is apparently no way to find the active frame other than recursion
;; - the js "for each" construct misbehaved on the "frames" collection
@@ -316,19 +418,22 @@ function findactiveelement(doc){
)
(defun xwidget-webkit-insert-string ()
- "Prompt for a string and insert it in the active field in the
-current webkit widget."
+ "Insert string into the active field in the current webkit widget."
;; Read out the string in the field first and provide for edit.
(interactive)
+ ;; As the prompt differs on JavaScript execution results,
+ ;; the function must handle the prompt itself.
(let ((xww (xwidget-webkit-current-session)))
(xwidget-webkit-execute-script
xww
(concat xwidget-webkit-activeelement-js "
(function () {
var res = findactiveelement(document);
- return [res.value, res.type];
+ if (res)
+ return [res.value, res.type];
})();")
(lambda (field)
+ "Prompt a string for the FIELD and insert in the active input."
(let ((str (pcase field
(`[,val "text"]
(read-string "Text: " val))
@@ -447,11 +552,23 @@ For example, use this to display an anchor."
(ignore-errors
(recenter-top-bottom)))
+;; Utility functions
+
+(defun xwidget-window-inside-pixel-width (window)
+ "Return Emacs WINDOW body width in pixel."
+ (let ((edges (window-inside-pixel-edges window)))
+ (- (nth 2 edges) (nth 0 edges))))
+
+(defun xwidget-window-inside-pixel-height (window)
+ "Return Emacs WINDOW body height in pixel."
+ (let ((edges (window-inside-pixel-edges window)))
+ (- (nth 3 edges) (nth 1 edges))))
+
(defun xwidget-webkit-adjust-size-to-window (xwidget &optional window)
"Adjust the size of the webkit XWIDGET to fit the WINDOW."
(xwidget-resize xwidget
- (window-pixel-width window)
- (window-pixel-height window)))
+ (xwidget-window-inside-pixel-width window)
+ (xwidget-window-inside-pixel-height window)))
(defun xwidget-webkit-adjust-size (w h)
"Manually set webkit size to width W, height H."
@@ -481,51 +598,56 @@ For example, use this to display an anchor."
(add-to-list 'window-size-change-functions
'xwidget-webkit-adjust-size-in-frame))
-(defun xwidget-webkit-new-session (url)
+(defun xwidget-webkit-new-session (url &optional callback)
"Create a new webkit session buffer with URL."
(let*
((bufname (generate-new-buffer-name "*xwidget-webkit*"))
+ (callback (or callback #'xwidget-webkit-callback))
xw)
(setq xwidget-webkit-last-session-buffer (switch-to-buffer
(get-buffer-create bufname)))
;; The xwidget id is stored in a text property, so we need to have
;; at least character in this buffer.
- (insert " ")
- (setq xw (xwidget-insert 1 'webkit bufname
- (window-pixel-width)
- (window-pixel-height)))
- (xwidget-put xw 'callback 'xwidget-webkit-callback)
+ ;; Insert invisible url, good default for next `g' to browse url.
+ (let ((start (point)))
+ (insert url)
+ (put-text-property start (+ start (length url)) 'invisible t)
+ (setq xw (xwidget-insert
+ start 'webkit bufname
+ (xwidget-window-inside-pixel-width (selected-window))
+ (xwidget-window-inside-pixel-height (selected-window)))))
+ (xwidget-put xw 'callback callback)
(xwidget-webkit-mode)
(xwidget-webkit-goto-uri (xwidget-webkit-last-session) url)))
(defun xwidget-webkit-goto-url (url)
- "Goto URL."
+ "Goto URL with xwidget webkit."
(if (xwidget-webkit-current-session)
(progn
(xwidget-webkit-goto-uri (xwidget-webkit-current-session) url))
(xwidget-webkit-new-session url)))
(defun xwidget-webkit-back ()
- "Go back in history."
+ "Go back to previous URL in xwidget webkit buffer."
(interactive)
- (xwidget-webkit-execute-script (xwidget-webkit-current-session)
- "history.go(-1);"))
+ (xwidget-webkit-goto-history (xwidget-webkit-current-session) -1))
+
+(defun xwidget-webkit-forward ()
+ "Go forward in history."
+ (interactive)
+ (xwidget-webkit-goto-history (xwidget-webkit-current-session) 1))
(defun xwidget-webkit-reload ()
- "Reload current url."
+ "Reload current URL."
(interactive)
- (xwidget-webkit-execute-script (xwidget-webkit-current-session)
- "history.go(0);"))
+ (xwidget-webkit-goto-history (xwidget-webkit-current-session) 0))
(defun xwidget-webkit-current-url ()
- "Get the webkit url and place it on the kill-ring."
+ "Display the current xwidget webkit URL and place it on the `kill-ring'."
(interactive)
- (xwidget-webkit-execute-script
- (xwidget-webkit-current-session)
- "document.URL" (lambda (rv)
- (let ((url (kill-new (or rv ""))))
- (message "url: %s" url)))))
+ (let ((url (xwidget-webkit-uri (xwidget-webkit-current-session))))
+ (message "URL: %s" (kill-new (or url "")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun xwidget-webkit-get-selection (proc)
@@ -536,10 +658,9 @@ For example, use this to display an anchor."
proc))
(defun xwidget-webkit-copy-selection-as-kill ()
- "Get the webkit selection and put it on the kill-ring."
+ "Get the webkit selection and put it on the `kill-ring'."
(interactive)
- (xwidget-webkit-get-selection (lambda (selection) (kill-new selection))))
-
+ (xwidget-webkit-get-selection #'kill-new))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Xwidget plist management (similar to the process plist functions)
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 50acc0a..03da228 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,4 +1,4 @@
-# gnulib-common.m4 serial 53
+# gnulib-common.m4 serial 55
dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -45,7 +45,7 @@ AC_DEFUN([gl_COMMON_BODY], [
? 6000000 <= __apple_build_version__ \
: 3 < __clang_major__ + (5 <= __clang_minor__))))
/* _Noreturn works as-is. */
-# elif _GL_GNUC_PREREQ (2, 8) || 0x5110 <= __SUNPRO_C
+# elif _GL_GNUC_PREREQ (2, 8) || defined __clang__ || 0x5110 <= __SUNPRO_C
# define _Noreturn __attribute__ ((__noreturn__))
# elif 1200 <= (defined _MSC_VER ? _MSC_VER : 0)
# define _Noreturn __declspec (noreturn)
@@ -76,6 +76,7 @@ AC_DEFUN([gl_COMMON_BODY], [
# define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3)
# define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95)
# define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1)
+# define _GL_ATTR_diagnose_if 0
# define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3)
# define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1)
# define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0)
@@ -149,6 +150,9 @@ AC_DEFUN([gl_COMMON_BODY], [
#if _GL_HAS_ATTRIBUTE (error)
# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__error__ (msg)))
# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__warning__ (msg)))
+#elif _GL_HAS_ATTRIBUTE (diagnose_if)
+# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__diagnose_if__ (1, msg,
"error")))
+# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__diagnose_if__ (1, msg,
"warning")))
#else
# define _GL_ATTRIBUTE_ERROR(msg)
# define _GL_ATTRIBUTE_WARNING(msg)
diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4
index 6bcfadb..d8bc8ff 100644
--- a/m4/stddef_h.m4
+++ b/m4/stddef_h.m4
@@ -1,5 +1,5 @@
dnl A placeholder for <stddef.h>, for platforms that have issues.
-# stddef_h.m4 serial 6
+# stddef_h.m4 serial 7
dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -19,7 +19,7 @@ AC_DEFUN([gl_STDDEF_H],
[AC_LANG_PROGRAM(
[[#include <stddef.h>
unsigned int s = sizeof (max_align_t);
- #if defined __GNUC__ || defined __IBM__ALIGNOF__
+ #if defined __GNUC__ || defined __clang__ || defined
__IBM__ALIGNOF__
int check1[2 * (__alignof__ (double) <= __alignof__ (max_align_t))
- 1];
int check2[2 * (__alignof__ (long double) <= __alignof__
(max_align_t)) - 1];
#endif
diff --git a/m4/stdint.m4 b/m4/stdint.m4
index 29ad826..e0fa8a5 100644
--- a/m4/stdint.m4
+++ b/m4/stdint.m4
@@ -1,4 +1,4 @@
-# stdint.m4 serial 54
+# stdint.m4 serial 55
dnl Copyright (C) 2001-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -152,7 +152,7 @@ uintmax_t j = UINTMAX_MAX;
/* Check that SIZE_MAX has the correct type, if possible. */
#if 201112 <= __STDC_VERSION__
int k = _Generic (SIZE_MAX, size_t: 0);
-#elif (2 <= __GNUC__ || defined __IBM__TYPEOF__ \
+#elif (2 <= __GNUC__ || 4 <= __clang_major__ || defined __IBM__TYPEOF__ \
|| (0x5110 <= __SUNPRO_C && !__STDC__))
extern size_t k;
extern __typeof__ (SIZE_MAX) k;
diff --git a/nextstep/templates/Info.plist.in b/nextstep/templates/Info.plist.in
index f791ade..1f074b0 100644
--- a/nextstep/templates/Info.plist.in
+++ b/nextstep/templates/Info.plist.in
@@ -675,8 +675,16 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>.
</array>
<key>NSAppleScriptEnabled</key>
<string>YES</string>
- <key>NSAppleEventsUsageDescription</key>
- <string>Emacs requires permission to send AppleEvents to other
applications.</string>
+ <key>NSAppleEventsUsageDescription</key>
+ <string>Emacs requires permission to send AppleEvents to other
applications.</string>
+ <!-- For xwidget webkit to browse remote url,
+ but this set no restriction at all. Consult apple's documentation
+ for detail information about `NSApplicationDefinedMask'. -->
+ <key>NSAppTransportSecurity</key>
+ <dict>
+ <key>NSAllowsArbitraryLoads</key>
+ <true/>
+ </dict>
<key>NSDesktopFolderUsageDescription</key>
<string>Emacs requires permission to access the Desktop
folder.</string>
<key>NSDocumentsFolderUsageDescription</key>
diff --git a/src/Makefile.in b/src/Makefile.in
index 3cc9d59..63a4aa8 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -438,6 +438,7 @@ SOME_MACHINE_OBJECTS = dosfns.o msdos.o \
xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o fringe.o image.o \
fontset.o dbusbind.o cygw32.o \
nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o macfont.o \
+ nsxwidget.o \
w32.o w32console.o w32cygwinx.o w32fns.o w32heap.o w32inevt.o w32notify.o \
w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \
w16select.o widget.o xfont.o ftfont.o xftfont.o gtkutil.o \
diff --git a/src/bytecode.c b/src/bytecode.c
index 1913a48..1c3b6ea 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1401,7 +1401,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector,
Lisp_Object maxdepth,
Lisp_Object v1 = POP;
ptrdiff_t i;
struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table);
- hash_rehash_if_needed (h);
/* h->count is a faster approximation for HASH_TABLE_SIZE (h)
here. */
diff --git a/src/composite.c b/src/composite.c
index f96f0b7..ec2b832 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -652,7 +652,6 @@ Lisp_Object
composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len)
{
struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
- hash_rehash_if_needed (h);
Lisp_Object header = LGSTRING_HEADER (gstring);
Lisp_Object hash = h->test.hashfn (header, h);
if (len < 0)
diff --git a/src/emacs.c b/src/emacs.c
index 8c25227..288ddb4 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1551,6 +1551,7 @@ Using an Emacs configured with --with-x-toolkit=lucid
does not have this problem
if (!initialized)
{
init_alloc_once ();
+ init_pdumper_once ();
init_obarray_once ();
init_eval_once ();
init_charset_once ();
@@ -1877,7 +1878,6 @@ Using an Emacs configured with --with-x-toolkit=lucid
does not have this problem
syms_of_xfns ();
syms_of_xmenu ();
syms_of_fontset ();
- syms_of_xwidget ();
syms_of_xsettings ();
#ifdef HAVE_X_SM
syms_of_xsmfns ();
@@ -1954,6 +1954,7 @@ Using an Emacs configured with --with-x-toolkit=lucid
does not have this problem
#endif /* HAVE_W32NOTIFY */
#endif /* WINDOWSNT */
+ syms_of_xwidget ();
syms_of_threads ();
syms_of_profiler ();
syms_of_pdumper ();
diff --git a/src/fns.c b/src/fns.c
index 811d6e8..9199178 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4248,50 +4248,31 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
/* Recompute the hashes (and hence also the "next" pointers).
Normally there's never a need to recompute hashes.
- This is done only on first-access to a hash-table loaded from
- the "pdump", because the object's addresses may have changed, thus
- affecting their hash. */
+ This is done only on first access to a hash-table loaded from
+ the "pdump", because the objects' addresses may have changed, thus
+ affecting their hashes. */
void
-hash_table_rehash (struct Lisp_Hash_Table *h)
+hash_table_rehash (Lisp_Object hash)
{
- ptrdiff_t size = HASH_TABLE_SIZE (h);
-
- /* These structures may have been purecopied and shared
- (bug#36447). */
- Lisp_Object hash = make_nil_vector (size);
- h->next = Fcopy_sequence (h->next);
- h->index = Fcopy_sequence (h->index);
+ struct Lisp_Hash_Table *h = XHASH_TABLE (hash);
+ ptrdiff_t i, count = h->count;
/* Recompute the actual hash codes for each entry in the table.
Order is still invalid. */
- for (ptrdiff_t i = 0; i < size; ++i)
+ for (i = 0; i < count; i++)
{
Lisp_Object key = HASH_KEY (h, i);
- if (!EQ (key, Qunbound))
- ASET (hash, i, h->test.hashfn (key, h));
+ Lisp_Object hash_code = h->test.hashfn (key, h);
+ ptrdiff_t start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index);
+ set_hash_hash_slot (h, i, hash_code);
+ set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
+ set_hash_index_slot (h, start_of_bucket, i);
+ eassert (HASH_NEXT (h, i) != i); /* Stop loops. */
}
- /* Reset the index so that any slot we don't fill below is marked
- invalid. */
- Ffillarray (h->index, make_fixnum (-1));
-
- /* Rebuild the collision chains. */
- for (ptrdiff_t i = 0; i < size; ++i)
- if (!NILP (AREF (hash, i)))
- {
- EMACS_UINT hash_code = XUFIXNUM (AREF (hash, i));
- ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index);
- set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
- set_hash_index_slot (h, start_of_bucket, i);
- eassert (HASH_NEXT (h, i) != i); /* Stop loops. */
- }
-
- /* Finally, mark the hash table as having a valid hash order.
- Do this last so that if we're interrupted, we retry on next
- access. */
- eassert (hash_rehash_needed_p (h));
- h->hash = hash;
- eassert (!hash_rehash_needed_p (h));
+ ptrdiff_t size = ASIZE (h->next);
+ for (; i + 1 < size; i++)
+ set_hash_next_slot (h, i, i + 1);
}
/* Lookup KEY in hash table H. If HASH is non-null, return in *HASH
@@ -4303,8 +4284,6 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key,
Lisp_Object *hash)
{
ptrdiff_t start_of_bucket, i;
- hash_rehash_if_needed (h);
-
Lisp_Object hash_code = h->test.hashfn (key, h);
if (hash)
*hash = hash_code;
@@ -4339,8 +4318,6 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key,
Lisp_Object value,
{
ptrdiff_t start_of_bucket, i;
- hash_rehash_if_needed (h);
-
/* Increment count after resizing because resizing may fail. */
maybe_resize_hash_table (h);
h->count++;
@@ -4373,8 +4350,6 @@ hash_remove_from_table (struct Lisp_Hash_Table *h,
Lisp_Object key)
ptrdiff_t start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index);
ptrdiff_t prev = -1;
- hash_rehash_if_needed (h);
-
for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket);
0 <= i;
i = HASH_NEXT (h, i))
@@ -4415,8 +4390,7 @@ hash_clear (struct Lisp_Hash_Table *h)
if (h->count > 0)
{
ptrdiff_t size = HASH_TABLE_SIZE (h);
- if (!hash_rehash_needed_p (h))
- memclear (xvector_contents (h->hash), size * word_size);
+ memclear (xvector_contents (h->hash), size * word_size);
for (ptrdiff_t i = 0; i < size; i++)
{
set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);
@@ -4452,9 +4426,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool
remove_entries_p)
for (ptrdiff_t bucket = 0; bucket < n; ++bucket)
{
/* Follow collision chain, removing entries that don't survive
- this garbage collection. It's okay if hash_rehash_needed_p
- (h) is true, since we're operating entirely on the cached
- hash values. */
+ this garbage collection. */
ptrdiff_t prev = -1;
ptrdiff_t next;
for (ptrdiff_t i = HASH_INDEX (h, bucket); 0 <= i; i = next)
@@ -4499,7 +4471,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool
remove_entries_p)
set_hash_hash_slot (h, i, Qnil);
eassert (h->count != 0);
- h->count += h->count > 0 ? -1 : 1;
+ h->count--;
}
else
{
@@ -4923,7 +4895,6 @@ DEFUN ("hash-table-count", Fhash_table_count,
Shash_table_count, 1, 1, 0,
(Lisp_Object table)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
- eassert (h->count >= 0);
return make_fixnum (h->count);
}
diff --git a/src/json.c b/src/json.c
index 814afc6..8c95836 100644
--- a/src/json.c
+++ b/src/json.c
@@ -479,9 +479,7 @@ lisp_to_json (Lisp_Object lisp, struct json_configuration
*conf)
{
intmax_t low = TYPE_MINIMUM (json_int_t);
intmax_t high = TYPE_MAXIMUM (json_int_t);
- intmax_t value;
- if (! (integer_to_intmax (lisp, &value) && low <= value && value <=
high))
- args_out_of_range_3 (lisp, make_int (low), make_int (high));
+ intmax_t value = check_integer_range (lisp, low, high);
return json_check (json_integer (value));
}
else if (FLOATP (lisp))
diff --git a/src/lisp.h b/src/lisp.h
index 75ef6d3..5f913b7 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2286,11 +2286,7 @@ struct hash_table_test
struct Lisp_Hash_Table
{
- /* Change pdumper.c if you change the fields here.
-
- IMPORTANT!!!!!!!
-
- Call hash_rehash_if_needed() before accessing. */
+ /* Change pdumper.c if you change the fields here. */
/* This is for Lisp; the hash table code does not refer to it. */
union vectorlike_header header;
@@ -2409,20 +2405,7 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
return size;
}
-void hash_table_rehash (struct Lisp_Hash_Table *h);
-
-INLINE bool
-hash_rehash_needed_p (const struct Lisp_Hash_Table *h)
-{
- return NILP (h->hash);
-}
-
-INLINE void
-hash_rehash_if_needed (struct Lisp_Hash_Table *h)
-{
- if (hash_rehash_needed_p (h))
- hash_table_rehash (h);
-}
+void hash_table_rehash (Lisp_Object);
/* Default size for hash tables if not specified. */
@@ -3975,7 +3958,8 @@ make_uninit_sub_char_table (int depth, int min_char)
return v;
}
-/* Make a vector of SIZE nils. */
+/* Make a vector of SIZE nils - faster than make_vector (size, Qnil)
+ if the OS already cleared the new memory. */
INLINE Lisp_Object
make_nil_vector (ptrdiff_t size)
diff --git a/src/macfont.m b/src/macfont.m
index 21bc7dd..c7430d3 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -1120,7 +1120,10 @@ struct macfont_metrics
glyph width. The `width_int' member is an integer that is
closest to the width. The `width_frac' member is the fractional
adjustment representing a value in [-.5, .5], multiplied by
- WIDTH_FRAC_SCALE. For synthetic monospace fonts, they represent
+ WIDTH_FRAC_SCALE. For monospace fonts, non-zero `width_frac'
+ means `width_int' is further adjusted to a multiple of the
+ (rounded) font width, and `width_frac' represents adjustment per
+ unit character. For synthetic monospace fonts, they represent
the advance delta for centering instead of the glyph width. */
signed width_frac : WIDTH_FRAC_BITS, width_int : 16 - WIDTH_FRAC_BITS;
};
@@ -1148,6 +1151,27 @@ enum metrics_status
#define LCD_FONT_SMOOTHING_LEFT_MARGIN (0.396f)
#define LCD_FONT_SMOOTHING_RIGHT_MARGIN (0.396f)
+/* If FONT is monospace and WIDTH can be regarded as a multiple of its
+ width where the multiplier is greater than 1, then return the
+ multiplier. Otherwise return 0. */
+static int
+macfont_monospace_width_multiplier (struct font *font, CGFloat width)
+{
+ struct macfont_info *macfont_info = (struct macfont_info *) font;
+ int multiplier = 0;
+
+ if (macfont_info->spacing == MACFONT_SPACING_MONO
+ && font->space_width != 0)
+ {
+ multiplier = lround (width / font->space_width);
+ if (multiplier == 1
+ || lround (width / multiplier) != font->space_width)
+ multiplier = 0;
+ }
+
+ return multiplier;
+}
+
static int
macfont_glyph_extents (struct font *font, CGGlyph glyph,
struct font_metrics *metrics, CGFloat *advance_delta,
@@ -1192,13 +1216,38 @@ macfont_glyph_extents (struct font *font, CGGlyph glyph,
else
fwidth = mac_font_get_advance_width_for_glyph (macfont, glyph);
- /* For synthetic mono fonts, cache->width_{int,frac} holds the
- advance delta value. */
- if (macfont_info->spacing == MACFONT_SPACING_SYNTHETIC_MONO)
- fwidth = (font->pixel_size - fwidth) / 2;
- cache->width_int = lround (fwidth);
- cache->width_frac = lround ((fwidth - cache->width_int)
- * WIDTH_FRAC_SCALE);
+ if (macfont_info->spacing == MACFONT_SPACING_MONO)
+ {
+ /* Some monospace fonts for programming languages contain
+ wider ligature glyphs consisting of multiple characters.
+ For such glyphs, simply rounding the combined fractional
+ width to an integer can result in a value that is not a
+ multiple of the (rounded) font width. */
+ int multiplier = macfont_monospace_width_multiplier (font, fwidth);
+
+ if (multiplier)
+ {
+ cache->width_int = font->space_width * multiplier;
+ cache->width_frac = lround ((fwidth / multiplier
+ - font->space_width)
+ * WIDTH_FRAC_SCALE);
+ }
+ else
+ {
+ cache->width_int = lround (fwidth);
+ cache->width_frac = 0;
+ }
+ }
+ else
+ {
+ /* For synthetic mono fonts, cache->width_{int,frac} holds
+ the advance delta value. */
+ if (macfont_info->spacing == MACFONT_SPACING_SYNTHETIC_MONO)
+ fwidth = (font->pixel_size - fwidth) / 2;
+ cache->width_int = lround (fwidth);
+ cache->width_frac = lround ((fwidth - cache->width_int)
+ * WIDTH_FRAC_SCALE);
+ }
METRICS_SET_STATUS (cache, METRICS_WIDTH_VALID);
}
if (macfont_info->spacing == MACFONT_SPACING_SYNTHETIC_MONO)
@@ -1235,6 +1284,10 @@ macfont_glyph_extents (struct font *font, CGGlyph glyph,
/ (CGFloat) (WIDTH_FRAC_SCALE * 2));
break;
case MACFONT_SPACING_MONO:
+ if (cache->width_frac)
+ bounds.origin.x += - ((cache->width_frac
+ / (CGFloat) (WIDTH_FRAC_SCALE * 2))
+ * (cache->width_int / font->space_width));
break;
case MACFONT_SPACING_SYNTHETIC_MONO:
bounds.origin.x += (cache->width_int
@@ -1271,7 +1324,16 @@ macfont_glyph_extents (struct font *font, CGGlyph glyph,
/ (CGFloat) (WIDTH_FRAC_SCALE * 2)));
break;
case MACFONT_SPACING_MONO:
- *advance_delta = 0;
+ if (cache->width_frac)
+ *advance_delta = 0;
+ else
+ {
+ CGFloat delta = - ((cache->width_frac
+ / (CGFloat) (WIDTH_FRAC_SCALE * 2))
+ * (cache->width_int / font->space_width));
+
+ *advance_delta = (force_integral_p ? round (delta) : delta);
+ }
break;
case MACFONT_SPACING_SYNTHETIC_MONO:
*advance_delta = (force_integral_p ? cache->width_int
@@ -3015,7 +3077,7 @@ macfont_shape (Lisp_Object lgstring, Lisp_Object
direction)
struct mac_glyph_layout *gl = glyph_layouts + i;
EMACS_INT from, to;
struct font_metrics metrics;
- int xoff, yoff, wadjust;
+ int xoff, yoff, wadjust, multiplier;
if (NILP (lglyph))
{
@@ -3068,7 +3130,11 @@ macfont_shape (Lisp_Object lgstring, Lisp_Object
direction)
xoff = lround (gl->advance_delta);
yoff = lround (- gl->baseline_delta);
- wadjust = lround (gl->advance);
+ multiplier = macfont_monospace_width_multiplier (font, gl->advance);
+ if (multiplier)
+ wadjust = font->space_width * multiplier;
+ else
+ wadjust = lround (gl->advance);
if (xoff != 0 || yoff != 0 || wadjust != metrics.width)
{
Lisp_Object vec = make_uninit_vector (3);
diff --git a/src/minibuf.c b/src/minibuf.c
index 9d870ce..cb302c5 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1212,9 +1212,6 @@ is used to further constrain the set of candidates. */)
bucket = AREF (collection, idx);
}
- if (HASH_TABLE_P (collection))
- hash_rehash_if_needed (XHASH_TABLE (collection));
-
while (1)
{
/* Get the next element of the alist, obarray, or hash-table. */
diff --git a/src/nsterm.m b/src/nsterm.m
index 572b859..9f5916d 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -49,6 +49,7 @@ GNUstep port and post-20 update by Adrian Robert
(arobert@cogsci.ucsd.edu)
#include "nsterm.h"
#include "systime.h"
#include "character.h"
+#include "xwidget.h"
#include "fontset.h"
#include "composite.h"
#include "ccl.h"
@@ -2600,7 +2601,8 @@ frame_set_mouse_pixel_position (struct frame *f, int
pix_x, int pix_y)
}
static int
-ns_note_mouse_movement (struct frame *frame, CGFloat x, CGFloat y)
+ns_note_mouse_movement (struct frame *frame, CGFloat x, CGFloat y,
+ BOOL dragging)
/* ------------------------------------------------------------------------
Called by EmacsView on mouseMovement events. Passes on
to emacs mainstream code if we moved off of a rect of interest
@@ -2609,17 +2611,24 @@ ns_note_mouse_movement (struct frame *frame, CGFloat x,
CGFloat y)
{
struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
NSRect *r;
+ BOOL force_update = NO;
// NSTRACE ("note_mouse_movement");
dpyinfo->last_mouse_motion_frame = frame;
r = &dpyinfo->last_mouse_glyph;
+ /* If the last rect is too large (ex, xwidget webkit), update at
+ every move, or resizing by dragging modeline or vertical split is
+ very hard to make its way. */
+ if (dragging && (r->size.width > 32 || r->size.height > 32))
+ force_update = YES;
+
/* Note, this doesn't get called for enter/leave, since we don't have a
position. Those are taken care of in the corresponding NSView methods.
*/
/* Has movement gone beyond last rect we were tracking? */
- if (x < r->origin.x || x >= r->origin.x + r->size.width
+ if (force_update || x < r->origin.x || x >= r->origin.x + r->size.width
|| y < r->origin.y || y >= r->origin.y + r->size.height)
{
ns_update_begin (frame);
@@ -4368,6 +4377,10 @@ ns_draw_glyph_string (struct glyph_string *s)
ns_unfocus (s->f);
break;
+ case XWIDGET_GLYPH:
+ x_draw_xwidget_glyph_string (s);
+ break;
+
case STRETCH_GLYPH:
ns_dumpglyphs_stretch (s);
break;
@@ -7065,6 +7078,7 @@ not_in_argv (NSString *arg)
struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe);
Lisp_Object frame;
NSPoint pt;
+ BOOL dragging;
NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "[EmacsView mouseMoved:]");
@@ -7107,7 +7121,8 @@ not_in_argv (NSString *arg)
last_mouse_window = window;
}
- if (!ns_note_mouse_movement (emacsframe, pt.x, pt.y))
+ dragging = (e.type == NSEventTypeLeftMouseDragged);
+ if (!ns_note_mouse_movement (emacsframe, pt.x, pt.y, dragging))
help_echo_string = previous_help_echo_string;
XSETFRAME (frame, emacsframe);
diff --git a/src/nsxwidget.h b/src/nsxwidget.h
new file mode 100644
index 0000000..3d91594
--- /dev/null
+++ b/src/nsxwidget.h
@@ -0,0 +1,80 @@
+/* Header for NS Cocoa part of xwidget and webkit widget.
+
+Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+
+#ifndef NSXWIDGET_H_INCLUDED
+#define NSXWIDGET_H_INCLUDED
+
+/* This file can be included from non-objc files through 'xwidget.h'. */
+#ifdef __OBJC__
+#import <AppKit/NSView.h>
+#endif
+
+#include "dispextern.h"
+#include "lisp.h"
+#include "xwidget.h"
+
+/* Functions for xwidget webkit. */
+
+bool nsxwidget_is_web_view (struct xwidget *xw);
+Lisp_Object nsxwidget_webkit_uri (struct xwidget *xw);
+Lisp_Object nsxwidget_webkit_title (struct xwidget *xw);
+void nsxwidget_webkit_goto_uri (struct xwidget *xw, const char *uri);
+void nsxwidget_webkit_goto_history (struct xwidget *xw, int rel_pos);
+void nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change);
+void nsxwidget_webkit_execute_script (struct xwidget *xw, const char *script,
+ Lisp_Object fun);
+
+/* Functions for xwidget model. */
+
+#ifdef __OBJC__
+@interface XwWindow : NSView
+@property struct xwidget *xw;
+@end
+#endif
+
+void nsxwidget_init (struct xwidget *xw);
+void nsxwidget_kill (struct xwidget *xw);
+void nsxwidget_resize (struct xwidget *xw);
+Lisp_Object nsxwidget_get_size (struct xwidget *xw);
+
+/* Functions for xwidget view. */
+
+#ifdef __OBJC__
+@interface XvWindow : NSView
+@property struct xwidget *xw;
+@property struct xwidget_view *xv;
+@end
+#endif
+
+void nsxwidget_init_view (struct xwidget_view *xv,
+ struct xwidget *xww,
+ struct glyph_string *s,
+ int x, int y);
+void nsxwidget_delete_view (struct xwidget_view *xv);
+
+void nsxwidget_show_view (struct xwidget_view *xv);
+void nsxwidget_hide_view (struct xwidget_view *xv);
+void nsxwidget_resize_view (struct xwidget_view *xv,
+ int widget, int height);
+
+void nsxwidget_move_view (struct xwidget_view *xv, int x, int y);
+void nsxwidget_move_widget_in_view (struct xwidget_view *xv, int x, int y);
+void nsxwidget_set_needsdisplay (struct xwidget_view *xv);
+
+#endif /* NSXWIDGET_H_INCLUDED */
diff --git a/src/nsxwidget.m b/src/nsxwidget.m
new file mode 100644
index 0000000..370abee
--- /dev/null
+++ b/src/nsxwidget.m
@@ -0,0 +1,601 @@
+/* NS Cocoa part implementation of xwidget and webkit widget.
+
+Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include "lisp.h"
+#include "blockinput.h"
+#include "dispextern.h"
+#include "buffer.h"
+#include "frame.h"
+#include "nsterm.h"
+#include "xwidget.h"
+
+#import <AppKit/AppKit.h>
+#import <WebKit/WebKit.h>
+
+/* Thoughts on NS Cocoa xwidget and webkit2:
+
+ Webkit2 process architecture seems to be very hostile for offscreen
+ rendering techniques, which is used by GTK xwiget implementation;
+ Specifically NSView level view sharing / copying is not working.
+
+ *** So only one view can be associcated with a model. ***
+
+ With this decision, implementation is plain and can expect best out
+ of webkit2's rationale. But process and session structures will
+ diverge from GTK xwiget. Though, cosmetically similar usages can
+ be presented and will be preferred, if agreeable.
+
+ For other widget types, OSR seems possible, but will not care for a
+ while. */
+
+/* Xwidget webkit. */
+
+@interface XwWebView : WKWebView
+<WKNavigationDelegate, WKUIDelegate, WKScriptMessageHandler>
+@property struct xwidget *xw;
+/* Map url to whether javascript is blocked by
+ 'Content-Security-Policy' sandbox without allow-scripts. */
+@property(retain) NSMutableDictionary *urlScriptBlocked;
+@end
+@implementation XwWebView : WKWebView
+
+- (id)initWithFrame:(CGRect)frame
+ configuration:(WKWebViewConfiguration *)configuration
+ xwidget:(struct xwidget *)xw
+{
+ /* Script controller to add script message handler and user script. */
+ WKUserContentController *scriptor = [[WKUserContentController alloc] init];
+ configuration.userContentController = scriptor;
+
+ /* Enable inspect element context menu item for debugging. */
+ [configuration.preferences setValue:@YES
+ forKey:@"developerExtrasEnabled"];
+
+ Lisp_Object enablePlugins =
+ Fintern (build_string ("xwidget-webkit-enable-plugins"), Qnil);
+ if (!EQ (Fsymbol_value (enablePlugins), Qnil))
+ configuration.preferences.plugInsEnabled = YES;
+
+ self = [super initWithFrame:frame configuration:configuration];
+ if (self)
+ {
+ self.xw = xw;
+ self.urlScriptBlocked = [[NSMutableDictionary alloc] init];
+ self.navigationDelegate = self;
+ self.UIDelegate = self;
+ self.customUserAgent =
+ @"Mozilla/5.0 (Macintosh; Intel Mac OS X 10_12_6)"
+ @" AppleWebKit/603.3.8 (KHTML, like Gecko)"
+ @" Version/11.0.1 Safari/603.3.8";
+ [scriptor addScriptMessageHandler:self name:@"keyDown"];
+ [scriptor addUserScript:[[WKUserScript alloc]
+ initWithSource:xwScript
+ injectionTime:
+ WKUserScriptInjectionTimeAtDocumentStart
+ forMainFrameOnly:NO]];
+ }
+ return self;
+}
+
+- (void)webView:(WKWebView *)webView
+didFinishNavigation:(WKNavigation *)navigation
+{
+ if (EQ (Fbuffer_live_p (self.xw->buffer), Qt))
+ store_xwidget_event_string (self.xw, "load-changed", "");
+}
+
+- (void)webView:(WKWebView *)webView
+decidePolicyForNavigationAction:(WKNavigationAction *)navigationAction
+decisionHandler:(void (^)(WKNavigationActionPolicy))decisionHandler
+{
+ switch (navigationAction.navigationType) {
+ case WKNavigationTypeLinkActivated:
+ decisionHandler (WKNavigationActionPolicyAllow);
+ break;
+ default:
+ // decisionHandler (WKNavigationActionPolicyCancel);
+ decisionHandler (WKNavigationActionPolicyAllow);
+ break;
+ }
+}
+
+- (void)webView:(WKWebView *)webView
+decidePolicyForNavigationResponse:(WKNavigationResponse *)navigationResponse
+decisionHandler:(void (^)(WKNavigationResponsePolicy))decisionHandler
+{
+ if (!navigationResponse.canShowMIMEType)
+ {
+ NSString *url = navigationResponse.response.URL.absoluteString;
+ NSString *mimetype = navigationResponse.response.MIMEType;
+ NSString *filename = navigationResponse.response.suggestedFilename;
+ decisionHandler (WKNavigationResponsePolicyCancel);
+ store_xwidget_download_callback_event (self.xw,
+ url.UTF8String,
+ mimetype.UTF8String,
+ filename.UTF8String);
+ return;
+ }
+ decisionHandler (WKNavigationResponsePolicyAllow);
+
+ self.urlScriptBlocked[navigationResponse.response.URL] =
+ [NSNumber numberWithBool:NO];
+ if ([navigationResponse.response isKindOfClass:[NSHTTPURLResponse class]])
+ {
+ NSDictionary *headers =
+ ((NSHTTPURLResponse *) navigationResponse.response).allHeaderFields;
+ NSString *value = headers[@"Content-Security-Policy"];
+ if (value)
+ {
+ /* TODO: Sloppy parsing of 'Content-Security-Policy' value. */
+ NSRange sandbox = [value rangeOfString:@"sandbox"];
+ if (sandbox.location != NSNotFound
+ && (sandbox.location == 0
+ || [value characterAtIndex:(sandbox.location - 1)] == ' '
+ || [value characterAtIndex:(sandbox.location - 1)] == ';'))
+ {
+ NSRange allowScripts = [value rangeOfString:@"allow-scripts"];
+ if (allowScripts.location == NSNotFound
+ || allowScripts.location < sandbox.location)
+ self.urlScriptBlocked[navigationResponse.response.URL] =
+ [NSNumber numberWithBool:YES];
+ }
+ }
+ }
+}
+
+/* No additional new webview or emacs window will be created
+ for <a ... target="_blank">. */
+- (WKWebView *)webView:(WKWebView *)webView
+createWebViewWithConfiguration:(WKWebViewConfiguration *)configuration
+ forNavigationAction:(WKNavigationAction *)navigationAction
+ windowFeatures:(WKWindowFeatures *)windowFeatures
+{
+ if (!navigationAction.targetFrame.isMainFrame)
+ [webView loadRequest:navigationAction.request];
+ return nil;
+}
+
+/* Open panel for file upload. */
+- (void)webView:(WKWebView *)webView
+runOpenPanelWithParameters:(WKOpenPanelParameters *)parameters
+initiatedByFrame:(WKFrameInfo *)frame
+completionHandler:(void (^)(NSArray<NSURL *> *URLs))completionHandler
+{
+ NSOpenPanel *openPanel = [NSOpenPanel openPanel];
+ openPanel.canChooseFiles = YES;
+ openPanel.canChooseDirectories = NO;
+ openPanel.allowsMultipleSelection = parameters.allowsMultipleSelection;
+ if ([openPanel runModal] == NSModalResponseOK)
+ completionHandler (openPanel.URLs);
+ else
+ completionHandler (nil);
+}
+
+/* By forwarding mouse events to emacs view (frame)
+ - Mouse click in webview selects the window contains the webview.
+ - Correct mouse hand/arrow/I-beam is displayed (TODO: not perfect yet).
+*/
+
+- (void)mouseDown:(NSEvent *)event
+{
+ [self.xw->xv->emacswindow mouseDown:event];
+ [super mouseDown:event];
+}
+
+- (void)mouseUp:(NSEvent *)event
+{
+ [self.xw->xv->emacswindow mouseUp:event];
+ [super mouseUp:event];
+}
+
+/* Basically we want keyboard events handled by emacs unless an input
+ element has focus. Especially, while incremental search, we set
+ emacs as first responder to avoid focus held in an input element
+ with matching text. */
+
+- (void)keyDown:(NSEvent *)event
+{
+ Lisp_Object var = Fintern (build_string ("isearch-mode"), Qnil);
+ Lisp_Object val = buffer_local_value (var, Fcurrent_buffer ());
+ if (!EQ (val, Qunbound) && !EQ (val, Qnil))
+ {
+ [self.window makeFirstResponder:self.xw->xv->emacswindow];
+ [self.xw->xv->emacswindow keyDown:event];
+ return;
+ }
+
+ /* Emacs handles keyboard events when javascript is blocked. */
+ if ([self.urlScriptBlocked[self.URL] boolValue])
+ {
+ [self.xw->xv->emacswindow keyDown:event];
+ return;
+ }
+
+ [self evaluateJavaScript:@"xwHasFocus()"
+ completionHandler:^(id result, NSError *error) {
+ if (error)
+ {
+ NSLog (@"xwHasFocus: %@", error);
+ [self.xw->xv->emacswindow keyDown:event];
+ }
+ else if (result)
+ {
+ NSNumber *hasFocus = result; /* __NSCFBoolean */
+ if (!hasFocus.boolValue)
+ [self.xw->xv->emacswindow keyDown:event];
+ else
+ [super keyDown:event];
+ }
+ }];
+}
+
+- (void)interpretKeyEvents:(NSArray<NSEvent *> *)eventArray
+{
+ /* We should do nothing and do not forward (default implementation
+ if we not override here) to let emacs collect key events and ask
+ interpretKeyEvents to its superclass. */
+}
+
+static NSString *xwScript;
++ (void)initialize
+{
+ /* Find out if an input element has focus.
+ Message to script message handler when 'C-g' key down. */
+ if (!xwScript)
+ xwScript =
+ @"function xwHasFocus() {"
+ @" var ae = document.activeElement;"
+ @" if (ae) {"
+ @" var name = ae.nodeName;"
+ @" return name == 'INPUT' || name == 'TEXTAREA';"
+ @" } else {"
+ @" return false;"
+ @" }"
+ @"}"
+ @"function xwKeyDown(event) {"
+ @" if (event.ctrlKey && event.key == 'g') {"
+ @" window.webkit.messageHandlers.keyDown.postMessage('C-g');"
+ @" }"
+ @"}"
+ @"document.addEventListener('keydown', xwKeyDown);"
+ ;
+}
+
+/* Confirming to WKScriptMessageHandler, listens concerning keyDown in
+ webkit. Currently 'C-g'. */
+- (void)userContentController:(WKUserContentController *)userContentController
+ didReceiveScriptMessage:(WKScriptMessage *)message
+{
+ if ([message.body isEqualToString:@"C-g"])
+ {
+ /* Just give up focus, no relay "C-g" to emacs, another "C-g"
+ follows will be handled by emacs. */
+ [self.window makeFirstResponder:self.xw->xv->emacswindow];
+ }
+}
+
+@end
+
+/* Xwidget webkit commands. */
+
+static Lisp_Object build_string_with_nsstr (NSString *nsstr);
+
+bool
+nsxwidget_is_web_view (struct xwidget *xw)
+{
+ return xw->xwWidget != NULL &&
+ [xw->xwWidget isKindOfClass:WKWebView.class];
+}
+
+Lisp_Object
+nsxwidget_webkit_uri (struct xwidget *xw)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ return build_string_with_nsstr (xwWebView.URL.absoluteString);
+}
+
+Lisp_Object
+nsxwidget_webkit_title (struct xwidget *xw)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ return build_string_with_nsstr (xwWebView.title);
+}
+
+/* @Note ATS - Need application transport security in 'Info.plist' or
+ remote pages will not loaded. */
+void
+nsxwidget_webkit_goto_uri (struct xwidget *xw, const char *uri)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ NSString *urlString = [NSString stringWithUTF8String:uri];
+ NSURL *url = [NSURL URLWithString:urlString];
+ NSURLRequest *urlRequest = [NSURLRequest requestWithURL:url];
+ [xwWebView loadRequest:urlRequest];
+}
+
+void
+nsxwidget_webkit_goto_history (struct xwidget *xw, int rel_pos)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ switch (rel_pos) {
+ case -1: [xwWebView goBack]; break;
+ case 0: [xwWebView reload]; break;
+ case 1: [xwWebView goForward]; break;
+ }
+}
+
+void
+nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ xwWebView.magnification += zoom_change;
+ /* TODO: setMagnification:centeredAtPoint. */
+}
+
+/* Build lisp string */
+static Lisp_Object
+build_string_with_nsstr (NSString *nsstr)
+{
+ const char *utfstr = [nsstr UTF8String];
+ NSUInteger bytes = [nsstr lengthOfBytesUsingEncoding:NSUTF8StringEncoding];
+ return make_string (utfstr, bytes);
+}
+
+/* Recursively convert an objc native type JavaScript value to a Lisp
+ value. Mostly copied from GTK xwidget 'webkit_js_to_lisp'. */
+static Lisp_Object
+js_to_lisp (id value)
+{
+ if (value == nil || [value isKindOfClass:NSNull.class])
+ return Qnil;
+ else if ([value isKindOfClass:NSString.class])
+ return build_string_with_nsstr ((NSString *) value);
+ else if ([value isKindOfClass:NSNumber.class])
+ {
+ NSNumber *nsnum = (NSNumber *) value;
+ char type = nsnum.objCType[0];
+ if (type == 'c') /* __NSCFBoolean has type character 'c'. */
+ return nsnum.boolValue? Qt : Qnil;
+ else
+ {
+ if (type == 'i' || type == 'l')
+ return make_int (nsnum.longValue);
+ else if (type == 'f' || type == 'd')
+ return make_float (nsnum.doubleValue);
+ /* else fall through. */
+ }
+ }
+ else if ([value isKindOfClass:NSArray.class])
+ {
+ NSArray *nsarr = (NSArray *) value;
+ EMACS_INT n = nsarr.count;
+ Lisp_Object obj;
+ struct Lisp_Vector *p = allocate_vector (n);
+
+ for (ptrdiff_t i = 0; i < n; ++i)
+ p->contents[i] = js_to_lisp ([nsarr objectAtIndex:i]);
+ XSETVECTOR (obj, p);
+ return obj;
+ }
+ else if ([value isKindOfClass:NSDictionary.class])
+ {
+ NSDictionary *nsdict = (NSDictionary *) value;
+ NSArray *keys = nsdict.allKeys;
+ ptrdiff_t n = keys.count;
+ Lisp_Object obj;
+ struct Lisp_Vector *p = allocate_vector (n);
+
+ for (ptrdiff_t i = 0; i < n; ++i)
+ {
+ NSString *prop_key = (NSString *) [keys objectAtIndex:i];
+ id prop_value = [nsdict valueForKey:prop_key];
+ p->contents[i] = Fcons (build_string_with_nsstr (prop_key),
+ js_to_lisp (prop_value));
+ }
+ XSETVECTOR (obj, p);
+ return obj;
+ }
+ NSLog (@"Unhandled type in javascript result");
+ return Qnil;
+}
+
+void
+nsxwidget_webkit_execute_script (struct xwidget *xw, const char *script,
+ Lisp_Object fun)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ if ([xwWebView.urlScriptBlocked[xwWebView.URL] boolValue])
+ {
+ message ("Javascript is blocked by 'CSP: sandbox'.");
+ return;
+ }
+
+ NSString *javascriptString = [NSString stringWithUTF8String:script];
+ [xwWebView evaluateJavaScript:javascriptString
+ completionHandler:^(id result, NSError *error) {
+ if (error)
+ {
+ NSLog (@"evaluateJavaScript error : %@", error.localizedDescription);
+ NSLog (@"error script=%@", javascriptString);
+ }
+ else if (result && FUNCTIONP (fun))
+ {
+ // NSLog (@"result=%@, type=%@", result, [result class]);
+ Lisp_Object lisp_value = js_to_lisp (result);
+ store_xwidget_js_callback_event (xw, fun, lisp_value);
+ }
+ }];
+}
+
+/* Window containing an xwidget. */
+
+@implementation XwWindow
+- (BOOL)isFlipped { return YES; }
+@end
+
+/* Xwidget model, macOS Cocoa part. */
+
+void
+nsxwidget_init(struct xwidget *xw)
+{
+ block_input ();
+ NSRect rect = NSMakeRect (0, 0, xw->width, xw->height);
+ xw->xwWidget = [[XwWebView alloc]
+ initWithFrame:rect
+ configuration:[[WKWebViewConfiguration alloc] init]
+ xwidget:xw];
+ xw->xwWindow = [[XwWindow alloc]
+ initWithFrame:rect];
+ [xw->xwWindow addSubview:xw->xwWidget];
+ xw->xv = NULL; /* for 1 to 1 relationship of webkit2. */
+ unblock_input ();
+}
+
+void
+nsxwidget_kill (struct xwidget *xw)
+{
+ if (xw)
+ {
+ WKUserContentController *scriptor =
+ ((XwWebView *) xw->xwWidget).configuration.userContentController;
+ [scriptor removeAllUserScripts];
+ [scriptor removeScriptMessageHandlerForName:@"keyDown"];
+ [scriptor release];
+ if (xw->xv)
+ xw->xv->model = Qnil; /* Make sure related view stale. */
+
+ /* This stops playing audio when a xwidget-webkit buffer is
+ killed. I could not find other solution. */
+ nsxwidget_webkit_goto_uri (xw, "about:blank");
+
+ [((XwWebView *) xw->xwWidget).urlScriptBlocked release];
+ [xw->xwWidget removeFromSuperviewWithoutNeedingDisplay];
+ [xw->xwWidget release];
+ [xw->xwWindow removeFromSuperviewWithoutNeedingDisplay];
+ [xw->xwWindow release];
+ xw->xwWidget = nil;
+ }
+}
+
+void
+nsxwidget_resize (struct xwidget *xw)
+{
+ if (xw->xwWidget)
+ {
+ [xw->xwWindow setFrameSize:NSMakeSize(xw->width, xw->height)];
+ [xw->xwWidget setFrameSize:NSMakeSize(xw->width, xw->height)];
+ }
+}
+
+Lisp_Object
+nsxwidget_get_size (struct xwidget *xw)
+{
+ return list2i (xw->xwWidget.frame.size.width,
+ xw->xwWidget.frame.size.height);
+}
+
+/* Xwidget view, macOS Cocoa part. */
+
+@implementation XvWindow : NSView
+- (BOOL)isFlipped { return YES; }
+@end
+
+void
+nsxwidget_init_view (struct xwidget_view *xv,
+ struct xwidget *xw,
+ struct glyph_string *s,
+ int x, int y)
+{
+ /* 'x_draw_xwidget_glyph_string' will calculate correct position and
+ size of clip to draw in emacs buffer window. Thus, just begin at
+ origin with no crop. */
+ xv->x = x;
+ xv->y = y;
+ xv->clip_left = 0;
+ xv->clip_right = xw->width;
+ xv->clip_top = 0;
+ xv->clip_bottom = xw->height;
+
+ xv->xvWindow = [[XvWindow alloc]
+ initWithFrame:NSMakeRect (x, y, xw->width, xw->height)];
+ xv->xvWindow.xw = xw;
+ xv->xvWindow.xv = xv;
+
+ xw->xv = xv; /* For 1 to 1 relationship of webkit2. */
+ [xv->xvWindow addSubview:xw->xwWindow];
+
+ xv->emacswindow = FRAME_NS_VIEW (s->f);
+ [xv->emacswindow addSubview:xv->xvWindow];
+}
+
+void
+nsxwidget_delete_view (struct xwidget_view *xv)
+{
+ if (!EQ (xv->model, Qnil))
+ {
+ struct xwidget *xw = XXWIDGET (xv->model);
+ [xw->xwWindow removeFromSuperviewWithoutNeedingDisplay];
+ xw->xv = NULL; /* Now model has no view. */
+ }
+ [xv->xvWindow removeFromSuperviewWithoutNeedingDisplay];
+ [xv->xvWindow release];
+}
+
+void
+nsxwidget_show_view (struct xwidget_view *xv)
+{
+ xv->hidden = NO;
+ [xv->xvWindow setFrameOrigin:NSMakePoint(xv->x + xv->clip_left,
+ xv->y + xv->clip_top)];
+}
+
+void
+nsxwidget_hide_view (struct xwidget_view *xv)
+{
+ xv->hidden = YES;
+ [xv->xvWindow setFrameOrigin:NSMakePoint(10000, 10000)];
+}
+
+void
+nsxwidget_resize_view (struct xwidget_view *xv, int width, int height)
+{
+ [xv->xvWindow setFrameSize:NSMakeSize(width, height)];
+}
+
+void
+nsxwidget_move_view (struct xwidget_view *xv, int x, int y)
+{
+ [xv->xvWindow setFrameOrigin:NSMakePoint (x, y)];
+}
+
+/* Move model window in container (view window). */
+void
+nsxwidget_move_widget_in_view (struct xwidget_view *xv, int x, int y)
+{
+ struct xwidget *xww = xv->xvWindow.xw;
+ [xww->xwWindow setFrameOrigin:NSMakePoint (x, y)];
+}
+
+void
+nsxwidget_set_needsdisplay (struct xwidget_view *xv)
+{
+ xv->xvWindow.needsDisplay = YES;
+}
diff --git a/src/pdumper.c b/src/pdumper.c
index de9c06c..c55b6f7 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -71,17 +71,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#ifdef HAVE_PDUMPER
#if GNUC_PREREQ (4, 7, 0)
-# pragma GCC diagnostic error "-Wconversion"
-# pragma GCC diagnostic ignored "-Wsign-conversion"
# pragma GCC diagnostic error "-Wshadow"
-# define ALLOW_IMPLICIT_CONVERSION \
- _Pragma ("GCC diagnostic push") \
- _Pragma ("GCC diagnostic ignored \"-Wconversion\"")
-# define DISALLOW_IMPLICIT_CONVERSION \
- _Pragma ("GCC diagnostic pop")
-#else
-# define ALLOW_IMPLICIT_CONVERSION ((void) 0)
-# define DISALLOW_IMPLICIT_CONVERSION ((void) 0)
#endif
#define VM_POSIX 1
@@ -105,17 +95,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
# define VM_SUPPORTED 0
#endif
-/* PDUMPER_CHECK_REHASHING being true causes the portable dumper to
- check, for each hash table it dumps, that the hash table means the
- same thing after rehashing. */
-#ifndef PDUMPER_CHECK_REHASHING
-# if ENABLE_CHECKING
-# define PDUMPER_CHECK_REHASHING 1
-# else
-# define PDUMPER_CHECK_REHASHING 0
-# endif
-#endif
-
/* Require an architecture in which pointers, ptrdiff_t and intptr_t
are the same size and have the same layout, and where bytes have
eight bits --- that is, a general-purpose computer made after 1990.
@@ -152,8 +131,11 @@ static int nr_remembered_data = 0;
typedef int_least32_t dump_off;
#define DUMP_OFF_MIN INT_LEAST32_MIN
#define DUMP_OFF_MAX INT_LEAST32_MAX
+#define PRIdDUMP_OFF PRIdLEAST32
+
+enum { EMACS_INT_XDIGITS = (EMACS_INT_WIDTH + 3) / 4 };
-static void ATTRIBUTE_FORMAT ((printf, 1, 2))
+static void ATTRIBUTE_FORMAT_PRINTF (1, 2)
dump_trace (const char *fmt, ...)
{
if (0)
@@ -326,9 +308,7 @@ static void
dump_reloc_set_offset (struct dump_reloc *reloc, dump_off offset)
{
eassert (offset >= 0);
- ALLOW_IMPLICIT_CONVERSION;
reloc->raw_offset = offset >> DUMP_RELOC_ALIGNMENT_BITS;
- DISALLOW_IMPLICIT_CONVERSION;
if (dump_reloc_get_offset (*reloc) != offset)
error ("dump relocation out of range");
}
@@ -417,6 +397,9 @@ struct dump_header
The start of the cold region is always aligned on a page
boundary. */
dump_off cold_start;
+
+ /* Offset of a vector of the dumped hash tables. */
+ dump_off hash_list;
};
/* Double-ended singly linked list. */
@@ -575,8 +558,11 @@ struct dump_context
heap objects. */
Lisp_Object bignum_data;
- unsigned number_hot_relocations;
- unsigned number_discardable_relocations;
+ /* List of hash tables that have been dumped. */
+ Lisp_Object hash_tables;
+
+ dump_off number_hot_relocations;
+ dump_off number_discardable_relocations;
};
/* These special values for use as offsets in dump_remember_object and
@@ -763,10 +749,7 @@ dump_off_from_lisp (Lisp_Object value)
{
intmax_t n = intmax_t_from_lisp (value);
eassert (DUMP_OFF_MIN <= n && n <= DUMP_OFF_MAX);
- ALLOW_IMPLICIT_CONVERSION;
- dump_off converted = n;
- DISALLOW_IMPLICIT_CONVERSION;
- return converted;
+ return n;
}
static Lisp_Object
@@ -983,11 +966,9 @@ dump_queue_init (struct dump_queue *dump_queue)
static bool
dump_queue_empty_p (struct dump_queue *dump_queue)
{
- bool is_empty =
- EQ (Fhash_table_count (dump_queue->sequence_numbers),
- make_fixnum (0));
- eassert (EQ (Fhash_table_count (dump_queue->sequence_numbers),
- Fhash_table_count (dump_queue->link_weights)));
+ ptrdiff_t count = XHASH_TABLE (dump_queue->sequence_numbers)->count;
+ bool is_empty = count == 0;
+ eassert (count == XFIXNAT (Fhash_table_count (dump_queue->link_weights)));
if (!is_empty)
{
eassert (!dump_tailq_empty_p (&dump_queue->zero_weight_objects)
@@ -1029,9 +1010,9 @@ dump_queue_enqueue (struct dump_queue *dump_queue,
if (NILP (weights))
{
/* Object is new. */
- dump_trace ("new object %016x weight=%u\n",
- (unsigned) XLI (object),
- (unsigned) weight.value);
+ EMACS_UINT uobj = XLI (object);
+ dump_trace ("new object %0*"pI"x weight=%d\n", EMACS_INT_XDIGITS, uobj,
+ weight.value);
if (weight.value == WEIGHT_NONE.value)
{
@@ -1246,17 +1227,15 @@ dump_queue_dequeue (struct dump_queue *dump_queue,
dump_off basis)
+ dump_tailq_length (&dump_queue->one_weight_normal_objects)
+ dump_tailq_length (&dump_queue->one_weight_strong_objects)));
- bool dump_object_counts = true;
- if (dump_object_counts)
- dump_trace
- ("dump_queue_dequeue basis=%d fancy=%u zero=%u "
- "normal=%u strong=%u hash=%u\n",
- basis,
- (unsigned) dump_tailq_length (&dump_queue->fancy_weight_objects),
- (unsigned) dump_tailq_length (&dump_queue->zero_weight_objects),
- (unsigned) dump_tailq_length (&dump_queue->one_weight_normal_objects),
- (unsigned) dump_tailq_length (&dump_queue->one_weight_strong_objects),
- (unsigned) XFIXNUM (Fhash_table_count (dump_queue->link_weights)));
+ dump_trace
+ (("dump_queue_dequeue basis=%"PRIdDUMP_OFF" fancy=%"PRIdPTR
+ " zero=%"PRIdPTR" normal=%"PRIdPTR" strong=%"PRIdPTR" hash=%td\n"),
+ basis,
+ dump_tailq_length (&dump_queue->fancy_weight_objects),
+ dump_tailq_length (&dump_queue->zero_weight_objects),
+ dump_tailq_length (&dump_queue->one_weight_normal_objects),
+ dump_tailq_length (&dump_queue->one_weight_strong_objects),
+ XHASH_TABLE (dump_queue->link_weights)->count);
static const int nr_candidates = 3;
struct candidate
@@ -1329,10 +1308,10 @@ dump_queue_dequeue (struct dump_queue *dump_queue,
dump_off basis)
else
emacs_abort ();
- dump_trace (" result score=%f src=%s object=%016x\n",
+ EMACS_UINT uresult = XLI (result);
+ dump_trace (" result score=%f src=%s object=%0*"pI"x\n",
best < 0 ? -1.0 : (double) candidates[best].score,
- src,
- (unsigned) XLI (result));
+ src, EMACS_INT_XDIGITS, uresult);
{
Lisp_Object weights = Fgethash (result, dump_queue->link_weights, Qnil);
@@ -2017,11 +1996,7 @@ static dump_off
finish_dump_pvec (struct dump_context *ctx,
union vectorlike_header *out_hdr)
{
- ALLOW_IMPLICIT_CONVERSION;
- dump_off result = dump_object_finish (ctx, out_hdr,
- vectorlike_nbytes (out_hdr));
- DISALLOW_IMPLICIT_CONVERSION;
- return result;
+ return dump_object_finish (ctx, out_hdr, vectorlike_nbytes (out_hdr));
}
static void
@@ -2633,78 +2608,65 @@ dump_vectorlike_generic (struct dump_context *ctx,
return offset;
}
-/* Determine whether the hash table's hash order is stable
- across dump and load. If it is, we don't have to trigger
- a rehash on access. */
-static bool
-dump_hash_table_stable_p (const struct Lisp_Hash_Table *hash)
+/* Return a vector of KEY, VALUE pairs in the given hash table H. The
+ first H->count pairs are valid, and the rest are unbound. */
+static Lisp_Object
+hash_table_contents (struct Lisp_Hash_Table *h)
{
- if (hash->test.hashfn == hashfn_user_defined)
+ if (h->test.hashfn == hashfn_user_defined)
error ("cannot dump hash tables with user-defined tests"); /* Bug#36769 */
- bool is_eql = hash->test.hashfn == hashfn_eql;
- bool is_equal = hash->test.hashfn == hashfn_equal;
- ptrdiff_t size = HASH_TABLE_SIZE (hash);
- for (ptrdiff_t i = 0; i < size; ++i)
+
+ ptrdiff_t size = HASH_TABLE_SIZE (h);
+ Lisp_Object key_and_value = make_uninit_vector (2 * size);
+ ptrdiff_t n = 0;
+
+ /* Make sure key_and_value ends up in the same order; charset.c
+ relies on it by expecting hash table indices to stay constant
+ across the dump. */
+ for (ptrdiff_t i = 0; i < size; i++)
+ if (!NILP (HASH_HASH (h, i)))
+ {
+ ASET (key_and_value, n++, HASH_KEY (h, i));
+ ASET (key_and_value, n++, HASH_VALUE (h, i));
+ }
+
+ while (n < 2 * size)
{
- Lisp_Object key = HASH_KEY (hash, i);
- if (!EQ (key, Qunbound))
- {
- bool key_stable = (dump_builtin_symbol_p (key)
- || FIXNUMP (key)
- || (is_equal
- && (STRINGP (key) || BOOL_VECTOR_P (key)))
- || ((is_equal || is_eql)
- && (FLOATP (key) || BIGNUMP (key))));
- if (!key_stable)
- return false;
- }
+ ASET (key_and_value, n++, Qunbound);
+ ASET (key_and_value, n++, Qnil);
}
- return true;
+ return key_and_value;
}
-/* Return a list of (KEY . VALUE) pairs in the given hash table. */
-static Lisp_Object
-hash_table_contents (Lisp_Object table)
+static dump_off
+dump_hash_table_list (struct dump_context *ctx)
{
- Lisp_Object contents = Qnil;
- struct Lisp_Hash_Table *h = XHASH_TABLE (table);
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
- {
- Lisp_Object key = HASH_KEY (h, i);
- if (!EQ (key, Qunbound))
- dump_push (&contents, Fcons (key, HASH_VALUE (h, i)));
- }
- return Fnreverse (contents);
+ if (!NILP (ctx->hash_tables))
+ return dump_object (ctx, CALLN (Fapply, Qvector, ctx->hash_tables));
+ else
+ return 0;
}
-/* Copy the given hash table, rehash it, and make sure that we can
- look up all the values in the original. */
static void
-check_hash_table_rehash (Lisp_Object table_orig)
-{
- ptrdiff_t count = XHASH_TABLE (table_orig)->count;
- hash_rehash_if_needed (XHASH_TABLE (table_orig));
- Lisp_Object table_rehashed = Fcopy_hash_table (table_orig);
- eassert (!hash_rehash_needed_p (XHASH_TABLE (table_rehashed)));
- XHASH_TABLE (table_rehashed)->hash = Qnil;
- eassert (count == 0 || hash_rehash_needed_p (XHASH_TABLE (table_rehashed)));
- hash_rehash_if_needed (XHASH_TABLE (table_rehashed));
- eassert (!hash_rehash_needed_p (XHASH_TABLE (table_rehashed)));
- Lisp_Object expected_contents = hash_table_contents (table_orig);
- while (!NILP (expected_contents))
- {
- Lisp_Object key_value_pair = dump_pop (&expected_contents);
- Lisp_Object key = XCAR (key_value_pair);
- Lisp_Object expected_value = XCDR (key_value_pair);
- Lisp_Object arbitrary = Qdump_emacs_portable__sort_predicate_copied;
- Lisp_Object found_value = Fgethash (key, table_rehashed, arbitrary);
- eassert (EQ (expected_value, found_value));
- Fremhash (key, table_rehashed);
- }
+hash_table_freeze (struct Lisp_Hash_Table *h)
+{
+ ptrdiff_t npairs = ASIZE (h->key_and_value) / 2;
+ h->key_and_value = hash_table_contents (h);
+ h->next = h->hash = make_fixnum (npairs);
+ h->index = make_fixnum (ASIZE (h->index));
+ h->next_free = (npairs == h->count ? -1 : h->count);
+}
- eassert (EQ (Fhash_table_count (table_rehashed),
- make_fixnum (0)));
+static void
+hash_table_thaw (Lisp_Object hash)
+{
+ struct Lisp_Hash_Table *h = XHASH_TABLE (hash);
+ h->hash = make_nil_vector (XFIXNUM (h->hash));
+ h->next = Fmake_vector (h->next, make_fixnum (-1));
+ h->index = Fmake_vector (h->index, make_fixnum (-1));
+
+ hash_table_rehash (hash);
}
static dump_off
@@ -2712,55 +2674,15 @@ dump_hash_table (struct dump_context *ctx,
Lisp_Object object,
dump_off offset)
{
-#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_12AFBF47AF
+#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_6D63EDB618
# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h."
#endif
const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object);
- bool is_stable = dump_hash_table_stable_p (hash_in);
- /* If the hash table is likely to be modified in memory (either
- because we need to rehash, and thus toggle hash->count, or
- because we need to assemble a list of weak tables) punt the hash
- table to the end of the dump, where we can lump all such hash
- tables together. */
- if (!(is_stable || !NILP (hash_in->weak))
- && ctx->flags.defer_hash_tables)
- {
- if (offset != DUMP_OBJECT_ON_HASH_TABLE_QUEUE)
- {
- eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE
- || offset == DUMP_OBJECT_NOT_SEEN);
- /* We still want to dump the actual keys and values now. */
- dump_enqueue_object (ctx, hash_in->key_and_value, WEIGHT_NONE);
- /* We'll get to the rest later. */
- offset = DUMP_OBJECT_ON_HASH_TABLE_QUEUE;
- dump_remember_object (ctx, object, offset);
- dump_push (&ctx->deferred_hash_tables, object);
- }
- return offset;
- }
-
- if (PDUMPER_CHECK_REHASHING)
- check_hash_table_rehash (make_lisp_ptr ((void *) hash_in,
Lisp_Vectorlike));
-
struct Lisp_Hash_Table hash_munged = *hash_in;
struct Lisp_Hash_Table *hash = &hash_munged;
- /* Remember to rehash this hash table on first access. After a
- dump reload, the hash table values will have changed, so we'll
- need to rebuild the index.
-
- TODO: for EQ and EQL hash tables, it should be possible to rehash
- here using the preferred load address of the dump, eliminating
- the need to rehash-on-access if we can load the dump where we
- want. */
- if (hash->count > 0 && !is_stable)
- /* Hash codes will have to be recomputed anyway, so let's not dump them.
- Also set `hash` to nil for hash_rehash_needed_p.
- We could also refrain from dumping the `next' and `index' vectors,
- except that `next' is currently used for HASH_TABLE_SIZE and
- we'd have to rebuild the next_free list as well as adjust
- sweep_weak_hash_table for the case where there's no `index'. */
- hash->hash = Qnil;
+ hash_table_freeze (hash);
+ dump_push (&ctx->hash_tables, object);
START_DUMP_PVEC (ctx, &hash->header, struct Lisp_Hash_Table, out);
dump_pseudovector_lisp_fields (ctx, &out->header, &hash->header);
@@ -3429,9 +3351,7 @@ static void
dump_cold_charset (struct dump_context *ctx, Lisp_Object data)
{
/* Dump charset lookup tables. */
- ALLOW_IMPLICIT_CONVERSION;
int cs_i = XFIXNUM (XCAR (data));
- DISALLOW_IMPLICIT_CONVERSION;
dump_off cs_dump_offset = dump_off_from_lisp (XCDR (data));
dump_remember_fixup_ptr_raw
(ctx,
@@ -3767,9 +3687,7 @@ static struct emacs_reloc
decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc)
{
struct emacs_reloc reloc = {0};
- ALLOW_IMPLICIT_CONVERSION;
int type = XFIXNUM (dump_pop (&lreloc));
- DISALLOW_IMPLICIT_CONVERSION;
reloc.emacs_offset = dump_off_from_lisp (dump_pop (&lreloc));
dump_check_emacs_off (reloc.emacs_offset);
switch (type)
@@ -3780,9 +3698,7 @@ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object
lreloc)
reloc.u.dump_offset = dump_off_from_lisp (dump_pop (&lreloc));
dump_check_dump_off (ctx, reloc.u.dump_offset);
dump_off length = dump_off_from_lisp (dump_pop (&lreloc));
- ALLOW_IMPLICIT_CONVERSION;
reloc.length = length;
- DISALLOW_IMPLICIT_CONVERSION;
if (reloc.length != length)
error ("relocation copy length too large");
}
@@ -3793,9 +3709,7 @@ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object
lreloc)
intmax_t value = intmax_t_from_lisp (dump_pop (&lreloc));
dump_off size = dump_off_from_lisp (dump_pop (&lreloc));
reloc.u.immediate = value;
- ALLOW_IMPLICIT_CONVERSION;
reloc.length = size;
- DISALLOW_IMPLICIT_CONVERSION;
eassert (reloc.length == size);
}
break;
@@ -3820,9 +3734,7 @@ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object
lreloc)
RELOC_EMACS_IMMEDIATE relocation instead. */
eassert (!dump_object_self_representing_p (target_value));
int tag_type = XTYPE (target_value);
- ALLOW_IMPLICIT_CONVERSION;
reloc.length = tag_type;
- DISALLOW_IMPLICIT_CONVERSION;
eassert (reloc.length == tag_type);
if (type == RELOC_EMACS_EMACS_LV)
@@ -3897,9 +3809,7 @@ dump_merge_emacs_relocs (Lisp_Object lreloc_a,
Lisp_Object lreloc_b)
return Qnil;
dump_off new_length = reloc_a.length + reloc_b.length;
- ALLOW_IMPLICIT_CONVERSION;
reloc_a.length = new_length;
- DISALLOW_IMPLICIT_CONVERSION;
if (reloc_a.length != new_length)
return Qnil; /* Overflow */
@@ -4254,6 +4164,19 @@ types. */)
|| !NILP (ctx->deferred_hash_tables)
|| !NILP (ctx->deferred_symbols));
+ ctx->header.hash_list = ctx->offset;
+ dump_hash_table_list (ctx);
+
+ do
+ {
+ dump_drain_deferred_hash_tables (ctx);
+ dump_drain_deferred_symbols (ctx);
+ dump_drain_normal_queue (ctx);
+ }
+ while (!dump_queue_empty_p (&ctx->dump_queue)
+ || !NILP (ctx->deferred_hash_tables)
+ || !NILP (ctx->deferred_symbols));
+
dump_sort_copied_objects (ctx);
/* While we copy built-in symbols into the Emacs image, these
@@ -4314,9 +4237,9 @@ types. */)
for (int i = 0; i < RELOC_NUM_PHASES; ++i)
drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger,
&ctx->dump_relocs[i], &ctx->header.dump_relocs[i]);
- unsigned number_hot_relocations = ctx->number_hot_relocations;
+ dump_off number_hot_relocations = ctx->number_hot_relocations;
ctx->number_hot_relocations = 0;
- unsigned number_discardable_relocations =
ctx->number_discardable_relocations;
+ dump_off number_discardable_relocations =
ctx->number_discardable_relocations;
ctx->number_discardable_relocations = 0;
drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger,
&ctx->object_starts, &ctx->header.object_starts);
@@ -4341,14 +4264,17 @@ types. */)
dump_seek (ctx, 0);
dump_write (ctx, &ctx->header, sizeof (ctx->header));
+ dump_off
+ header_bytes = header_end - header_start,
+ hot_bytes = hot_end - hot_start,
+ discardable_bytes = discardable_end - ctx->header.discardable_start,
+ cold_bytes = cold_end - ctx->header.cold_start;
fprintf (stderr,
("Dump complete\n"
- "Byte counts: header=%lu hot=%lu discardable=%lu cold=%lu\n"
- "Reloc counts: hot=%u discardable=%u\n"),
- (unsigned long) (header_end - header_start),
- (unsigned long) (hot_end - hot_start),
- (unsigned long) (discardable_end - ctx->header.discardable_start),
- (unsigned long) (cold_end - ctx->header.cold_start),
+ "Byte counts: header=%"PRIdDUMP_OFF" hot=%"PRIdDUMP_OFF
+ " discardable=%"PRIdDUMP_OFF" cold=%"PRIdDUMP_OFF"\n"
+ "Reloc counts: hot=%"PRIdDUMP_OFF" discardable=%"PRIdDUMP_OFF"\n"),
+ header_bytes, hot_bytes, discardable_bytes, cold_bytes,
number_hot_relocations,
number_discardable_relocations);
@@ -5214,14 +5140,13 @@ dump_read_all (int fd, void *buf, size_t bytes_to_read)
{
/* We don't want to use emacs_read, since that relies on the lisp
world, and we're not in the lisp world yet. */
- eassert (bytes_to_read <= SSIZE_MAX);
size_t bytes_read = 0;
while (bytes_read < bytes_to_read)
{
- /* Some platforms accept only int-sized values to read. */
- unsigned chunk_to_read = INT_MAX;
- if (bytes_to_read - bytes_read < chunk_to_read)
- chunk_to_read = (unsigned) (bytes_to_read - bytes_read);
+ /* Some platforms accept only int-sized values to read.
+ Round this down to a page size (see MAX_RW_COUNT in sysdep.c). */
+ int max_rw_count = INT_MAX >> 18 << 18;
+ int chunk_to_read = min (bytes_to_read - bytes_read, max_rw_count);
ssize_t chunk = read (fd, (char *) buf + bytes_read, chunk_to_read);
if (chunk < 0)
return chunk;
@@ -5485,6 +5410,9 @@ enum dump_section
NUMBER_DUMP_SECTIONS,
};
+/* Pointer to a stack variable to avoid having to staticpro it. */
+static Lisp_Object *pdumper_hashes = &zero_vector;
+
/* Load a dump from DUMP_FILENAME. Return an error code.
N.B. We run very early in initialization, so we can't use lisp,
@@ -5631,6 +5559,15 @@ pdumper_load (const char *dump_filename, char *argv0,
char const *original_pwd)
for (int i = 0; i < ARRAYELTS (sections); ++i)
dump_mmap_reset (§ions[i]);
+ Lisp_Object hashes = zero_vector;
+ if (header->hash_list)
+ {
+ struct Lisp_Vector *hash_tables =
+ (struct Lisp_Vector *) (dump_base + header->hash_list);
+ hashes = make_lisp_ptr (hash_tables, Lisp_Vectorlike);
+ }
+
+ pdumper_hashes = &hashes;
/* Run the functions Emacs registered for doing post-dump-load
initialization. */
for (int i = 0; i < nr_dump_hooks; ++i)
@@ -5707,6 +5644,19 @@ Value is nil if this session was not started using a
dump file.*/)
#endif /* HAVE_PDUMPER */
+static void
+thaw_hash_tables (void)
+{
+ Lisp_Object hash_tables = *pdumper_hashes;
+ for (ptrdiff_t i = 0; i < ASIZE (hash_tables); i++)
+ hash_table_thaw (AREF (hash_tables, i));
+}
+
+void
+init_pdumper_once (void)
+{
+ pdumper_do_now_and_after_load (thaw_hash_tables);
+}
void
syms_of_pdumper (void)
diff --git a/src/pdumper.h b/src/pdumper.h
index b92958e..c4baeaf 100644
--- a/src/pdumper.h
+++ b/src/pdumper.h
@@ -257,6 +257,7 @@ pdumper_clear_marks (void)
file was loaded. */
extern void pdumper_record_wd (const char *);
+void init_pdumper_once (void);
void syms_of_pdumper (void);
INLINE_HEADER_END
diff --git a/src/timefns.c b/src/timefns.c
index 7bcc37d..94cfddf 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -2048,7 +2048,7 @@ syms_of_timefns (void)
defsubr (&Scurrent_time_zone);
defsubr (&Sset_time_zone_rule);
- flt_radix_power = make_vector (flt_radix_power_size, Qnil);
+ flt_radix_power = make_nil_vector (flt_radix_power_size);
staticpro (&flt_radix_power);
#ifdef NEED_ZTRILLION_INIT
diff --git a/src/xfaces.c b/src/xfaces.c
index 585cfa1..2c6e593 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -2517,6 +2517,7 @@ merge_face_ref (struct window *w,
{
bool ok = true; /* Succeed without an error? */
Lisp_Object filtered_face_ref;
+ bool attr_filter_passed = false;
filtered_face_ref = face_ref;
do
@@ -2613,6 +2614,7 @@ merge_face_ref (struct window *w,
|| UNSPECIFIEDP (scratch_attrs[attr_filter]))
return true;
}
+ attr_filter_passed = true;
}
while (CONSP (face_ref) && CONSP (XCDR (face_ref)))
{
@@ -2776,9 +2778,21 @@ merge_face_ref (struct window *w,
{
/* This is not really very useful; it's just like a
normal face reference. */
- if (! merge_face_ref (w, f, value, to,
- err_msgs, named_merge_points,
- attr_filter))
+ if (attr_filter_passed)
+ {
+ /* We already know that this face was tested
+ against attr_filter and was found applicable,
+ so don't pass attr_filter to merge_face_ref.
+ This is for when a face is specified like
+ (:inherit FACE :extend t), but the parent
+ FACE itself doesn't specify :extend. */
+ if (! merge_face_ref (w, f, value, to,
+ err_msgs, named_merge_points, 0))
+ err = true;
+ }
+ else if (! merge_face_ref (w, f, value, to,
+ err_msgs, named_merge_points,
+ attr_filter))
err = true;
}
else if (EQ (keyword, QCextend))
diff --git a/src/xwidget.c b/src/xwidget.c
index 0347f1e..c61f5be 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -23,13 +23,21 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "lisp.h"
#include "blockinput.h"
+#include "dispextern.h"
#include "frame.h"
#include "keyboard.h"
#include "gtkutil.h"
#include "sysstdio.h"
+#include "termhooks.h"
+#include "window.h"
+/* Include xwidget bottom end headers. */
+#ifdef USE_GTK
#include <webkit2/webkit2.h>
#include <JavaScriptCore/JavaScript.h>
+#elif defined NS_IMPL_COCOA
+#include "nsxwidget.h"
+#endif
static struct xwidget *
allocate_xwidget (void)
@@ -48,6 +56,7 @@ allocate_xwidget_view (void)
static struct xwidget_view *xwidget_view_lookup (struct xwidget *,
struct window *);
+#ifdef USE_GTK
static void webkit_view_load_changed_cb (WebKitWebView *,
WebKitLoadEvent,
gpointer);
@@ -61,6 +70,7 @@ webkit_decide_policy_cb (WebKitWebView *,
WebKitPolicyDecision *,
WebKitPolicyDecisionType,
gpointer);
+#endif
DEFUN ("make-xwidget",
@@ -78,8 +88,10 @@ Returns the newly constructed xwidget, or nil if
construction fails. */)
Lisp_Object title, Lisp_Object width, Lisp_Object height,
Lisp_Object arguments, Lisp_Object buffer)
{
+#ifdef USE_GTK
if (!xg_gtk_initialized)
error ("make-xwidget: GTK has not been initialized");
+#endif
CHECK_SYMBOL (type);
CHECK_FIXNAT (width);
CHECK_FIXNAT (height);
@@ -94,10 +106,11 @@ Returns the newly constructed xwidget, or nil if
construction fails. */)
xw->kill_without_query = false;
XSETXWIDGET (val, xw);
Vxwidget_list = Fcons (val, Vxwidget_list);
- xw->widgetwindow_osr = NULL;
- xw->widget_osr = NULL;
xw->plist = Qnil;
+#ifdef USE_GTK
+ xw->widgetwindow_osr = NULL;
+ xw->widget_osr = NULL;
if (EQ (xw->type, Qwebkit))
{
block_input ();
@@ -152,6 +165,9 @@ Returns the newly constructed xwidget, or nil if
construction fails. */)
unblock_input ();
}
+#elif defined NS_IMPL_COCOA
+ nsxwidget_init (xw);
+#endif
return val;
}
@@ -187,6 +203,7 @@ xwidget_hidden (struct xwidget_view *xv)
return xv->hidden;
}
+#ifdef USE_GTK
static void
xwidget_show_view (struct xwidget_view *xv)
{
@@ -220,13 +237,14 @@ offscreen_damage_event (GtkWidget *widget, GdkEvent
*event,
if (GTK_IS_WIDGET (xv_widget))
gtk_widget_queue_draw (GTK_WIDGET (xv_widget));
else
- printf ("Warning, offscreen_damage_event received invalid xv pointer:%p\n",
- xv_widget);
+ message ("Warning, offscreen_damage_event received invalid xv
pointer:%p\n",
+ xv_widget);
return FALSE;
}
+#endif /* USE_GTK */
-static void
+void
store_xwidget_event_string (struct xwidget *xw, const char *eventname,
const char *eventstr)
{
@@ -240,7 +258,27 @@ store_xwidget_event_string (struct xwidget *xw, const char
*eventname,
kbd_buffer_store_event (&event);
}
-static void
+void
+store_xwidget_download_callback_event (struct xwidget *xw,
+ const char *url,
+ const char *mimetype,
+ const char *filename)
+{
+ struct input_event event;
+ Lisp_Object xwl;
+ XSETXWIDGET (xwl, xw);
+ EVENT_INIT (event);
+ event.kind = XWIDGET_EVENT;
+ event.frame_or_window = Qnil;
+ event.arg = list5 (intern ("download-callback"),
+ xwl,
+ build_string (url),
+ build_string (mimetype),
+ build_string (filename));
+ kbd_buffer_store_event (&event);
+}
+
+void
store_xwidget_js_callback_event (struct xwidget *xw,
Lisp_Object proc,
Lisp_Object argument)
@@ -256,6 +294,7 @@ store_xwidget_js_callback_event (struct xwidget *xw,
}
+#ifdef USE_GTK
void
webkit_view_load_changed_cb (WebKitWebView *webkitwebview,
WebKitLoadEvent load_event,
@@ -486,6 +525,7 @@ xwidget_osr_event_set_embedder (GtkWidget *widget, GdkEvent
*event,
gtk_widget_get_window (xv->widget));
return FALSE;
}
+#endif /* USE_GTK */
/* Initializes and does initial placement of an xwidget view on screen. */
@@ -495,8 +535,10 @@ xwidget_init_view (struct xwidget *xww,
int x, int y)
{
+#ifdef USE_GTK
if (!xg_gtk_initialized)
error ("xwidget_init_view: GTK has not been initialized");
+#endif
struct xwidget_view *xv = allocate_xwidget_view ();
Lisp_Object val;
@@ -507,6 +549,7 @@ xwidget_init_view (struct xwidget *xww,
XSETWINDOW (xv->w, s->w);
XSETXWIDGET (xv->model, xww);
+#ifdef USE_GTK
if (EQ (xww->type, Qwebkit))
{
xv->widget = gtk_drawing_area_new ();
@@ -564,6 +607,10 @@ xwidget_init_view (struct xwidget *xww,
xv->x = x;
xv->y = y;
gtk_widget_show_all (xv->widgetwindow);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_init_view (xv, xww, s, x, y);
+ nsxwidget_resize_view(xv, xww->width, xww->height);
+#endif
return xv;
}
@@ -576,6 +623,7 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
initialization. */
struct xwidget *xww = s->xwidget;
struct xwidget_view *xv = xwidget_view_lookup (xww, s->w);
+ int text_area_x, text_area_y, text_area_width, text_area_height;
int clip_right;
int clip_bottom;
int clip_top;
@@ -587,13 +635,47 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
/* Do initialization here in the display loop because there is no
other time to know things like window placement etc. Do not
create a new view if we have found one that is usable. */
+#ifdef USE_GTK
if (!xv)
xv = xwidget_init_view (xww, s, x, y);
-
- int text_area_x, text_area_y, text_area_width, text_area_height;
+#elif defined NS_IMPL_COCOA
+ if (!xv)
+ {
+ /* Enforce 1 to 1, model and view for macOS Cocoa webkit2. */
+ if (xww->xv)
+ {
+ if (xwidget_hidden (xww->xv))
+ {
+ Lisp_Object xvl;
+ XSETXWIDGET_VIEW (xvl, xww->xv);
+ Fdelete_xwidget_view (xvl);
+ }
+ else
+ {
+ message ("You can't share an xwidget (webkit2) among windows.");
+ return;
+ }
+ }
+ xv = xwidget_init_view (xww, s, x, y);
+ }
+#endif
window_box (s->w, TEXT_AREA, &text_area_x, &text_area_y,
&text_area_width, &text_area_height);
+
+ /* Resize xwidget webkit if its container window size is changed in
+ some ways, for example, a buffer became hidden in small split
+ window, then it can appear front in merged whole window. */
+ if (EQ (xww->type, Qwebkit)
+ && (xww->width != text_area_width || xww->height != text_area_height))
+ {
+ Lisp_Object xwl;
+ XSETXWIDGET (xwl, xww);
+ Fxwidget_resize (xwl,
+ make_int (text_area_width),
+ make_int (text_area_height));
+ }
+
clip_left = max (0, text_area_x - x);
clip_right = max (clip_left,
min (xww->width, text_area_x + text_area_width - x));
@@ -616,8 +698,14 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
/* Has it moved? */
if (moved)
- gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (s->f)),
- xv->widgetwindow, x + clip_left, y + clip_top);
+ {
+#ifdef USE_GTK
+ gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (s->f)),
+ xv->widgetwindow, x + clip_left, y + clip_top);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_move_view (xv, x + clip_left, y + clip_top);
+#endif
+ }
/* Clip the widget window if some parts happen to be outside
drawable area. An Emacs window is not a gtk window. A gtk window
@@ -628,10 +716,16 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
|| xv->clip_bottom != clip_bottom
|| xv->clip_top != clip_top || xv->clip_left != clip_left)
{
+#ifdef USE_GTK
gtk_widget_set_size_request (xv->widgetwindow, clip_right - clip_left,
clip_bottom - clip_top);
gtk_fixed_move (GTK_FIXED (xv->widgetwindow), xv->widget, -clip_left,
-clip_top);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_resize_view (xv, clip_right - clip_left,
+ clip_bottom - clip_top);
+ nsxwidget_move_widget_in_view (xv, -clip_left, -clip_top);
+#endif
xv->clip_right = clip_right;
xv->clip_bottom = clip_bottom;
@@ -645,22 +739,66 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
xwidgets background. It's just a visual glitch though. */
if (!xwidget_hidden (xv))
{
+#ifdef USE_GTK
gtk_widget_queue_draw (xv->widgetwindow);
gtk_widget_queue_draw (xv->widget);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_set_needsdisplay (xv);
+#endif
}
}
-/* Macro that checks WEBKIT_IS_WEB_VIEW (xw->widget_osr) first. */
+static bool
+xwidget_is_web_view (struct xwidget *xw)
+{
+#ifdef USE_GTK
+ return xw->widget_osr != NULL && WEBKIT_IS_WEB_VIEW (xw->widget_osr);
+#elif defined NS_IMPL_COCOA
+ return nsxwidget_is_web_view (xw);
+#endif
+}
+
+/* Macro that checks xwidget hold webkit web view first. */
#define WEBKIT_FN_INIT() \
CHECK_XWIDGET (xwidget); \
struct xwidget *xw = XXWIDGET (xwidget); \
- if (!xw->widget_osr || !WEBKIT_IS_WEB_VIEW (xw->widget_osr)) \
+ if (!xwidget_is_web_view (xw)) \
{ \
fputs ("ERROR xw->widget_osr does not hold a webkit instance\n", \
stdout); \
return Qnil; \
}
+DEFUN ("xwidget-webkit-uri",
+ Fxwidget_webkit_uri, Sxwidget_webkit_uri,
+ 1, 1, 0,
+ doc: /* Get the current URL of XWIDGET webkit. */)
+ (Lisp_Object xwidget)
+{
+ WEBKIT_FN_INIT ();
+#ifdef USE_GTK
+ WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr);
+ return build_string (webkit_web_view_get_uri (wkwv));
+#elif defined NS_IMPL_COCOA
+ return nsxwidget_webkit_uri (xw);
+#endif
+}
+
+DEFUN ("xwidget-webkit-title",
+ Fxwidget_webkit_title, Sxwidget_webkit_title,
+ 1, 1, 0,
+ doc: /* Get the current title of XWIDGET webkit. */)
+ (Lisp_Object xwidget)
+{
+ WEBKIT_FN_INIT ();
+#ifdef USE_GTK
+ WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr);
+ return build_string (webkit_web_view_get_title (wkwv));
+#elif defined NS_IMPL_COCOA
+ return nsxwidget_webkit_title (xw);
+#endif
+}
+
DEFUN ("xwidget-webkit-goto-uri",
Fxwidget_webkit_goto_uri, Sxwidget_webkit_goto_uri,
2, 2, 0,
@@ -670,7 +808,36 @@ DEFUN ("xwidget-webkit-goto-uri",
WEBKIT_FN_INIT ();
CHECK_STRING (uri);
uri = ENCODE_FILE (uri);
+#ifdef USE_GTK
webkit_web_view_load_uri (WEBKIT_WEB_VIEW (xw->widget_osr), SSDATA (uri));
+#elif defined NS_IMPL_COCOA
+ nsxwidget_webkit_goto_uri (xw, SSDATA (uri));
+#endif
+ return Qnil;
+}
+
+DEFUN ("xwidget-webkit-goto-history",
+ Fxwidget_webkit_goto_history, Sxwidget_webkit_goto_history,
+ 2, 2, 0,
+ doc: /* Make the XWIDGET webkit load REL-POS (-1, 0, 1) page in browse
history. */)
+ (Lisp_Object xwidget, Lisp_Object rel_pos)
+{
+ WEBKIT_FN_INIT ();
+ /* Should be one of -1, 0, 1 */
+ if (XFIXNUM (rel_pos) < -1 || XFIXNUM (rel_pos) > 1)
+ args_out_of_range_3 (rel_pos, make_fixnum (-1), make_fixnum (1));
+
+#ifdef USE_GTK
+ WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr);
+ switch (XFIXNAT (rel_pos))
+ {
+ case -1: webkit_web_view_go_back (wkwv); break;
+ case 0: webkit_web_view_reload (wkwv); break;
+ case 1: webkit_web_view_go_forward (wkwv); break;
+ }
+#elif defined NS_IMPL_COCOA
+ nsxwidget_webkit_goto_history (xw, XFIXNAT (rel_pos));
+#endif
return Qnil;
}
@@ -684,14 +851,19 @@ DEFUN ("xwidget-webkit-zoom",
if (FLOATP (factor))
{
double zoom_change = XFLOAT_DATA (factor);
+#ifdef USE_GTK
webkit_web_view_set_zoom_level
(WEBKIT_WEB_VIEW (xw->widget_osr),
webkit_web_view_get_zoom_level
(WEBKIT_WEB_VIEW (xw->widget_osr)) + zoom_change);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_webkit_zoom (xw, zoom_change);
+#endif
}
return Qnil;
}
+#ifdef USE_GTK
/* Save script and fun in the script/callback save vector and return
its index. */
static ptrdiff_t
@@ -713,6 +885,7 @@ save_script_callback (struct xwidget *xw, Lisp_Object
script, Lisp_Object fun)
ASET (cbs, idx, Fcons (make_mint_ptr (xlispstrdup (script)), fun));
return idx;
}
+#endif
DEFUN ("xwidget-webkit-execute-script",
Fxwidget_webkit_execute_script, Sxwidget_webkit_execute_script,
@@ -729,6 +902,7 @@ argument procedure FUN.*/)
script = ENCODE_SYSTEM (script);
+#ifdef USE_GTK
/* Protect script and fun during GC. */
intptr_t idx = save_script_callback (xw, script, fun);
@@ -742,6 +916,9 @@ argument procedure FUN.*/)
NULL, /* cancelable */
webkit_javascript_finished_cb,
(gpointer) idx);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_webkit_execute_script (xw, SSDATA (script), fun);
+#endif
return Qnil;
}
@@ -758,6 +935,7 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize,
3, 3, 0,
xw->height = h;
/* If there is an offscreen widget resize it first. */
+#ifdef USE_GTK
if (xw->widget_osr)
{
gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width,
@@ -766,6 +944,9 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize,
3, 3, 0,
gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width,
xw->height);
}
+#elif defined NS_IMPL_COCOA
+ nsxwidget_resize (xw);
+#endif
for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); tail = XCDR (tail))
{
@@ -773,8 +954,14 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize,
3, 3, 0,
{
struct xwidget_view *xv = XXWIDGET_VIEW (XCAR (tail));
if (XXWIDGET (xv->model) == xw)
+ {
+#ifdef USE_GTK
gtk_widget_set_size_request (GTK_WIDGET (xv->widget), xw->width,
xw->height);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_resize_view(xv, xw->width, xw->height);
+#endif
+ }
}
}
@@ -793,9 +980,13 @@ Emacs allocated area accordingly. */)
(Lisp_Object xwidget)
{
CHECK_XWIDGET (xwidget);
+#ifdef USE_GTK
GtkRequisition requisition;
gtk_widget_size_request (XXWIDGET (xwidget)->widget_osr, &requisition);
return list2i (requisition.width, requisition.height);
+#elif defined NS_IMPL_COCOA
+ return nsxwidget_get_size (XXWIDGET (xwidget));
+#endif
}
DEFUN ("xwidgetp",
@@ -872,14 +1063,19 @@ DEFUN ("delete-xwidget-view",
{
CHECK_XWIDGET_VIEW (xwidget_view);
struct xwidget_view *xv = XXWIDGET_VIEW (xwidget_view);
+#ifdef USE_GTK
gtk_widget_destroy (xv->widgetwindow);
- Vxwidget_view_list = Fdelq (xwidget_view, Vxwidget_view_list);
/* xv->model still has signals pointing to the view. There can be
several views. Find the matching signals and delete them all. */
g_signal_handlers_disconnect_matched (XXWIDGET
(xv->model)->widgetwindow_osr,
G_SIGNAL_MATCH_DATA,
0, 0, 0, 0,
xv->widget);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_delete_view (xv);
+#endif
+
+ Vxwidget_view_list = Fdelq (xwidget_view, Vxwidget_view_list);
return Qnil;
}
@@ -985,7 +1181,10 @@ syms_of_xwidget (void)
defsubr (&Sxwidget_query_on_exit_flag);
defsubr (&Sset_xwidget_query_on_exit_flag);
+ defsubr (&Sxwidget_webkit_uri);
+ defsubr (&Sxwidget_webkit_title);
defsubr (&Sxwidget_webkit_goto_uri);
+ defsubr (&Sxwidget_webkit_goto_history);
defsubr (&Sxwidget_webkit_zoom);
defsubr (&Sxwidget_webkit_execute_script);
DEFSYM (Qwebkit, "webkit");
@@ -1156,11 +1355,19 @@ xwidget_end_redisplay (struct window *w, struct
glyph_matrix *matrix)
xwidget_end_redisplay (w->current_matrix); */
struct xwidget_view *xv
= xwidget_view_lookup (glyph->u.xwidget, w);
+#ifdef USE_GTK
/* FIXME: Is it safe to assume xwidget_view_lookup
always succeeds here? If so, this comment can be removed.
If not, the code probably needs fixing. */
eassume (xv);
xwidget_touch (xv);
+#elif defined NS_IMPL_COCOA
+ /* In NS xwidget, xv can be NULL for the second or
+ later views for a model, the result of 1 to 1
+ model view relation enforcement. */
+ if (xv)
+ xwidget_touch (xv);
+#endif
}
}
}
@@ -1177,9 +1384,21 @@ xwidget_end_redisplay (struct window *w, struct
glyph_matrix *matrix)
if (XWINDOW (xv->w) == w)
{
if (xwidget_touched (xv))
- xwidget_show_view (xv);
+ {
+#ifdef USE_GTK
+ xwidget_show_view (xv);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_show_view (xv);
+#endif
+ }
else
- xwidget_hide_view (xv);
+ {
+#ifdef USE_GTK
+ xwidget_hide_view (xv);
+#elif defined NS_IMPL_COCOA
+ nsxwidget_hide_view (xv);
+#endif
+ }
}
}
}
@@ -1198,6 +1417,7 @@ kill_buffer_xwidgets (Lisp_Object buffer)
{
CHECK_XWIDGET (xwidget);
struct xwidget *xw = XXWIDGET (xwidget);
+#ifdef USE_GTK
if (xw->widget_osr && xw->widgetwindow_osr)
{
gtk_widget_destroy (xw->widget_osr);
@@ -1211,6 +1431,9 @@ kill_buffer_xwidgets (Lisp_Object buffer)
xfree (xmint_pointer (XCAR (cb)));
ASET (xw->script_callbacks, idx, Qnil);
}
+#elif defined NS_IMPL_COCOA
+ nsxwidget_kill (xw);
+#endif
}
}
}
diff --git a/src/xwidget.h b/src/xwidget.h
index 99fa8bb..40ad8ae 100644
--- a/src/xwidget.h
+++ b/src/xwidget.h
@@ -29,7 +29,13 @@ struct xwidget_view;
struct window;
#ifdef HAVE_XWIDGETS
-# include <gtk/gtk.h>
+
+#if defined (USE_GTK)
+#include <gtk/gtk.h>
+#elif defined (NS_IMPL_COCOA) && defined (__OBJC__)
+#import <AppKit/NSView.h>
+#import "nsxwidget.h"
+#endif
struct xwidget
{
@@ -54,9 +60,25 @@ struct xwidget
int height;
int width;
+#if defined (USE_GTK)
/* For offscreen widgets, unused if not osr. */
GtkWidget *widget_osr;
GtkWidget *widgetwindow_osr;
+#elif defined (NS_IMPL_COCOA)
+# ifdef __OBJC__
+ /* For offscreen widgets, unused if not osr. */
+ NSView *xwWidget;
+ XwWindow *xwWindow;
+
+ /* Used only for xwidget types (such as webkit2) enforcing 1 to 1
+ relationship between model and view. */
+ struct xwidget_view *xv;
+# else
+ void *xwWidget;
+ void *xwWindow;
+ struct xwidget_view *xv;
+# endif
+#endif
/* Kill silently if Emacs is exited. */
bool_bf kill_without_query : 1;
@@ -75,9 +97,20 @@ struct xwidget_view
/* The "live" instance isn't drawn. */
bool hidden;
+#if defined (USE_GTK)
GtkWidget *widget;
GtkWidget *widgetwindow;
GtkWidget *emacswindow;
+#elif defined (NS_IMPL_COCOA)
+# ifdef __OBJC__
+ XvWindow *xvWindow;
+ NSView *emacswindow;
+# else
+ void *xvWindow;
+ void *emacswindow;
+# endif
+#endif
+
int x;
int y;
int clip_right;
@@ -116,6 +149,19 @@ void x_draw_xwidget_glyph_string (struct glyph_string *);
struct xwidget *lookup_xwidget (Lisp_Object spec);
void xwidget_end_redisplay (struct window *, struct glyph_matrix *);
void kill_buffer_xwidgets (Lisp_Object);
+/* Defined in 'xwidget.c'. */
+void store_xwidget_event_string (struct xwidget *xw,
+ const char *eventname,
+ const char *eventstr);
+
+void store_xwidget_download_callback_event (struct xwidget *xw,
+ const char *url,
+ const char *mimetype,
+ const char *filename);
+
+void store_xwidget_js_callback_event (struct xwidget *xw,
+ Lisp_Object proc,
+ Lisp_Object argument);
#else
INLINE_HEADER_BEGIN
INLINE void syms_of_xwidget (void) {}
diff --git a/test/lisp/bookmark-resources/test-list.bmk
b/test/lisp/bookmark-resources/test-list.bmk
new file mode 100644
index 0000000..696d649
--- /dev/null
+++ b/test/lisp/bookmark-resources/test-list.bmk
@@ -0,0 +1,20 @@
+;;;; Emacs Bookmark Format Version 1 ;;;; -*- coding: utf-8-emacs -*-
+;;; This format is meant to be slightly human-readable;
+;;; nevertheless, you probably don't want to edit it.
+;;; -*- End Of Bookmark File Format Version Stamp -*-
+(("name-0"
+ (filename . "/some/file-0")
+ (front-context-string . "abc")
+ (rear-context-string . "def")
+ (position . 3))
+("name-1"
+ (filename . "/some/file-1")
+ (front-context-string . "abc")
+ (rear-context-string . "def")
+ (position . 3))
+("name-2"
+ (filename . "/some/file-2")
+ (front-context-string . "abc")
+ (rear-context-string . "def")
+ (position . 3))
+)
diff --git a/test/lisp/bookmark-tests.el b/test/lisp/bookmark-tests.el
index b9c6ff9..c5959e4 100644
--- a/test/lisp/bookmark-tests.el
+++ b/test/lisp/bookmark-tests.el
@@ -83,6 +83,70 @@ the lexically-bound variable `buffer'."
,@body)
(kill-buffer buffer))))
+(defvar bookmark-tests-bookmark-file-list
+ (expand-file-name "test-list.bmk" bookmark-tests-data-dir)
+ "Bookmark file used for testing a list of bookmarks.")
+
+;; The values below should match `bookmark-tests-bookmark-file-list'
+;; content. We cache these values to speed up tests.
+(eval-and-compile ; needed by `with-bookmark-test-list' macro
+ (defvar bookmark-tests-bookmark-list-0 '("name-0"
+ (filename . "/some/file-0")
+ (front-context-string . "ghi")
+ (rear-context-string . "jkl")
+ (position . 4))
+ "Cached value used in bookmark-tests.el."))
+
+;; The values below should match `bookmark-tests-bookmark-file-list'
+;; content. We cache these values to speed up tests.
+(eval-and-compile ; needed by `with-bookmark-test-list' macro
+ (defvar bookmark-tests-bookmark-list-1 '("name-1"
+ (filename . "/some/file-1")
+ (front-context-string . "mno")
+ (rear-context-string . "pqr")
+ (position . 5))
+ "Cached value used in bookmark-tests.el."))
+
+;; The values below should match `bookmark-tests-bookmark-file-list'
+;; content. We cache these values to speed up tests.
+(eval-and-compile ; needed by `with-bookmark-test-list' macro
+ (defvar bookmark-tests-bookmark-list-2 '("name-2"
+ (filename . "/some/file-2")
+ (front-context-string . "stu")
+ (rear-context-string . "vwx")
+ (position . 6))
+ "Cached value used in bookmark-tests.el."))
+
+(defvar bookmark-tests-cache-timestamp-list
+ (cons bookmark-tests-bookmark-file-list
+ (nth 5 (file-attributes
+ bookmark-tests-bookmark-file-list)))
+ "Cached value used in bookmark-tests.el.")
+
+(defmacro with-bookmark-test-list (&rest body)
+ "Create environment for testing bookmark.el and evaluate BODY.
+Ensure a clean environment for testing, and do not change user
+data when running tests interactively."
+ `(with-temp-buffer
+ (let ((bookmark-alist (quote (,(copy-sequence
bookmark-tests-bookmark-list-0)
+ ,(copy-sequence
bookmark-tests-bookmark-list-1)
+ ,(copy-sequence
bookmark-tests-bookmark-list-2))))
+ (bookmark-default-file bookmark-tests-bookmark-file-list)
+ (bookmark-bookmarks-timestamp bookmark-tests-cache-timestamp-list)
+ bookmark-save-flag)
+ ,@body)))
+
+(defmacro with-bookmark-test-file-list (&rest body)
+ "Create environment for testing bookmark.el and evaluate BODY.
+Same as `with-bookmark-test-list' but also opens the resource file
+example.txt in a buffer, which can be accessed by callers through
+the lexically-bound variable `buffer'."
+ `(let ((buffer (find-file-noselect bookmark-tests-example-file)))
+ (unwind-protect
+ (with-bookmark-test-list
+ ,@body)
+ (kill-buffer buffer))))
+
(ert-deftest bookmark-tests-all-names ()
(with-bookmark-test
(should (equal (bookmark-all-names) '("name")))))
@@ -95,6 +159,30 @@ the lexically-bound variable `buffer'."
(with-bookmark-test
(should (equal (bookmark-get-bookmark-record "name") (cdr
bookmark-tests-bookmark)))))
+(ert-deftest bookmark-tests-all-names-list ()
+ (with-bookmark-test-list
+ (should (equal (bookmark-all-names) '("name-0"
+ "name-1"
+ "name-2")))))
+
+(ert-deftest bookmark-tests-get-bookmark-list ()
+ (with-bookmark-test-list
+ (should (equal (bookmark-get-bookmark "name-0")
+ bookmark-tests-bookmark-list-0))
+ (should (equal (bookmark-get-bookmark "name-1")
+ bookmark-tests-bookmark-list-1))
+ (should (equal (bookmark-get-bookmark "name-2")
+ bookmark-tests-bookmark-list-2))))
+
+(ert-deftest bookmark-tests-get-bookmark-record-list ()
+ (with-bookmark-test-list
+ (should (equal (bookmark-get-bookmark-record "name-0")
+ (cdr bookmark-tests-bookmark-list-0)))
+ (should (equal (bookmark-get-bookmark-record "name-1")
+ (cdr bookmark-tests-bookmark-list-1)))
+ (should (equal (bookmark-get-bookmark-record "name-2")
+ (cdr bookmark-tests-bookmark-list-2)))))
+
(ert-deftest bookmark-tests-record-getters-and-setters-new ()
(with-temp-buffer
(let* ((buffer-file-name "test")
@@ -130,6 +218,19 @@ the lexically-bound variable `buffer'."
;; calling twice gives same record
(should (equal (bookmark-make-record) record))))))
+(ert-deftest bookmark-tests-make-record-list ()
+ (with-bookmark-test-file-list
+ (let* ((record `("example.txt" (filename . ,bookmark-tests-example-file)
+ (front-context-string . "is text file is ")
+ (rear-context-string)
+ (position . 3)
+ (defaults "example.txt"))))
+ (with-current-buffer buffer
+ (goto-char 3)
+ (should (equal (bookmark-make-record) record))
+ ;; calling twice gives same record
+ (should (equal (bookmark-make-record) record))))))
+
(ert-deftest bookmark-tests-make-record-function ()
(with-bookmark-test
(let ((buffer-file-name "test"))
@@ -267,6 +368,11 @@ the lexically-bound variable `buffer'."
(bookmark-delete "name")
(should (equal bookmark-alist nil))))
+(ert-deftest bookmark-tests-delete-all ()
+ (with-bookmark-test-list
+ (bookmark-delete-all t)
+ (should (equal bookmark-alist nil))))
+
(defmacro with-bookmark-test-save-load (&rest body)
"Create environment for testing bookmark.el and evaluate BODY.
Same as `with-bookmark-test' but also sets a temporary
@@ -340,6 +446,18 @@ testing `bookmark-bmenu-list'."
,@body)
(kill-buffer bookmark-bmenu-buffer)))))
+(defmacro with-bookmark-bmenu-test-list (&rest body)
+ "Create environment for testing `bookmark-bmenu-list' and evaluate BODY.
+Same as `with-bookmark-test-list' but with additions suitable for
+testing `bookmark-bmenu-list'."
+ `(with-bookmark-test-list
+ (let ((bookmark-bmenu-buffer "*Bookmark List - Testing*"))
+ (unwind-protect
+ (save-window-excursion
+ (bookmark-bmenu-list)
+ ,@body)
+ (kill-buffer bookmark-bmenu-buffer)))))
+
(ert-deftest bookmark-test-bmenu-edit-annotation/show-annotation ()
(with-bookmark-bmenu-test
(bookmark-set-annotation "name" "foo")
@@ -402,6 +520,52 @@ testing `bookmark-bmenu-list'."
(beginning-of-line)
(should (bookmark-bmenu-any-marks))))
+(ert-deftest bookmark-test-bmenu-mark-all ()
+ (with-bookmark-bmenu-test-list
+ (let ((here (point-max)))
+ ;; Expect to not move the point
+ (goto-char here)
+ (bookmark-bmenu-mark-all)
+ (should (equal here (point)))
+ ;; Verify that all bookmarks are marked
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (should (looking-at "^> "))
+ (should (equal bookmark-tests-bookmark-list-0
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^> "))
+ (should (equal bookmark-tests-bookmark-list-1
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^> "))
+ (should (equal bookmark-tests-bookmark-list-2
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark)))))))
+
+(ert-deftest bookmark-test-bmenu-any-marks-list ()
+ (with-bookmark-bmenu-test-list
+ ;; Mark just the second item
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (forward-line 1)
+ (bookmark-bmenu-mark)
+ ;; Verify that only the second item is marked
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (should (looking-at "^ "))
+ (should (equal bookmark-tests-bookmark-list-0
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^> "))
+ (should (equal bookmark-tests-bookmark-list-1
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^ "))
+ (should (equal bookmark-tests-bookmark-list-2
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ ;; There should be at least one mark
+ (should (bookmark-bmenu-any-marks))))
+
(ert-deftest bookmark-test-bmenu-unmark ()
(with-bookmark-bmenu-test
(bookmark-bmenu-mark)
@@ -410,12 +574,63 @@ testing `bookmark-bmenu-list'."
(beginning-of-line)
(should (looking-at "^ "))))
+(ert-deftest bookmark-test-bmenu-unmark-all ()
+ (with-bookmark-bmenu-test-list
+ (bookmark-bmenu-mark-all)
+ (let ((here (point-max)))
+ ;; Expect to not move the point
+ (goto-char here)
+ (bookmark-bmenu-unmark-all)
+ (should (equal here (point)))
+ ;; Verify that all bookmarks are unmarked
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (should (looking-at "^ "))
+ (should (equal bookmark-tests-bookmark-list-0
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^ "))
+ (should (equal bookmark-tests-bookmark-list-1
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^ "))
+ (should (equal bookmark-tests-bookmark-list-2
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark)))))))
+
(ert-deftest bookmark-test-bmenu-delete ()
(with-bookmark-bmenu-test
(bookmark-bmenu-delete)
(bookmark-bmenu-execute-deletions)
(should (equal (length bookmark-alist) 0))))
+(ert-deftest bookmark-test-bmenu-delete-all ()
+ (with-bookmark-bmenu-test-list
+ ;; Verify that unmarked bookmarks aren't deleted
+ (bookmark-bmenu-execute-deletions)
+ (should-not (eq bookmark-alist nil))
+ (let ((here (point-max)))
+ ;; Expect to not move the point
+ (goto-char here)
+ (bookmark-bmenu-delete-all)
+ (should (equal here (point)))
+ ;; Verify that all bookmarks are marked for deletion
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (should (looking-at "^D "))
+ (should (equal bookmark-tests-bookmark-list-0
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^D "))
+ (should (equal bookmark-tests-bookmark-list-1
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ (forward-line 1)
+ (should (looking-at "^D "))
+ (should (equal bookmark-tests-bookmark-list-2
+ (bookmark-get-bookmark (bookmark-bmenu-bookmark))))
+ ;; Verify that all bookmarks are deleted
+ (bookmark-bmenu-execute-deletions)
+ (should (eq bookmark-alist nil)))))
+
(ert-deftest bookmark-test-bmenu-locate ()
(let (msg)
(cl-letf (((symbol-function 'message)
diff --git a/test/lisp/emacs-lisp/lisp-tests.el
b/test/lisp/emacs-lisp/lisp-tests.el
index 8736ac7..a2b8304 100644
--- a/test/lisp/emacs-lisp/lisp-tests.el
+++ b/test/lisp/emacs-lisp/lisp-tests.el
@@ -367,6 +367,61 @@ start."
"
"Test buffer for `mark-defun'."))
+;;; end-of-defun
+
+(ert-deftest end-of-defun-twice ()
+ "Test behavior of prefix arg for `end-of-defun' (Bug#24427).
+Calling `end-of-defun' twice should be the same as a prefix arg
+of two."
+ (setq last-command nil)
+ (cl-flet ((eod2 (lambda ()
+ (goto-char (point-min))
+ (end-of-defun)
+ (end-of-defun)
+ (let ((pt-eod2 (point)))
+ (goto-char (point-min))
+ (end-of-defun 2)
+ (should (= (point) pt-eod2))))))
+ (with-temp-buffer
+ (insert "\
+\(defun a ())
+
+\(defun b ())
+
+\(defun c ())")
+ (eod2))
+ (with-temp-buffer
+ (insert "\
+\(defun a ())
+\(defun b ())
+\(defun c ())")
+ (eod2)))
+ (elisp-tests-with-temp-buffer ";; Comment header
+
+\(defun func-1 (arg)
+ \"docstring\"
+ body)
+=!p1=
+;; Comment before a defun
+\(defun func-2 (arg)
+ \"docstring\"
+ body)
+
+\(defun func-3 (arg)
+ \"docstring\"
+ body)
+=!p2=(defun func-4 (arg)
+ \"docstring\"
+ body)
+
+;; end
+"
+ (goto-char p1)
+ (end-of-defun 2)
+ (should (= (point) p2))))
+
+;;; mark-defun
+
(ert-deftest mark-defun-no-arg-region-inactive ()
"Test `mark-defun' with no prefix argument and inactive
region."
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 4b902fd..5b2f5fd 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -190,7 +190,6 @@ form.")
(ert-deftest files-tests-bug-21454 ()
"Test for https://debbugs.gnu.org/21454 ."
- :expected-result :failed
(let ((input-result
'(("/foo/bar//baz/:/bar/foo/baz//" nil ("/foo/bar/baz/"
"/bar/foo/baz/"))
("/foo/bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/"
"/qux/foo/"))
@@ -1362,5 +1361,9 @@ See <https://debbugs.gnu.org/36401>."
(normal-mode)
(should (not (eq major-mode 'text-mode))))))
+(ert-deftest files-colon-path ()
+ (should (equal (parse-colon-path "/foo//bar/baz")
+ '("/foo/bar/baz/"))))
+
(provide 'files-tests)
;;; files-tests.el ends here
diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
index 8f78a66..07da4bf 100644
--- a/test/lisp/gnus/mml-sec-tests.el
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -663,6 +663,7 @@ In this test, just multiple encryption and signing keys may
be available."
(ert-deftest mml-secure-en-decrypt-sign-1-3-double ()
"Sign and encrypt message; then decrypt and test for expected result.
In this test, just multiple encryption and signing keys may be available."
+ :tags '(:unstable)
(skip-unless (test-conf))
(mml-secure-test-key-fixture
(lambda ()
@@ -680,6 +681,7 @@ In this test, just multiple encryption and signing keys may
be available."
(ert-deftest mml-secure-en-decrypt-sign-2 ()
"Sign and encrypt message; then decrypt and test for expected result.
In this test, lists of encryption and signing keys are customized."
+ :tags '(:unstable)
(skip-unless (test-conf))
(mml-secure-test-key-fixture
(lambda ()
@@ -714,6 +716,7 @@ In this test, lists of encryption and signing keys are
customized."
(ert-deftest mml-secure-en-decrypt-sign-3 ()
"Sign and encrypt message; then decrypt and test for expected result.
Use sign-with-sender and encrypt-to-self."
+ :tags '(:unstable)
(skip-unless (test-conf))
(mml-secure-test-key-fixture
(lambda ()
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index d2dc3d2..da2b49e 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -160,4 +160,15 @@ Return first line of the output of (describe-function-1
FUNC)."
(with-current-buffer "*Help*"
(should (looking-at "^help-fns-test--describe-keymap-foo is"))))
+;;; Tests for find-lisp-object-file-name
+(ert-deftest help-fns-test-bug24697-function-search ()
+ (should-not (find-lisp-object-file-name 'tab-width 1)))
+
+(ert-deftest help-fns-test-bug24697-non-internal-variable ()
+ (let ((help-fns--test-var (make-symbol "help-fns--test-var")))
+ ;; simulate an internal variable
+ (put help-fns--test-var 'variable-documentation 1)
+ (should-not (find-lisp-object-file-name help-fns--test-var 'defface))
+ (should-not (find-lisp-object-file-name help-fns--test-var 1))))
+
;;; help-fns-tests.el ends here
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 51b2ca0..0fd8e1d 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -24,6 +24,7 @@
;; module in test/data/emacs-module.
;;; Code:
+;;; Prelude
(require 'cl-lib)
(require 'ert)
@@ -48,9 +49,7 @@
(cl-defmethod emacs-module-tests--generic ((_ user-ptr))
'user-ptr)
-;;
-;; Basic tests.
-;;
+;;; Basic tests
(ert-deftest mod-test-sum-test ()
(should (= (mod-test-sum 1 2) 3))
@@ -103,9 +102,7 @@ changes."
">" eos)
(prin1-to-string func)))))
-;;
-;; Non-local exists (throw, signal).
-;;
+;;; Non-local exists (throw, signal)
(ert-deftest mod-test-non-local-exit-signal-test ()
(should-error (mod-test-signal))
@@ -142,9 +139,7 @@ changes."
(should (equal (mod-test-non-local-exit-funcall (lambda () (throw 'tag 32)))
'(throw tag 32))))
-;;
-;; String tests.
-;;
+;;; String tests
(defun multiply-string (s n)
"Return N copies of S concatenated together."
@@ -168,9 +163,7 @@ changes."
(ert-deftest mod-test-string-a-to-b-test ()
(should (string= (mod-test-string-a-to-b "aaa") "bbb")))
-;;
-;; User-pointer tests.
-;;
+;;; User-pointer tests
(ert-deftest mod-test-userptr-fun-test ()
(let* ((n 42)
@@ -184,9 +177,7 @@ changes."
;; TODO: try to test finalizer
-;;
-;; Vector tests.
-;;
+;;; Vector tests
(ert-deftest mod-test-vector-test ()
(dolist (s '(2 10 100 1000))