[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp cf1e8e7 1/2: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp cf1e8e7 1/2: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Sun, 21 Feb 2021 16:21:38 -0500 (EST) |
branch: feature/native-comp
commit cf1e8e792f60949e09e3ad4c53fb61b0b7628229
Merge: 39792cf d0c4765
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into HEAD
---
CONTRIBUTE | 14 +-
admin/cus-test.el | 7 +
doc/emacs/basic.texi | 5 +
doc/emacs/m-x.texi | 8 +
doc/lispref/commands.texi | 33 ++-
doc/lispref/display.texi | 2 +-
doc/lispref/functions.texi | 4 +
doc/lispref/markers.texi | 4 +-
doc/lispref/sequences.texi | 2 +-
doc/lispref/windows.texi | 2 +-
doc/misc/efaq.texi | 5 +
doc/misc/tramp.texi | 66 ++++--
etc/NEWS | 18 +-
etc/NEWS.19 | 1 +
etc/ORG-NEWS | 2 +-
lisp/battery.el | 4 +-
lisp/calculator.el | 62 ++----
lisp/calendar/parse-time.el | 2 +-
lisp/cedet/ede.el | 2 +-
lisp/comint.el | 4 +-
lisp/dired-x.el | 2 +-
lisp/emacs-lisp/bindat.el | 18 +-
lisp/emacs-lisp/byte-opt.el | 2 +-
lisp/emacs-lisp/byte-run.el | 4 +-
lisp/emacs-lisp/bytecomp.el | 28 ++-
lisp/emacs-lisp/chart.el | 6 +-
lisp/emacs-lisp/edebug.el | 74 ++-----
lisp/emacs-lisp/eldoc.el | 4 +-
lisp/emacs-lisp/package.el | 53 +++--
lisp/emacs-lisp/pcase.el | 4 +-
lisp/emacs-lisp/re-builder.el | 78 +++----
lisp/emacs-lisp/rx.el | 2 +-
lisp/finder.el | 27 ++-
lisp/gnus/gnus-search.el | 16 +-
lisp/gnus/nnselect.el | 2 +-
lisp/help-mode.el | 28 ++-
lisp/image-mode.el | 4 +-
lisp/isearch.el | 2 +-
lisp/json.el | 36 ++--
lisp/man.el | 41 ++--
lisp/mh-e/mh-show.el | 2 +-
lisp/net/dictionary-connection.el | 6 +-
lisp/net/dictionary.el | 20 +-
lisp/net/eudcb-macos-contacts.el | 2 +-
lisp/net/mailcap.el | 2 +-
lisp/net/newst-treeview.el | 30 +--
lisp/net/socks.el | 4 +-
lisp/net/tramp-smb.el | 2 +-
lisp/nxml/nxml-mode.el | 2 +-
lisp/play/bubbles.el | 130 +++++-------
lisp/play/handwrite.el | 2 +-
lisp/play/snake.el | 15 +-
lisp/play/tetris.el | 19 +-
lisp/plstore.el | 3 +-
lisp/progmodes/asm-mode.el | 20 +-
lisp/progmodes/cc-engine.el | 2 +-
lisp/progmodes/cperl-mode.el | 8 +-
lisp/progmodes/elisp-mode.el | 20 +-
lisp/progmodes/flymake.el | 2 +-
lisp/progmodes/grep.el | 76 +++----
lisp/progmodes/m4-mode.el | 26 +--
lisp/progmodes/make-mode.el | 119 +++++------
lisp/progmodes/sh-script.el | 116 +++++------
lisp/progmodes/verilog-mode.el | 4 +-
lisp/simple.el | 102 +++++++---
lisp/subr.el | 12 +-
lisp/textmodes/bibtex.el | 2 +-
lisp/textmodes/texnfo-upd.el | 2 +-
lisp/url/url-http.el | 2 +-
lisp/w32-fns.el | 1 +
lisp/wdired.el | 6 +-
lisp/woman.el | 22 +-
src/alloc.c | 33 +++
src/callproc.c | 6 +-
src/data.c | 12 +-
src/dispnew.c | 2 +-
src/font.c | 2 +-
src/indent.c | 2 +-
src/nsterm.m | 7 +-
src/process.c | 2 +-
src/w32.c | 51 +++++
src/w32fns.c | 2 +-
test/Makefile.in | 15 +-
test/README | 7 +-
test/file-organization.org | 4 +
test/lisp/custom-tests.el | 11 -
test/lisp/emacs-lisp/edebug-tests.el | 34 ++--
test/lisp/emacs-lisp/rx-tests.el | 2 +
test/lisp/json-tests.el | 79 +++++++-
test/lisp/jsonrpc-tests.el | 2 +-
test/lisp/net/ntlm-resources/authinfo | 1 +
test/lisp/net/ntlm-tests.el | 368 ++++++++++++++++++++++++++++++++++
test/lisp/net/socks-tests.el | 291 ++++++++++++++++++++++-----
test/lisp/net/tramp-tests.el | 4 +-
test/lisp/textmodes/dns-mode-tests.el | 2 +-
test/misc/test-custom-deps.el | 42 ++++
test/misc/test-custom-libs.el | 46 +++++
test/misc/test-custom-noloads.el | 45 +++++
test/misc/test-custom-opts.el | 39 ++++
test/src/keyboard-tests.el | 39 +++-
100 files changed, 1800 insertions(+), 809 deletions(-)
diff --git a/CONTRIBUTE b/CONTRIBUTE
index 9b2af9c..bbf5262 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -66,11 +66,15 @@ more reliably, and makes the job of applying the patches
easier and less
error-prone. It also allows sending patches whose author is someone
other than the email sender.
-Once the cumulative amount of your submissions exceeds about 15 lines
-of non-trivial code, we will need you to assign to the FSF the
-copyright for your contributions. Ask on emacs-devel@gnu.org, and we
-will send you the necessary form together with the instructions to
-fill and email it, in order to start this legal paperwork.
+Once the cumulative amount of your submissions exceeds a dozen or so
+lines of non-trivial changes, we will need you to assign to the FSF
+the copyright for your contributions. (To see how many lines were
+non-trivially changed, count only added and modified lines in the
+patched code. Consider an added or changed line non-trivial if it
+includes at least one identifier, string, or substantial comment.)
+Ask on emacs-devel@gnu.org, and we will send you the necessary form
+together with the instructions to fill and email it, in order to start
+this legal paperwork.
** Issue tracker (a.k.a. "bug tracker")
diff --git a/admin/cus-test.el b/admin/cus-test.el
index afd5f4c..30b5f65 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -37,6 +37,13 @@
;;
;; src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
;;
+;; or as a part of the test suite with
+;;
+;; make -C test test-custom-opts
+;; make -C test test-custom-deps
+;; make -C test test-custom-libs
+;; make -C test test-custom-noloads
+;;
;; in the emacs source directory.
;;
;; For interactive use: Load this file. Then
diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index 8bf52d5..4a34fd3 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -331,6 +331,11 @@ a plain prefix argument. Alternatively, you can use the
command
@code{goto-line-relative} to move point to the line relative to the
accessible portion of the narrowed buffer.
+@code{goto-line} has its own history list (@pxref{Minibuffer
+History}). You can have either a single list shared between all
+buffers (the default) or a separate list for each buffer, by
+customizing the user option @code{goto-line-history-local}.
+
@item M-g @key{TAB}
@kindex M-g TAB
@findex move-to-column
diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi
index c51f10a..d35a835 100644
--- a/doc/emacs/m-x.texi
+++ b/doc/emacs/m-x.texi
@@ -58,6 +58,14 @@ Modes}). By default, no commands are excluded, but you can
customize
the option @code{read-extended-command-predicate} to exclude those
irrelevant commands from completion results.
+@kindex M-S-x
+ Conversely, Emacs can exclude all commands except those that are
+particularly relevant to the current buffer. The @kbd{M-S-x} (that's
+``meta shift x'') command works just like @kbd{M-x}, but instead of
+listing all (or most) of the commands Emacs knows about, it will only
+list the commands that have been marked as ``belonging'' to the
+current major mode, or any enabled minor modes.
+
To cancel the @kbd{M-x} and not run a command, type @kbd{C-g} instead
of entering the command name. This takes you back to command level.
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 85376cc..8199ece 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -493,7 +493,10 @@ I/O.
Point and the mark, as two numeric arguments, smallest first. This is
the only code letter that specifies two successive arguments rather than
one. This will signal an error if the mark is not set in the buffer
-which is current when the command is invoked. No I/O.
+which is current when the command is invoked. If Transient Mark mode
+is turned on (@pxref{The Mark}) --- as it is by default --- and user
+option @code{mark-even-if-inactive} is @code{nil}, Emacs will signal
+an error even if the mark @emph{is} set, but is inactive. No I/O.
@item s
Arbitrary text, read in the minibuffer and returned as a string
@@ -597,16 +600,17 @@ Put them into three windows, selecting the last one."
@subsection Specifying Modes For Commands
Many commands in Emacs are general, and not tied to any specific mode.
-For instance, @kbd{M-x kill-region} can be used pretty in pretty much
-any mode that has editable text, and commands that display information
+For instance, @kbd{M-x kill-region} can be used in pretty much any
+mode that has editable text, and commands that display information
(like @kbd{M-x list-buffers}) can be used in pretty much any context.
Many other commands, however, are specifically tied to a mode, and
make no sense outside of that context. For instance, @code{M-x
-dired-diff} will just signal an error used outside of a dired buffer.
+dired-diff} will just signal an error if used outside of a Dired
+buffer.
Emacs therefore has a mechanism for specifying what mode (or modes) a
-command ``belong'' to:
+command ``belongs'' to:
@lisp
(defun dired-diff (...)
@@ -634,8 +638,8 @@ commands (if they aren't bound to any keys).
If using this extended @code{interactive} form isn't convenient
(because the code is supposed to work in older versions of Emacs that
-doesn't support the extended @code{interactive} form), the following
-can be used instead:
+don't support the extended @code{interactive} form), the following
+equivalent declaration (@pxref{Declare Form}) can be used instead:
@lisp
(declare (modes dired-mode))
@@ -657,10 +661,10 @@ call @code{kill-buffer}. This command will ``work'' from
any mode,
but it is highly unlikely that anybody would actually want to use the
command outside the context of this special mode.
-Many modes have a set of different commands that start that start the
-mode in different ways, (e.g., @code{eww-open-in-new-buffer} and
+Many modes have a set of different commands that start the mode in
+different ways (e.g., @code{eww-open-in-new-buffer} and
@code{eww-open-file}). Commands like that should never be tagged as
-mode-specific, as then can be issued by the user from pretty much any
+mode-specific, as they can be issued by the user from pretty much any
context.
@node Generic Commands
@@ -847,6 +851,15 @@ non-@code{nil} if the command is to be included when
completing in
that buffer.
@end deffn
+@deffn Command execute-extended-command-for-buffer prefix-argument
+This is like @code{execute-extended-command}, but limits the commands
+offered for completion to those commands that are of particular
+relevance to the current major mode (and enabled minor modes). This
+includes commands that are tagged with the modes (@pxref{Using
+Interactive}), and also commands that are bound to locally active
+keymaps.
+@end deffn
+
@node Distinguish Interactive
@section Distinguish Interactive Calls
@cindex distinguish interactive calls
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 93e935c..131ad2d 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -1997,7 +1997,7 @@ the beginning of the result if a multi-column character in
If @var{ellipsis} is non-@code{nil}, it should be a string which will
replace the end of @var{string} when it is truncated. In this case,
-more charcaters will be removed from @var{string} to free enough space
+more characters will be removed from @var{string} to free enough space
for @var{ellipsis} to fit within @var{width} columns. However, if
the display width of @var{string} is less than the display width of
@var{ellipsis}, @var{ellipsis} will not be appended to the result. If
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 1e3da8e..2a9b57f 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -863,6 +863,10 @@ This function returns @var{argument} and has no side
effects.
This function ignores any @var{arguments} and returns @code{nil}.
@end defun
+@defun always &rest arguments
+This function ignores any @var{arguments} and returns @code{t}.
+@end defun
+
Some functions are user-visible @dfn{commands}, which can be called
interactively (usually by a key sequence). It is possible to invoke
such a command exactly as though it was called interactively, by using
diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi
index b39373f..80f79b6 100644
--- a/doc/lispref/markers.texi
+++ b/doc/lispref/markers.texi
@@ -609,8 +609,8 @@ the function @code{use-region-p} for that (@pxref{The
Region}).
@defvarx deactivate-mark-hook
These normal hooks are run, respectively, when the mark becomes active
and when it becomes inactive. The hook @code{activate-mark-hook} is
-also run at the end of the command loop if the mark is active and it
-is possible that the region may have changed.
+also run when the region is reactivated, for instance after using a
+command that switches back to a buffer that has an active mark.
@ignore
This piece of command_loop_1, run unless deactivating the mark:
if (current_buffer != prev_buffer || MODIFF != prev_modiff)
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 0c74dbe..545fd40 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -609,7 +609,7 @@ returned value is a list.
(seq-map-indexed (lambda (elt idx)
(list idx elt))
'(a b c))
-@result{} ((0 a) (b 1) (c 2))
+@result{} ((0 a) (1 b) (2 c))
@end group
@end example
@end defun
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index f305d1a..c32d711 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -2557,7 +2557,7 @@ frame visible and, unless @var{alist} contains an
This function tries to display @var{buffer} by finding a window
that is displaying a buffer in a given mode.
-If @var{alist} contains a @code{mode} entry, its value specifes a
+If @var{alist} contains a @code{mode} entry, its value specifies a
major mode (a symbol) or a list of major modes. If @var{alist}
contains no @code{mode} entry, the current major mode of @var{buffer}
is used instead. A window is a candidate if it displays a buffer
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index f26ae63..6f0a81b 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -388,6 +388,11 @@ posting a followup that recommends such software.
@uref{news:gnu.emacs.bug} is a place where bug reports appear, but avoid
posting bug reports to this newsgroup directly (@pxref{Reporting bugs}).
+Finally, we recommend reading the
+@url{https://www.gnu.org/philosophy/kind-communication.html, GNU Kind
+Communications Guidelines} before posting to any GNU lists or
+newsgroups.
+
@node Newsgroup archives
@section Where can I get old postings to @uref{news:gnu.emacs.help} and other
GNU groups?
@cindex Archived postings from @code{gnu.emacs.help}
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 6d60215..e745af2 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -1927,6 +1927,25 @@ file, you must customize @code{ange-ftp-netrc-filename}:
(customize-set-variable 'ange-ftp-netrc-filename "~/.authinfo.gpg")
@end lisp
+In case you do not want to use an authentication file for
+@value{tramp} passwords, use connection-local variables
+@ifinfo
+(@pxref{Connection Variables, , , emacs})
+@end ifinfo
+like this:
+
+@lisp
+@group
+(connection-local-set-profile-variables
+ 'remote-without-auth-sources '((auth-sources . nil)))
+@end group
+
+@group
+(connection-local-set-profiles
+ '(:application tramp) 'remote-without-auth-sources)
+@end group
+@end lisp
+
@anchor{Caching passwords}
@subsection Caching passwords
@@ -2345,10 +2364,16 @@ fi
Another possibility is to check the environment variable
@env{INSIDE_EMACS}. Like for all subprocesses of Emacs, this is set
-to the version of the parent Emacs process, @xref{Interactive Shell, ,
-, emacs}. @value{tramp} adds its own package version to this string,
-which could be used for further tests in an inferior shell. The
-string of that environment variable looks always like
+to the version of the parent Emacs
+@ifinfo
+process, @xref{Interactive Shell, , , emacs}.
+@end ifinfo
+@ifnotinfo
+process.
+@end ifnotinfo
+@value{tramp} adds its own package version to this string, which could
+be used for further tests in an inferior shell. The string of that
+environment variable looks always like
@example
@group
@@ -3473,10 +3498,13 @@ uid=0(root) gid=0(root) groups=0(root)
@cindex @code{gdb}
@cindex @code{perldb}
-@file{gud.el} provides a unified interface to symbolic debuggers
+@file{gud.el} provides a unified interface to symbolic
@ifinfo
-(@ref{Debuggers, , , emacs}).
+debuggers (@pxref{Debuggers, , , emacs}).
@end ifinfo
+@ifnotinfo
+debuggers.
+@end ifnotinfo
@value{tramp} can run debug on remote hosts by calling @code{gdb}
with a remote file name:
@@ -3637,9 +3665,15 @@ minibuffer. Each connection is of the format
Flushing remote connections also cleans the password cache
(@pxref{Password handling}), file cache, connection cache
-(@pxref{Connection caching}), and recentf cache (@pxref{File
-Conveniences, , , emacs}). It also deletes session timers
-(@pxref{Predefined connection information}) and connection buffers.
+(@pxref{Connection caching}), and recentf
+@ifinfo
+cache (@pxref{File Conveniences, , , emacs}).
+@end ifinfo
+@ifnotinfo
+cache.
+@end ifnotinfo
+It also deletes session timers (@pxref{Predefined connection
+information}) and connection buffers.
If @var{keep-debug} is non-@code{nil}, the debug buffer is kept. A
non-@code{nil} @var{keep-password} preserves the password cache.
@@ -4544,10 +4578,16 @@ HISTFILE=/dev/null
@item
Where are remote files trashed to?
-Emacs can trash file instead of deleting them, @ref{Misc File Ops,
-Trashing , , emacs}. Remote files are always trashed to the local
-trash, except remote encrypted files (@pxref{Keeping files
-encrypted}), which are deleted anyway.
+Emacs can trash file instead of deleting
+@ifinfo
+them, @ref{Misc File Ops, Trashing , , emacs}.
+@end ifinfo
+@ifnotinfo
+them.
+@end ifnotinfo
+Remote files are always trashed to the local trash, except remote
+encrypted files (@pxref{Keeping files encrypted}), which are deleted
+anyway.
If Emacs is configured to use the XDG conventions for the trash
directory, remote files cannot be restored with the respective tools,
diff --git a/etc/NEWS b/etc/NEWS
index 3e06cc4..6525763 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -252,6 +252,13 @@ commands. The new keystrokes are 'C-x x g'
('revert-buffer'),
* Editing Changes in Emacs 28.1
+++
+** New command 'execute-extended-command-for-buffer'.
+This new command, bound to 'M-S-x', works like
+'execute-extended-command', but limits the set of commands to the
+commands that have been determined to be particularly useful with the
+current mode.
+
++++
** New user option 'read-extended-command-predicate'.
This option controls how 'M-x' performs completion of commands when
you type TAB. By default, any command that matches what you have
@@ -345,6 +352,11 @@ trying to be non-destructive.
This command opens a new buffer called "*Memory Report*" and gives a
summary of where Emacs is using memory currently.
++++
+** The history list for the 'goto-line' command is now a single list
+for all buffers by default. You can configure a separate list for
+each buffer by customizing the user option 'goto-line-history-local'.
+
** Outline
+++
@@ -1010,7 +1022,7 @@ separate buffer, or a tooltip.
*** New user option 'eldoc-documentation-strategy'.
The built-in choices available for this user option let users compose
the results of 'eldoc-documentation-functions' in various ways, even
-if some of those functions are sychronous and some asynchchronous.
+if some of those functions are synchronous and some asynchronous.
The user option replaces 'eldoc-documentation-function', which is now
obsolete.
@@ -2305,6 +2317,10 @@ back in Emacs 23.1. The affected functions are:
'make-obsolete',
* Lisp Changes in Emacs 28.1
+++
+** New function 'always'.
+This is identical to 'ignore', but returns t instead.
+
++++
** New forms to declare how completion should happen has been added.
'(declare (completion PREDICATE))' can be used as a general predicate
to say whether the command should be present when completing with
diff --git a/etc/NEWS.19 b/etc/NEWS.19
index f2cef62..fd91c08 100644
--- a/etc/NEWS.19
+++ b/etc/NEWS.19
@@ -4011,6 +4011,7 @@ The third component is now determined on the basis of the
names of the
existing executable files. This means that version.el is not altered
by building Emacs.
+** New macro 'easy-menu-define'
* Changes in 19.22.
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 2cae8b9..2b9cbf3 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -747,7 +747,7 @@ removed.
For those who hate breaking changes, even though the changes are made
to clean things up; fear not. ATTACH_DIR will still continue to work.
It's just not documented any longer. When you get the chance, run the
-code above to clean things up anyways!
+code above to clean things up anyway!
**** New hooks
Two hooks are added to org-attach:
diff --git a/lisp/battery.el b/lisp/battery.el
index 77ad73d..59f6987 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -246,7 +246,7 @@ seconds."
(add-to-list 'global-mode-string 'battery-mode-line-string t)
(and (eq battery-status-function #'battery-upower)
battery-upower-subscribe
- (battery--upower-subsribe))
+ (battery--upower-subscribe))
(setq battery-update-timer (run-at-time nil battery-update-interval
#'battery-update-handler))
(battery-update))
@@ -634,7 +634,7 @@ Intended as a UPower PropertiesChanged signal handler."
(mapc #'dbus-unregister-object battery--upower-signals)
(setq battery--upower-signals ()))
-(defun battery--upower-subsribe ()
+(defun battery--upower-subscribe ()
"Subscribe to UPower device change signals."
(push (dbus-register-signal :system battery-upower-service
battery-upower-path
diff --git a/lisp/calculator.el b/lisp/calculator.el
index b4c0075..0088398 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -20,23 +20,18 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;;=====================================================================
;;; Commentary:
-;;
+
;; A calculator for Emacs.
;; Why should you reach for your mouse to get xcalc (calc.exe, gcalc or
;; whatever), when you have Emacs running already?
;;
-;; If this is not part of your Emacs distribution, then simply bind
-;; `calculator' to a key and make it an autoloaded function, e.g.:
-;; (autoload 'calculator "calculator"
-;; "Run the Emacs calculator." t)
+;; You can bind this to a key by adding this to your Init file:
+;;
;; (global-set-key [(control return)] 'calculator)
;;
;; Written by Eli Barzilay, eli@barzilay.org
-;;
-;;;=====================================================================
;;; Customization:
(defgroup calculator nil
@@ -50,19 +45,16 @@
"Run `calculator' electrically, in the echo area.
Electric mode saves some place but changes the way you interact with the
calculator."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-use-menu t
"Make `calculator' create a menu.
Note that this requires easymenu. Must be set before loading."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-bind-escape nil
"If non-nil, set escape to exit the calculator."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-unary-style 'postfix
"Value is either `prefix' or `postfix'.
@@ -75,44 +67,38 @@ This determines the default behavior of unary operators."
It should contain a \"%s\" somewhere that will indicate the i/o radixes;
this will be a two-character string as described in the documentation
for `calculator-mode'."
- :type 'string
- :group 'calculator)
+ :type 'string)
(defcustom calculator-number-digits 3
"The calculator's number of digits used for standard display.
Used by the `calculator-standard-display' function - it will use the
format string \"%.NC\" where this number is N and C is a character given
at runtime."
- :type 'integer
- :group 'calculator)
+ :type 'integer)
(defcustom calculator-radix-grouping-mode t
"Use digit grouping in radix output mode.
If this is set, chunks of `calculator-radix-grouping-digits' characters
will be separated by `calculator-radix-grouping-separator' when in radix
output mode is active (determined by `calculator-output-radix')."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-radix-grouping-digits 4
"The number of digits used for grouping display in radix modes.
See `calculator-radix-grouping-mode'."
- :type 'integer
- :group 'calculator)
+ :type 'integer)
(defcustom calculator-radix-grouping-separator "'"
"The separator used in radix grouping display.
See `calculator-radix-grouping-mode'."
- :type 'string
- :group 'calculator)
+ :type 'string)
(defcustom calculator-remove-zeros t
"Non-nil value means delete all redundant zero decimal digits.
If this value is not t and not nil, redundant zeros are removed except
for one.
Used by the `calculator-remove-zeros' function."
- :type '(choice (const t) (const leave-decimal) (const nil))
- :group 'calculator)
+ :type '(choice (const t) (const leave-decimal) (const nil)))
(defcustom calculator-displayer '(std ?n)
"A displayer specification for numerical values.
@@ -135,8 +121,7 @@ a character and G is an optional boolean, in this case the
arguments."
:type '(choice (function) (string) (sexp)
(list (const std) character)
- (list (const std) character boolean))
- :group 'calculator)
+ (list (const std) character boolean)))
(defcustom calculator-displayers
'(((std ?n) "Standard display, decimal point or scientific")
@@ -152,15 +137,13 @@ specification is the same as the values that can be
stored in
`calculator-displayer'.
`calculator-rotate-displayer' rotates this list."
- :type 'sexp
- :group 'calculator)
+ :type 'sexp)
(defcustom calculator-paste-decimals t
"If non-nil, convert pasted integers so they have a decimal point.
This makes it possible to paste big integers since they will be read as
floats, otherwise the Emacs reader will fail on them."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(make-obsolete-variable 'calculator-paste-decimals
"it is no longer used." "26.1")
@@ -169,14 +152,12 @@ floats, otherwise the Emacs reader will fail on them."
`calculator-displayer', to format a string before copying it with
`calculator-copy'. If nil, then `calculator-displayer's normal value is
used."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-2s-complement nil
"If non-nil, show negative numbers in 2s complement in radix modes.
Otherwise show as a negative number."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-mode-hook nil
"List of hook functions for `calculator-mode' to run.
@@ -184,8 +165,7 @@ Note: if `calculator-electric-mode' is on, then this hook
will get
activated in the minibuffer -- in that case it should not do much more
than local key settings and other effects that will change things
outside the scope of calculator related code."
- :type 'hook
- :group 'calculator)
+ :type 'hook)
(defcustom calculator-user-registers nil
"An association list of user-defined register bindings.
@@ -200,8 +180,7 @@ before you load calculator."
(when (boundp 'calculator-registers)
(setq calculator-registers
(append val calculator-registers)))
- (setq calculator-user-registers val))
- :group 'calculator)
+ (setq calculator-user-registers val)))
(defcustom calculator-user-operators nil
"A list of additional operators.
@@ -234,8 +213,7 @@ Examples:
Note that this will be either postfix or prefix, according to
`calculator-unary-style'."
- :type '(repeat (list string symbol sexp integer integer))
- :group 'calculator)
+ :type '(repeat (list string symbol sexp integer integer)))
;;;=====================================================================
;;; Code:
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index ba7418f..aa3236c 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -29,7 +29,7 @@
;; `parse-time-string' parses a time in a string and returns a list of
;; values, just like `decode-time', where unspecified elements in the
-;; string are returned as nil (except unspecfied DST is returned as -1).
+;; string are returned as nil (except unspecified DST is returned as -1).
;; `encode-time' may be applied on these values to obtain an internal
;; time value.
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index e3cc906..369a9f7 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -1518,7 +1518,7 @@ It does not apply the value to buffers."
;;; FIXME: Could someone look into implementing `project-ignores' for
;;; EDE and/or a faster `project-files'?
-(add-hook 'project-find-functions #'project-try-ede)
+(add-hook 'project-find-functions #'project-try-ede 50)
(provide 'ede)
diff --git a/lisp/comint.el b/lisp/comint.el
index 57df6bf..ea69c3b 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -378,7 +378,7 @@ This variable is buffer-local."
"\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)"
"\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?"
;; "[[:alpha:]]" used to be "for", which fails to match non-English.
- "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:blank:]]*\\'")
+ "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:space:]]*\\'")
"Regexp matching prompts for passwords in the inferior process.
This is used by `comint-watch-for-password-prompt'."
:version "27.1"
@@ -2432,6 +2432,8 @@ This function could be in the list
`comint-output-filter-functions'."
(replace-regexp-in-string "\r" "" string)))
(when (string-match "^[ \n\r\t\v\f\b\a]+" string)
(setq string (replace-match "" t t string)))
+ (when (string-match "\n+\\'" string)
+ (setq string (replace-match "" t t string)))
(let ((comint--prompt-recursion-depth (1+ comint--prompt-recursion-depth)))
(if (> comint--prompt-recursion-depth 10)
(message "Password prompt recursion too deep")
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 5a52ecc..1199de1 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -447,7 +447,7 @@ If it is `no-dir', omitting is much faster, but you can
only match
against the non-directory part of the file name. Set it to nil if you
need to match the entire file name.")
-;; \017=^O for Omit - other packages can chose other control characters.
+;; \017=^O for Omit - other packages can choose other control characters.
(defvar dired-omit-marker-char ?\017
"Temporary marker used by Dired-Omit.
Should never be used as marker by the user or other packages.")
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 1f5022c..b1b2144 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -41,23 +41,23 @@
;; Consider the following C structures:
;;
;; struct header {
-;; unsigned long dest_ip;
-;; unsigned long src_ip;
-;; unsigned short dest_port;
-;; unsigned short src_port;
+;; uint32_t dest_ip;
+;; uint32_t src_ip;
+;; uint16_t dest_port;
+;; uint16_t src_port;
;; };
;;
;; struct data {
-;; unsigned char type;
-;; unsigned char opcode;
-;; unsigned long length; /* In little endian order */
+;; uint8_t type;
+;; uint8_t opcode;
+;; uint32_t length; /* In little endian order */
;; unsigned char id[8]; /* nul-terminated string */
;; unsigned char data[/* (length + 3) & ~3 */];
;; };
;;
;; struct packet {
;; struct header header;
-;; unsigned char items;
+;; uint8_t items;
;; unsigned char filler[3];
;; struct data item[/* items */];
;; };
@@ -75,7 +75,7 @@
;; (bindat-spec
;; (type u8)
;; (opcode u8)
-;; (length u16r) ;; little endian order
+;; (length u32r) ;; little endian order
;; (id strz 8)
;; (data vec (length))
;; (align 4)))
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index e0feb95..9f0ba23 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1348,7 +1348,7 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
window-total-height window-total-width window-use-time window-vscroll
window-width zerop))
(side-effect-and-error-free-fns
- '(arrayp atom
+ '(always arrayp atom
bignump bobp bolp bool-vector-p
buffer-end buffer-list buffer-size buffer-string bufferp
car-safe case-table-p cdr-safe char-or-string-p characterp
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 5de7bc6..df0beb5 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -159,9 +159,7 @@ The return value of this function is not used."
(defalias 'byte-run--set-modes
#'(lambda (f _args &rest val)
(list 'function-put (list 'quote f)
- ''completion-predicate
- `(lambda (_ b)
- (command-completion-with-modes-p ',val b)))))
+ ''command-modes (list 'quote val))))
;; Add any new entries to info node `(elisp)Declare Form'.
(defvar defun-declarations-alist
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 0da7b83..25e1920 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2940,7 +2940,9 @@ If FORM is a lambda or a macro, byte-compile it as a
function."
((eq arg '&optional)
(when (memq '&optional (cdr list))
(error "Duplicate &optional")))
- ((memq arg vars)
+ ((and (memq arg vars)
+ ;; Allow repetitions for unused args.
+ (not (string-match "\\`_" (symbol-name arg))))
(byte-compile-warn "repeated variable %s in lambda-list" arg))
(t
(push arg vars))))
@@ -3903,15 +3905,21 @@ discarding."
(cl-assert (or (> (length env) 0)
docstring-exp)) ;Otherwise, we don't need a closure.
(cl-assert (byte-code-function-p fun))
- (byte-compile-form `(make-byte-code
- ',(aref fun 0) ',(aref fun 1)
- (vconcat (vector . ,env) ',(aref fun 2))
- ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x)
fun))))
- (if docstring-exp
- `(,(car rest)
- ,docstring-exp
- ,@(cddr rest))
- rest)))))))
+ (byte-compile-form
+ ;; Use symbols V0, V1 ... as placeholders for closure variables:
+ ;; they should be short (to save space in the .elc file), yet
+ ;; distinct when disassembled.
+ (let* ((dummy-vars (mapcar (lambda (i) (intern (format "V%d" i)))
+ (number-sequence 0 (1- (length env)))))
+ (proto-fun
+ (apply #'make-byte-code
+ (aref fun 0) (aref fun 1)
+ ;; Prepend dummy cells to the constant vector,
+ ;; to get the indices right when disassembling.
+ (vconcat dummy-vars (aref fun 2))
+ (mapcar (lambda (i) (aref fun i))
+ (number-sequence 3 (1- (length fun)))))))
+ `(make-closure ,proto-fun ,@env))))))
(defun byte-compile-get-closed-var (form)
"Byte-compile the special `internal-get-closed-var' form."
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index 7d760ff..40c17b9 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -187,7 +187,7 @@ Make sure the width/height is correct."
)
"Class used to display an axis which represents different named items.")
-(defclass chart-sequece ()
+(defclass chart-sequence ()
((data :initarg :data
:initform nil)
(name :initarg :name
@@ -583,12 +583,12 @@ SORT-PRED if desired."
))
(iv (eq dir 'vertical)))
(chart-add-sequence nc
- (make-instance 'chart-sequece
+ (make-instance 'chart-sequence
:data namelst
:name nametitle)
(if iv 'x-axis 'y-axis))
(chart-add-sequence nc
- (make-instance 'chart-sequece
+ (make-instance 'chart-sequence
:data numlst
:name numtitle)
(if iv 'y-axis 'x-axis))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 4599694..45e76c7 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -88,7 +88,6 @@ using, but only when you also use Edebug."
;; because the byte compiler binds them; as a result, if edebug
;; is first loaded for a require in a compilation, they will be left unbound.
-;;;###autoload
(defcustom edebug-all-defs nil
"If non-nil, evaluating defining forms instruments for Edebug.
This applies to `eval-defun', `eval-region', `eval-buffer', and
@@ -101,11 +100,6 @@ variable. You may wish to make it local to each buffer
with
`emacs-lisp-mode-hook'."
:type 'boolean)
-;; edebug-all-defs and edebug-all-forms need to be autoloaded
-;; because the byte compiler binds them; as a result, if edebug
-;; is first loaded for a require in a compilation, they will be left unbound.
-
-;;;###autoload
(defcustom edebug-all-forms nil
"Non-nil means evaluation of all forms will instrument for Edebug.
This doesn't apply to loading or evaluations in the minibuffer.
@@ -457,66 +451,24 @@ the option `edebug-all-forms'."
;; We should somehow arrange to be able to do this
;; without actually replacing the eval-defun command.
-(defun edebug-eval-defun (edebug-it)
- "Evaluate the top-level form containing point, or after point.
-
-If the current defun is actually a call to `defvar', then reset the
-variable using its initial value expression even if the variable
-already has some other value. (Normally `defvar' does not change the
-variable's value if it already has a value.) Treat `defcustom'
-similarly. Reinitialize the face according to `defface' specification.
-
-With a prefix argument, instrument the code for Edebug.
-
-Setting option `edebug-all-defs' to a non-nil value reverses the meaning
+(defun edebug--eval-defun (orig-fun edebug-it)
+ "Setting option `edebug-all-defs' to a non-nil value reverses the meaning
of the prefix argument. Code is then instrumented when this function is
invoked without a prefix argument.
If acting on a `defun' for FUNCTION, and the function was instrumented,
`Edebug: FUNCTION' is printed in the minibuffer. If not instrumented,
-just FUNCTION is printed.
+just FUNCTION is printed."
+ (let* ((edebug-all-forms (not (eq (not edebug-it) (not edebug-all-defs))))
+ (edebug-all-defs edebug-all-forms))
+ (funcall orig-fun nil)))
-If not acting on a `defun', the result of evaluation is displayed in
-the minibuffer."
+(defun edebug-eval-defun (edebug-it)
+ (declare (obsolete "use eval-defun or edebug--eval-defun instead" "28.1"))
(interactive "P")
- (let* ((edebugging (not (eq (not edebug-it) (not edebug-all-defs))))
- (edebug-result)
- (form
- (let ((edebug-all-forms edebugging)
- (edebug-all-defs (eq edebug-all-defs (not edebug-it))))
- (edebug-read-top-level-form))))
- ;; This should be consistent with `eval-defun-1', but not the
- ;; same, since that gets a macroexpanded form.
- (cond ((and (eq (car form) 'defvar)
- (cdr-safe (cdr-safe form)))
- ;; Force variable to be bound.
- (makunbound (nth 1 form)))
- ((and (eq (car form) 'defcustom)
- (default-boundp (nth 1 form)))
- ;; Force variable to be bound.
- ;; FIXME: Shouldn't this use the :setter or :initializer?
- (set-default (nth 1 form) (eval (nth 2 form) lexical-binding)))
- ((eq (car form) 'defface)
- ;; Reset the face.
- (setq face-new-frame-defaults
- (assq-delete-all (nth 1 form) face-new-frame-defaults))
- (put (nth 1 form) 'face-defface-spec nil)
- (put (nth 1 form) 'face-documentation (nth 3 form))
- ;; See comments in `eval-defun-1' for purpose of code below
- (setq form (prog1 `(prog1 ,form
- (put ',(nth 1 form) 'saved-face
- ',(get (nth 1 form) 'saved-face))
- (put ',(nth 1 form) 'customized-face
- ,(nth 2 form)))
- (put (nth 1 form) 'saved-face nil)))))
- (setq edebug-result (eval (eval-sexp-add-defvars form) lexical-binding))
- (if (not edebugging)
- (prog1
- (prin1 edebug-result)
- (let ((str (eval-expression-print-format edebug-result)))
- (if str (princ str))))
- edebug-result)))
-
+ (if (advice-member-p #'edebug--eval-defun 'eval-defun)
+ (eval-defun edebug-it)
+ (edebug--eval-defun #'eval-defun edebug-it)))
;;;###autoload
(defalias 'edebug-defun 'edebug-eval-top-level-form)
@@ -588,12 +540,12 @@ already is one.)"
(defun edebug-install-read-eval-functions ()
(interactive)
(add-function :around load-read-function #'edebug--read)
- (advice-add 'eval-defun :override #'edebug-eval-defun))
+ (advice-add 'eval-defun :around #'edebug--eval-defun))
(defun edebug-uninstall-read-eval-functions ()
(interactive)
(remove-function load-read-function #'edebug--read)
- (advice-remove 'eval-defun #'edebug-eval-defun))
+ (advice-remove 'eval-defun #'edebug--eval-defun))
;;; Edebug internal data
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index c95540e..a02406a 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -100,7 +100,7 @@ If the value is a positive number, it is used to calculate a
number of logical lines of documentation that ElDoc is allowed to
put in the echo area. If a positive integer, the number is used
directly, while a float specifies the number of lines as a
-proporting of the echo area frame's height.
+proportion of the echo area frame's height.
If value is the symbol `truncate-sym-name-if-fit' t, the part of
the doc string that represents a symbol's name may be truncated
@@ -692,7 +692,7 @@ following values are allowed:
- `eldoc-documentation-compose-eagerly': calls all functions in
the special hook and display as many of the resulting doc
- strings as possible, as soon as possibl. Preserving the
+ strings as possible, as soon as possible. Preserving the
relative order of doc strings;
- `eldoc-documentation-enthusiast': calls all functions in the
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 9f155ba..51895f8 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2830,6 +2830,7 @@ either a full name or nil, and EMAIL is a valid email
address."
Letters do not insert themselves; instead, they are commands.
\\<package-menu-mode-map>
\\{package-menu-mode-map}"
+ :interactive nil
(setq mode-line-process '((package--downloads-in-progress ":Loading")
(package-menu--transaction-status
package-menu--transaction-status)))
@@ -2952,7 +2953,7 @@ Installed obsolete packages are always displayed.")
Also hide packages whose name matches a regexp in user option
`package-hidden-regexps' (a list). To add regexps to this list,
use `package-menu-hide-package'."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(setq package-menu--hide-packages
(not package-menu--hide-packages))
@@ -3289,7 +3290,7 @@ To unhide a package, type
Type \\[package-menu-toggle-hiding] to toggle package hiding."
(declare (interactive-only "change `package-hidden-regexps' instead."))
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(let* ((name (when (derived-mode-p 'package-menu-mode)
(concat "\\`" (regexp-quote (symbol-name (package-desc-name
@@ -3313,7 +3314,7 @@ Type \\[package-menu-toggle-hiding] to toggle package
hiding."
(defun package-menu-describe-package (&optional button)
"Describe the current package.
If optional arg BUTTON is non-nil, describe its associated package."
- (interactive)
+ (interactive nil package-menu-mode)
(let ((pkg-desc (if button (button-get button 'package-desc)
(tabulated-list-get-id))))
(if pkg-desc
@@ -3323,7 +3324,7 @@ If optional arg BUTTON is non-nil, describe its
associated package."
;; fixme numeric argument
(defun package-menu-mark-delete (&optional _num)
"Mark a package for deletion and move to the next line."
- (interactive "p")
+ (interactive "p" package-menu-mode)
(package--ensure-package-menu-mode)
(if (member (package-menu-get-status)
'("installed" "dependency" "obsolete" "unsigned"))
@@ -3332,7 +3333,7 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(defun package-menu-mark-install (&optional _num)
"Mark a package for installation and move to the next line."
- (interactive "p")
+ (interactive "p" package-menu-mode)
(package--ensure-package-menu-mode)
(if (member (package-menu-get-status) '("available" "avail-obso" "new"
"dependency"))
(tabulated-list-put-tag "I" t)
@@ -3340,20 +3341,20 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(defun package-menu-mark-unmark (&optional _num)
"Clear any marks on a package and move to the next line."
- (interactive "p")
+ (interactive "p" package-menu-mode)
(package--ensure-package-menu-mode)
(tabulated-list-put-tag " " t))
(defun package-menu-backup-unmark ()
"Back up one line and clear any marks on that package."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(forward-line -1)
(tabulated-list-put-tag " "))
(defun package-menu-mark-obsolete-for-deletion ()
"Mark all obsolete packages for deletion."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(save-excursion
(goto-char (point-min))
@@ -3384,7 +3385,7 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(defun package-menu-quick-help ()
"Show short key binding help for `package-menu-mode'.
The full list of keys can be viewed with \\[describe-mode]."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(message (mapconcat #'package--prettify-quick-help-key
package--quick-help-keys "\n")))
@@ -3480,7 +3481,7 @@ call will upgrade the package.
If there's an async refresh operation in progress, the flags will
be placed as part of `package-menu--post-refresh' instead of
immediately."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(if (not package--downloads-in-progress)
(package-menu--mark-upgrades-1)
@@ -3574,7 +3575,7 @@ packages list, respectively."
Packages marked for installation are downloaded and installed;
packages marked for deletion are removed.
Optional argument NOQUERY non-nil means do not ask the user to confirm."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(let (install-list delete-list cmd pkg-desc)
(save-excursion
@@ -3819,7 +3820,8 @@ strings. If ARCHIVE is nil or the empty string, show all
packages."
(interactive (list (completing-read-multiple
"Filter by archive (comma separated): "
- (mapcar #'car package-archives))))
+ (mapcar #'car package-archives)))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(let ((re (if (listp archive)
(regexp-opt archive)
@@ -3840,7 +3842,8 @@ DESCRIPTION.
When called interactively, prompt for DESCRIPTION.
If DESCRIPTION is nil or the empty string, show all packages."
- (interactive (list (read-regexp "Filter by description (regexp)")))
+ (interactive (list (read-regexp "Filter by description (regexp)"))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(if (or (not description) (string-empty-p description))
(package-menu--generate t t)
@@ -3861,10 +3864,11 @@ strings. If KEYWORD is nil or the empty string, show
all
packages."
(interactive (list (completing-read-multiple
"Keywords (comma separated): "
- (package-all-keywords))))
+ (package-all-keywords)))
+ package-menu-mode)
+ (package--ensure-package-menu-mode)
(when (stringp keyword)
(setq keyword (list keyword)))
- (package--ensure-package-menu-mode)
(if (not keyword)
(package-menu--generate t t)
(package-menu--filter-by (lambda (pkg-desc)
@@ -3883,7 +3887,8 @@ When called interactively, prompt for NAME-OR-DESCRIPTION.
If NAME-OR-DESCRIPTION is nil or the empty string, show all
packages."
- (interactive (list (read-regexp "Filter by name or description (regexp)")))
+ (interactive (list (read-regexp "Filter by name or description (regexp)"))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(if (or (not name-or-description) (string-empty-p name-or-description))
(package-menu--generate t t)
@@ -3902,7 +3907,8 @@ Display only packages with name that matches regexp NAME.
When called interactively, prompt for NAME.
If NAME is nil or the empty string, show all packages."
- (interactive (list (read-regexp "Filter by name (regexp)")))
+ (interactive (list (read-regexp "Filter by name (regexp)"))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(if (or (not name) (string-empty-p name))
(package-menu--generate t t)
@@ -3932,7 +3938,8 @@ packages."
"incompat"
"installed"
"new"
- "unsigned"))))
+ "unsigned")))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(if (or (not status) (string-empty-p status))
(package-menu--generate t t)
@@ -3967,7 +3974,9 @@ If VERSION is nil or the empty string, show all packages."
('< "< less than")
('> "> greater than"))
"): "))
- choice))))
+ choice)))
+ package-menu-mode)
+ (package--ensure-package-menu-mode)
(unless (equal predicate 'quit)
(if (or (not version) (string-empty-p version))
(package-menu--generate t t)
@@ -3985,7 +3994,7 @@ If VERSION is nil or the empty string, show all packages."
(defun package-menu-filter-marked ()
"Filter \"*Packages*\" buffer by non-empty upgrade mark.
Unlike other filters, this leaves the marks intact."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(widen)
(let (found-entries mark pkg-id entry marks)
@@ -4013,7 +4022,7 @@ Unlike other filters, this leaves the marks intact."
(defun package-menu-filter-upgradable ()
"Filter \"*Packages*\" buffer to show only upgradable packages."
- (interactive)
+ (interactive nil package-menu-mode)
(let ((pkgs (mapcar #'car (package-menu--find-upgrades))))
(package-menu--filter-by
(lambda (pkg)
@@ -4022,7 +4031,7 @@ Unlike other filters, this leaves the marks intact."
(defun package-menu-clear-filter ()
"Clear any filter currently applied to the \"*Packages*\" buffer."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(package-menu--generate t t))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index d3928fa..c7288b7 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -642,7 +642,7 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase--split-pred (vars upat pat)
"Indicate the overlap or mutual-exclusion between UPAT and PAT.
-More specifically retuns a pair (A . B) where A indicates whether PAT
+More specifically returns a pair (A . B) where A indicates whether PAT
can match when UPAT has matched, and B does the same for the case
where UPAT failed to match.
A and B can be one of:
@@ -784,7 +784,7 @@ Otherwise, it defers to REST which is a list of branches of
the form
\(ELSE-MATCH ELSE-CODE . ELSE-VARS)."
;; Depending on the order in which we choose to check each of the MATCHES,
;; the resulting tree may be smaller or bigger. So in general, we'd want
- ;; to be careful to chose the "optimal" order. But predicate
+ ;; to be careful to choose the "optimal" order. But predicate
;; patterns make this harder because they create dependencies
;; between matches. So we don't bother trying to reorder anything.
(cond
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index ce8d98d..455fcac 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -217,8 +217,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
;; Define the local "\C-c" keymap
(defvar reb-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap)))
+ (let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" 'reb-toggle-case)
(define-key map "\C-c\C-q" 'reb-quit)
(define-key map "\C-c\C-w" 'reb-copy)
@@ -228,43 +227,37 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
(define-key map "\C-c\C-e" 'reb-enter-subexp-mode)
(define-key map "\C-c\C-b" 'reb-change-target-buffer)
(define-key map "\C-c\C-u" 'reb-force-update)
- (define-key map [menu-bar reb-mode] (cons "Re-Builder" menu-map))
- (define-key menu-map [rq]
- '(menu-item "Quit" reb-quit
- :help "Quit the RE Builder mode"))
- (define-key menu-map [div1] '(menu-item "--"))
- (define-key menu-map [rt]
- '(menu-item "Case sensitive" reb-toggle-case
- :button (:toggle . (with-current-buffer
- reb-target-buffer
- (null case-fold-search)))
- :help "Toggle case sensitivity of searches for RE Builder
target buffer"))
- (define-key menu-map [rb]
- '(menu-item "Change target buffer..." reb-change-target-buffer
- :help "Change the target buffer and display it in the target
window"))
- (define-key menu-map [rs]
- '(menu-item "Change syntax..." reb-change-syntax
- :help "Change the syntax used by the RE Builder"))
- (define-key menu-map [div2] '(menu-item "--"))
- (define-key menu-map [re]
- '(menu-item "Enter subexpression mode" reb-enter-subexp-mode
- :help "Enter the subexpression mode in the RE Builder"))
- (define-key menu-map [ru]
- '(menu-item "Force update" reb-force-update
- :help "Force an update in the RE Builder target window
without a match limit"))
- (define-key menu-map [rn]
- '(menu-item "Go to next match" reb-next-match
- :help "Go to next match in the RE Builder target window"))
- (define-key menu-map [rp]
- '(menu-item "Go to previous match" reb-prev-match
- :help "Go to previous match in the RE Builder target window"))
- (define-key menu-map [div3] '(menu-item "--"))
- (define-key menu-map [rc]
- '(menu-item "Copy current RE" reb-copy
- :help "Copy current RE into the kill ring for later
insertion"))
map)
"Keymap used by the RE Builder.")
+(easy-menu-define reb-mode-menu reb-mode-map
+ "Menu for the RE Builder."
+ '("Re-Builder"
+ ["Copy current RE" reb-copy
+ :help "Copy current RE into the kill ring for later insertion"]
+ "---"
+ ["Go to previous match" reb-prev-match
+ :help "Go to previous match in the RE Builder target window"]
+ ["Go to next match" reb-next-match
+ :help "Go to next match in the RE Builder target window"]
+ ["Force update" reb-force-update
+ :help "Force an update in the RE Builder target window without a match
limit"]
+ ["Enter subexpression mode" reb-enter-subexp-mode
+ :help "Enter the subexpression mode in the RE Builder"]
+ "---"
+ ["Change syntax..." reb-change-syntax
+ :help "Change the syntax used by the RE Builder"]
+ ["Change target buffer..." reb-change-target-buffer
+ :help "Change the target buffer and display it in the target window"]
+ ["Case sensitive" reb-toggle-case
+ :style toggle
+ :selected (with-current-buffer reb-target-buffer
+ (null case-fold-search))
+ :help "Toggle case sensitivity of searches for RE Builder target buffer"]
+ "---"
+ ["Quit" reb-quit
+ :help "Quit the RE Builder mode"]))
+
(define-derived-mode reb-mode nil "RE Builder"
"Major mode for interactively building Regular Expressions."
(setq-local blink-matching-paren nil)
@@ -368,7 +361,6 @@ matching parts of the target buffer will be highlighted."
(defun reb-change-target-buffer (buf)
"Change the target buffer and display it in the target window."
(interactive "bSet target buffer to: ")
-
(let ((buffer (get-buffer buf)))
(if (not buffer)
(error "No such buffer")
@@ -381,7 +373,6 @@ matching parts of the target buffer will be highlighted."
(defun reb-force-update ()
"Force an update in the RE Builder target window without a match limit."
(interactive)
-
(let ((reb-auto-match-limit nil))
(reb-update-overlays
(if reb-subexp-mode reb-subexp-displayed nil))))
@@ -389,7 +380,6 @@ matching parts of the target buffer will be highlighted."
(defun reb-quit ()
"Quit the RE Builder mode."
(interactive)
-
(setq reb-subexp-mode nil
reb-subexp-displayed nil)
(reb-delete-overlays)
@@ -399,7 +389,6 @@ matching parts of the target buffer will be highlighted."
(defun reb-next-match ()
"Go to next match in the RE Builder target window."
(interactive)
-
(reb-assert-buffer-in-window)
(with-selected-window reb-target-window
(if (not (re-search-forward reb-regexp (point-max) t))
@@ -411,7 +400,6 @@ matching parts of the target buffer will be highlighted."
(defun reb-prev-match ()
"Go to previous match in the RE Builder target window."
(interactive)
-
(reb-assert-buffer-in-window)
(with-selected-window reb-target-window
(let ((p (point)))
@@ -426,7 +414,6 @@ matching parts of the target buffer will be highlighted."
(defun reb-toggle-case ()
"Toggle case sensitivity of searches for RE Builder target buffer."
(interactive)
-
(with-current-buffer reb-target-buffer
(setq case-fold-search (not case-fold-search)))
(reb-update-modestring)
@@ -435,7 +422,6 @@ matching parts of the target buffer will be highlighted."
(defun reb-copy ()
"Copy current RE into the kill ring for later insertion."
(interactive)
-
(reb-update-regexp)
(let ((re (with-output-to-string
(print (reb-target-binding reb-regexp)))))
@@ -503,7 +489,6 @@ Optional argument SYNTAX must be specified if called
non-interactively."
(defun reb-do-update (&optional subexp)
"Update matches in the RE Builder target window.
If SUBEXP is non-nil mark only the corresponding sub-expressions."
-
(reb-assert-buffer-in-window)
(reb-update-regexp)
(reb-update-overlays subexp))
@@ -541,7 +526,6 @@ optional fourth argument FORCE is non-nil."
(defun reb-assert-buffer-in-window ()
"Assert that `reb-target-buffer' is displayed in `reb-target-window'."
-
(if (not (eq reb-target-buffer (window-buffer reb-target-window)))
(set-window-buffer reb-target-window reb-target-buffer)))
@@ -560,7 +544,6 @@ optional fourth argument FORCE is non-nil."
(defun reb-display-subexp (&optional subexp)
"Highlight only subexpression SUBEXP in the RE Builder."
(interactive)
-
(setq reb-subexp-displayed
(or subexp (string-to-number (format "%c" last-command-event))))
(reb-update-modestring)
@@ -568,7 +551,6 @@ optional fourth argument FORCE is non-nil."
(defun reb-kill-buffer ()
"When the RE Builder buffer is killed make sure no overlays stay around."
-
(when (reb-mode-buffer-p)
(reb-delete-overlays)))
@@ -600,7 +582,6 @@ optional fourth argument FORCE is non-nil."
(defun reb-insert-regexp ()
"Insert current RE."
-
(let ((re (or (reb-target-binding reb-regexp)
(reb-empty-regexp))))
(cond ((eq reb-re-syntax 'read)
@@ -636,7 +617,6 @@ Return t if the (cooked) expression changed."
;; And now the real core of the whole thing
(defun reb-count-subexps (re)
"Return number of sub-expressions in the regexp RE."
-
(let ((i 0) (beg 0))
(while (string-match "\\\\(" re beg)
(setq i (1+ i)
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index b29b870..58584f3 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -890,7 +890,7 @@ Return (REGEXP . PRECEDENCE)."
(* (or (seq "[:" (+ (any "a-z")) ":]")
(not (any "]"))))
"]")
- anything
+ (not (any "*+?^$[\\"))
(seq "\\"
(or anything
(seq (any "sScC_") anything)
diff --git a/lisp/finder.el b/lisp/finder.el
index 15c3fcb..2c3869b 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -90,24 +90,21 @@ Each element has the form (KEYWORD . DESCRIPTION).")
(define-key map "p" 'previous-line)
(define-key map "q" 'finder-exit)
(define-key map "d" 'finder-list-keywords)
-
- (define-key map [menu-bar finder-mode]
- (cons "Finder" menu-map))
- (define-key menu-map [finder-exit]
- '(menu-item "Quit" finder-exit
- :help "Exit Finder mode"))
- (define-key menu-map [finder-summary]
- '(menu-item "Summary" finder-summary
- :help "Summary item on current line in a finder buffer"))
- (define-key menu-map [finder-list-keywords]
- '(menu-item "List keywords" finder-list-keywords
- :help "Display descriptions of the keywords in the Finder
buffer"))
- (define-key menu-map [finder-select]
- '(menu-item "Select" finder-select
- :help "Select item on current line in a finder buffer"))
map)
"Keymap used in `finder-mode'.")
+(easy-menu-define finder-mode-menu finder-mode-map
+ "Menu for `finder-mode'."
+ '("Finder"
+ ["Select" finder-select
+ :help "Select item on current line in a finder buffer"]
+ ["List keywords" finder-list-keywords
+ :help "Display descriptions of the keywords in the Finder buffer"]
+ ["Summary" finder-summary
+ :help "Summary item on current line in a finder buffer"]
+ ["Quit" finder-exit
+ :help "Exit Finder mode"]))
+
(defvar finder-mode-syntax-table
(let ((st (make-syntax-table emacs-lisp-mode-syntax-table)))
(modify-syntax-entry ?\; ". " st)
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index d7b1c06..339bff9 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -365,7 +365,7 @@ This variable can also be set per-server."
"A list of strings representing expandable search keys.
\"Expandable\" simply means the key can be abbreviated while
typing in search queries, ie \"subject\" could be entered as
-\"subj\" or even \"su\", though \"s\" is ambigous between
+\"subj\" or even \"su\", though \"s\" is ambiguous between
\"subject\" and \"since\".
Ambiguous abbreviations will raise an error."
@@ -402,7 +402,7 @@ The search \"language\" is essentially a series of key:value
expressions. Key is most often a mail header, but there are
other keys. Value is a string, quoted if it contains spaces.
Key and value are separated by a colon, no space. Expressions
-are implictly ANDed; the \"or\" keyword can be used to
+are implicitly ANDed; the \"or\" keyword can be used to
OR. \"not\" will negate the following expression, or keys can be
prefixed with a \"-\". The \"near\" operator will work for
engines that understand it; other engines will convert it to
@@ -448,7 +448,7 @@ auto-completion of contact names and addresses for keys like
Date values (any key in `gnus-search-date-keys') can be provided
in any format that `parse-time-string' can parse (note that this
can produce weird results). Dates with missing bits will be
-interpreted as the most recent occurance thereof (ie \"march 03\"
+interpreted as the most recent occurence thereof (ie \"march 03\"
is the most recent March 3rd). Lastly, relative specifications
such as 1d (one day ago) are understood. This also accepts w, m,
and y. m is assumed to be 30 days.
@@ -646,7 +646,7 @@ gnus-*-mark marks, and return an appropriate string."
"Return a string from the current buffer.
If DELIMITED is non-nil, assume the next character is a delimiter
character, and return everything between point and the next
-occurance of the delimiter, including the delimiters themselves.
+occurence of the delimiter, including the delimiters themselves.
If TRIM is non-nil, do not return the delimiters. Otherwise,
return one word."
;; This function cannot handle nested delimiters, as it's not a
@@ -789,7 +789,7 @@ the files in ARTLIST by that search key.")
(raw-queries-p
:initform (symbol-value 'gnus-search-imap-raw-queries-p)))
:documentation
- "The base IMAP search engine, using an IMAP server's search capabilites.
+ "The base IMAP search engine, using an IMAP server's search capabilities.
This backend may be subclassed to handle particular IMAP servers'
quirks.")
@@ -1082,7 +1082,7 @@ Responsible for handling and, or, and parenthetical
expressions.")
(cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap)
(query string))
"Create the IMAP search command for QUERY.
-Currenly takes into account support for the LITERAL+ capability.
+Currently takes into account support for the LITERAL+ capability.
Other capabilities could be tested here."
(with-slots (literal-plus) engine
(when literal-plus
@@ -1672,8 +1672,8 @@ and \"-\" before marks."
(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
(expr (head or)))
"Handle Mairix \"or\" statement.
-Mairix only accepts \"or\" expressions on homogenous keys. We
-cast \"or\" expressions on heterogenous keys as \"and\", which
+Mairix only accepts \"or\" expressions on homogeneous keys. We
+cast \"or\" expressions on heterogeneous keys as \"and\", which
isn't quite right, but it's the best we can do. For date keys,
only keep one of the terms."
(let ((term1 (caadr expr))
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index fffa2d2..1daa8aa 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -33,7 +33,7 @@
;; turn be a vector of three elements: a real prefixed group name, an
;; article number in that group, and an integer score. The score is
;; not used by nnselect but may be used by other code to help in
-;; sorting. Most functions will just chose a fixed number, such as
+;; sorting. Most functions will just choose a fixed number, such as
;; 100, for this score.
;; For example the search function `gnus-search-run-query' applied to
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 79710a1..30a1ce0 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -54,14 +54,30 @@
["Show Help for Symbol" help-follow-symbol
:help "Show the docs for the symbol at point"]
["Previous Topic" help-go-back
- :help "Go back to previous topic in this help buffer"]
+ :help "Go back to previous topic in this help buffer"
+ :active help-xref-stack]
["Next Topic" help-go-forward
- :help "Go back to next topic in this help buffer"]
+ :help "Go back to next topic in this help buffer"
+ :active help-xref-forward-stack]
["Move to Previous Button" backward-button
:help "Move to the Previous Button in the help buffer"]
["Move to Next Button" forward-button
:help "Move to the Next Button in the help buffer"]))
+(defvar help-mode-tool-bar-map
+ (let ((map (make-sparse-keymap)))
+ (tool-bar-local-item "close" 'quit-window 'quit map
+ :label "Quit help."
+ :vert-only t)
+ (define-key-after map [separator-1] menu-bar-separator)
+ (tool-bar-local-item "search" 'isearch-forward 'search map
+ :label "Search" :vert-only t)
+ (tool-bar-local-item-from-menu 'help-go-back "left-arrow" map help-mode-map
+ :rtl "right-arrow" :vert-only t)
+ (tool-bar-local-item-from-menu 'help-go-forward "right-arrow" map
help-mode-map
+ :rtl "left-arrow" :vert-only t)
+ map))
+
(defvar-local help-xref-stack nil
"A stack of ways by which to return to help buffers after following xrefs.
Used by `help-follow' and `help-xref-go-back'.
@@ -317,6 +333,8 @@ Commands:
\\{help-mode-map}"
(setq-local revert-buffer-function
#'help-mode-revert-buffer)
+ (setq-local tool-bar-map
+ help-mode-tool-bar-map)
(setq-local bookmark-make-record-function
#'help-bookmark-make-record))
@@ -778,8 +796,8 @@ help buffer by other means."
(&optional no-file no-context posn))
(defun help-bookmark-make-record ()
- "Create and return a help-mode bookmark record.
-Implements `bookmark-make-record-function' for help-mode buffers."
+ "Create and return a `help-mode' bookmark record.
+Implements `bookmark-make-record-function' for `help-mode' buffers."
(unless (car help-xref-stack-item)
(error "Cannot create bookmark - help command not known"))
`(,@(bookmark-make-record-default 'NO-FILE 'NO-CONTEXT)
@@ -792,7 +810,7 @@ Implements `bookmark-make-record-function' for help-mode
buffers."
;;;###autoload
(defun help-bookmark-jump (bookmark)
- "Jump to help-mode bookmark BOOKMARK.
+ "Jump to `help-mode' bookmark BOOKMARK.
Handler function for record returned by `help-bookmark-make-record'.
BOOKMARK is a bookmark name or a bookmark record."
(let ((help-fn (bookmark-prop-get bookmark 'help-fn))
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index ec0a559..7384abf 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -858,7 +858,9 @@ was inserted."
(setq image-transform-rotation
(or (exif-orientation
(ignore-error exif-error
- (exif-parse-buffer)))
+ ;; exif-parse-buffer can move point, so preserve it.
+ (save-excursion
+ (exif-parse-buffer))))
0.0)))
;; Swap width and height when changing orientation
;; between portrait and landscape.
diff --git a/lisp/isearch.el b/lisp/isearch.el
index c571ea9..8266c4b 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -3356,7 +3356,7 @@ the word mode."
(defun isearch-lazy-count-format (&optional suffix-p)
"Format the current match number and the total number of matches.
-When SUFFIX-P is non-nil, the returned string is indended for
+When SUFFIX-P is non-nil, the returned string is intended for
isearch-message-suffix prompt. Otherwise, for isearch-message-prefix."
(let ((format-string (if suffix-p
lazy-count-suffix-format
diff --git a/lisp/json.el b/lisp/json.el
index 1f1f608..f20123f 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -438,7 +438,8 @@ Initialized lazily by `json-encode-string'.")
;; This seems to afford decent performance gains.
(setq-local inhibit-modification-hooks t)
(setq json--string-buffer (current-buffer))))
- (insert ?\" (substring-no-properties string)) ; see bug#43549
+ ;; Strip `read-only' property (bug#43549).
+ (insert ?\" (substring-no-properties string))
(goto-char (1+ (point-min)))
(while (re-search-forward (rx json--escape) nil 'move)
(let ((char (preceding-char)))
@@ -452,14 +453,20 @@ Initialized lazily by `json-encode-string'.")
;; Empty buffer for next invocation.
(delete-and-extract-region (point-min) (point-max)))))
+(defun json--encode-stringlike (object)
+ "Return OBJECT encoded as a JSON string, or nil if not possible."
+ (cond ((stringp object) (json-encode-string object))
+ ((keywordp object) (json-encode-string
+ (substring (symbol-name object) 1)))
+ ((symbolp object) (json-encode-string (symbol-name object)))))
+
(defun json-encode-key (object)
"Return a JSON representation of OBJECT.
If the resulting JSON object isn't a valid JSON object key,
this signals `json-key-format'."
- (let ((encoded (json-encode object)))
- (unless (stringp (json-read-from-string encoded))
- (signal 'json-key-format (list object)))
- encoded))
+ ;; Encoding must be a JSON string.
+ (or (json--encode-stringlike object)
+ (signal 'json-key-format (list object))))
;;; Objects
@@ -652,11 +659,10 @@ become JSON objects."
;; Array encoding
(defun json-encode-array (array)
- "Return a JSON representation of ARRAY."
+ "Return a JSON representation of ARRAY.
+ARRAY can also be a list."
(if (and json-encoding-pretty-print
- (if (listp array)
- array
- (> (length array) 0)))
+ (not (length= array 0)))
(concat
"["
(json--with-indentation
@@ -737,15 +743,9 @@ you will get the following structure returned:
OBJECT should have a structure like one returned by `json-read'.
If an error is detected during encoding, an error based on
`json-error' is signaled."
- (cond ((eq object t) (json-encode-keyword object))
- ((eq object json-null) (json-encode-keyword object))
- ((eq object json-false) (json-encode-keyword object))
- ((stringp object) (json-encode-string object))
- ((keywordp object) (json-encode-string
- (substring (symbol-name object) 1)))
+ (cond ((json-encode-keyword object))
((listp object) (json-encode-list object))
- ((symbolp object) (json-encode-string
- (symbol-name object)))
+ ((json--encode-stringlike object))
((numberp object) (json-encode-number object))
((arrayp object) (json-encode-array object))
((hash-table-p object) (json-encode-hash-table object))
@@ -774,6 +774,8 @@ With prefix argument MINIMIZE, minimize it instead."
(json-null :json-null)
;; Ensure that ordering is maintained.
(json-object-type 'alist)
+ ;; Ensure that keys survive roundtrip (bug#24252, bug#42545).
+ (json-key-type 'string)
(orig-buf (current-buffer))
error)
;; Strategy: Repeatedly `json-read' from the original buffer and
diff --git a/lisp/man.el b/lisp/man.el
index 1fded38..abb9bba 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -1024,7 +1024,7 @@ to auto-complete your input based on the installed manual
pages."
;;;###autoload
(defun man-follow (man-args)
"Get a Un*x manual page of the item under point and put it in a buffer."
- (interactive (list (Man-default-man-entry)))
+ (interactive (list (Man-default-man-entry)) man-common)
(if (or (not man-args)
(string= man-args ""))
(error "No item under point")
@@ -1143,7 +1143,7 @@ Return the buffer in which the manpage will appear."
(defun Man-update-manpage ()
"Reformat current manpage by calling the man command again synchronously."
- (interactive)
+ (interactive nil man-common)
(when (eq Man-arguments nil)
;;this shouldn't happen unless it is not in a Man buffer."
(error "Man-arguments not initialized"))
@@ -1239,7 +1239,7 @@ See the variable `Man-notify-method' for the different
notification behaviors."
(defun Man-fontify-manpage ()
"Convert overstriking and underlining to the correct fonts.
Same for the ANSI bold and normal escape sequences."
- (interactive)
+ (interactive nil man-common)
(goto-char (point-min))
;; Fontify ANSI escapes.
(let ((ansi-color-apply-face-function #'ansi-color-apply-text-property-face)
@@ -1355,7 +1355,7 @@ default type, `Man-xref-man-page' is used for the
buttons."
Normally skip any jobs that should have been done by the sed script,
but when called interactively, do those jobs even if the sed
script would have done them."
- (interactive "p")
+ (interactive "p" man-common)
(if (or interactive (not Man-sed-script))
(progn
(goto-char (point-min))
@@ -1527,7 +1527,14 @@ manpage command."
(defvar bookmark-make-record-function)
-(define-derived-mode Man-mode special-mode "Man"
+(define-derived-mode man-common special-mode "Man Shared"
+ "Parent mode for `Man-mode' like modes.
+This mode is here to be inherited by modes that need to use
+commands from `Man-mode'. Used by `woman'.
+(In itself, this mode currently does nothing.)"
+ :interactive nil)
+
+(define-derived-mode Man-mode man-common "Man"
"A mode for browsing Un*x manual pages.
The following man commands are available in the buffer. Try
@@ -1723,7 +1730,7 @@ The following key bindings are currently in effect in the
buffer:
(defun Man-next-section (n)
"Move point to Nth next section (default 1)."
- (interactive "p")
+ (interactive "p" man-common)
(let ((case-fold-search nil)
(start (point)))
(if (looking-at Man-heading-regexp)
@@ -1739,7 +1746,7 @@ The following key bindings are currently in effect in the
buffer:
(defun Man-previous-section (n)
"Move point to Nth previous section (default 1)."
- (interactive "p")
+ (interactive "p" man-common)
(let ((case-fold-search nil))
(if (looking-at Man-heading-regexp)
(forward-line -1))
@@ -1756,8 +1763,7 @@ Returns t if section is found, nil otherwise."
(if (re-search-forward (concat "^" section) (point-max) t)
(progn (beginning-of-line) t)
(goto-char curpos)
- nil)
- ))
+ nil)))
(defvar Man--last-section nil)
@@ -1771,7 +1777,8 @@ Returns t if section is found, nil otherwise."
(prompt (concat "Go to section (default " default "): "))
(chosen (completing-read prompt Man--sections
nil nil nil nil default)))
- (list chosen)))
+ (list chosen))
+ man-common)
(setq Man--last-section section)
(unless (Man-find-section section)
(error "Section %s not found" section)))
@@ -1780,7 +1787,7 @@ Returns t if section is found, nil otherwise."
(defun Man-goto-see-also-section ()
"Move point to the \"SEE ALSO\" section.
Actually the section moved to is described by `Man-see-also-regexp'."
- (interactive)
+ (interactive nil man-common)
(if (not (Man-find-section Man-see-also-regexp))
(error "%s" (concat "No " Man-see-also-regexp
" section found in the current manpage"))))
@@ -1834,7 +1841,8 @@ Specify which REFERENCE to use; default is based on word
at point."
(prompt (concat "Refer to (default " default "): "))
(chosen (completing-read prompt Man--refpages
nil nil nil nil defaults)))
- chosen))))
+ chosen)))
+ man-common)
(if (not Man--refpages)
(error "Can't find any references in the current manpage")
(setq Man--last-refpage reference)
@@ -1843,7 +1851,7 @@ Specify which REFERENCE to use; default is based on word
at point."
(defun Man-kill ()
"Kill the buffer containing the manpage."
- (interactive)
+ (interactive nil man-common)
(quit-window t))
(defun Man-goto-page (page &optional noerror)
@@ -1854,7 +1862,8 @@ Specify which REFERENCE to use; default is based on word
at point."
(if (= (length Man-page-list) 1)
(error "You're looking at the only manpage in the buffer")
(list (read-minibuffer (format "Go to manpage [1-%d]: "
- (length Man-page-list)))))))
+ (length Man-page-list))))))
+ man-common)
(if (and (not Man-page-list) (not noerror))
(error "Not a man page buffer"))
(when Man-page-list
@@ -1876,7 +1885,7 @@ Specify which REFERENCE to use; default is based on word
at point."
(defun Man-next-manpage ()
"Find the next manpage entry in the buffer."
- (interactive)
+ (interactive nil man-common)
(if (= (length Man-page-list) 1)
(error "This is the only manpage in the buffer"))
(if (< Man-current-page (length Man-page-list))
@@ -1887,7 +1896,7 @@ Specify which REFERENCE to use; default is based on word
at point."
(defun Man-previous-manpage ()
"Find the previous manpage entry in the buffer."
- (interactive)
+ (interactive nil man-common)
(if (= (length Man-page-list) 1)
(error "This is the only manpage in the buffer"))
(if (> Man-current-page 1)
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index 9ad843c..1d25b14 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -136,7 +136,7 @@ displayed."
(show-window (get-buffer-window mh-show-buffer))
(display-mime-buttons-flag mh-display-buttons-for-inline-parts-flag))
(if (not (eq (next-window (minibuffer-window)) (selected-window)))
- (delete-other-windows)) ; force ourself to the top window
+ (delete-other-windows)) ; force ourselves to the top window
(mh-in-show-buffer (mh-show-buffer)
(setq mh-display-buttons-for-inline-parts-flag display-mime-buttons-flag)
(if (and show-window
diff --git a/lisp/net/dictionary-connection.el
b/lisp/net/dictionary-connection.el
index 8ad4fe4..8312574 100644
--- a/lisp/net/dictionary-connection.el
+++ b/lisp/net/dictionary-connection.el
@@ -23,9 +23,9 @@
;;; Commentary:
;; dictionary-connection allows to handle TCP-based connections in
-;; client mode where text-based information are exchanged. There is
+;; client mode where text-based information is exchanged. There is
;; special support for handling CR LF (and the usual CR LF . CR LF
-;; terminater).
+;; terminator).
;;; Code:
@@ -68,7 +68,7 @@
(defun dictionary-connection-open (server port)
"Open a connection to SERVER at PORT.
-A data structure identifing the connection is returned"
+A data structure identifying the connection is returned"
(let ((process-buffer (generate-new-buffer (format " connection to %s:%s"
server
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index 6f08605..c6af4e6 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -127,9 +127,9 @@ by the choice value:
The found word exactly matches the searched word.
-- Similiar sounding
+- Similar sounding
- The found word sounds similiar to the searched word. For this match type
+ The found word sounds similar to the searched word. For this match type
the soundex algorithm defined by Donald E. Knuth is used. It will only
works with english words and the algorithm is not very reliable (i.e.,
the soundex algorithm is quite simple).
@@ -148,7 +148,7 @@ by the choice value:
dictionary server."
:group 'dictionary
:type '(choice (const :tag "Exact match" "exact")
- (const :tag "Similiar sounding" "soundex")
+ (const :tag "Similar sounding" "soundex")
(const :tag "Levenshtein distance one" "lev")
(string :tag "User choice"))
:version "28.1")
@@ -419,7 +419,7 @@ This is a quick reference to this mode describing the
default key bindings:
;;;###autoload
(defun dictionary ()
- "Create a new dictonary buffer and install `dictionary-mode'."
+ "Create a new dictionary buffer and install `dictionary-mode'."
(interactive)
(let ((buffer (or (and dictionary-use-single-buffer
(get-buffer "*Dictionary*"))
@@ -568,7 +568,7 @@ The connection takes the proxy setting in customization
group
answer)))
(defun dictionary-split-string (string)
- "Split STRING constiting of space-separated words into elements.
+ "Split STRING consisting of space-separated words into elements.
This function knows about the special meaning of quotes (\")"
(let ((list))
(while (and string (> (length string) 0))
@@ -894,7 +894,7 @@ The word is taken from the buffer, the DICTIONARY is given
as argument."
(unless (dictionary-check-reply reply 110)
(error "Unknown server answer: %s"
(dictionary-reply reply)))
- (dictionary-display-dictionarys))))
+ (dictionary-display-dictionaries))))
(defun dictionary-simple-split-string (string &optional pattern)
"Return a list of substrings of STRING which are separated by PATTERN.
@@ -909,7 +909,7 @@ If PATTERN is omitted, it defaults to \"[
\\f\\t\\n\\r\\v]+\"."
start (match-end 0)))
(nreverse (cons (substring string start) parts))))
-(defun dictionary-display-dictionarys ()
+(defun dictionary-display-dictionaries ()
"Handle the display of all dictionaries existing on the server."
(dictionary-pre-buffer)
(insert "Please select your default dictionary:\n\n")
@@ -1171,7 +1171,7 @@ allows editing it."
;; if called by pressing the button
(unless word
(setq word (read-string "Search word: " nil 'dictionary-word-history)))
- ;; just in case non-interactivly called
+ ;; just in case non-interactively called
(unless dictionary
(setq dictionary dictionary-default-dictionary))
(dictionary-new-search (cons word dictionary)))
@@ -1249,10 +1249,10 @@ allows editing it."
;;; Tooltip support
-;; Add a mode indicater named "Dict"
+;; Add a mode indicator named "Dict"
(defvar dictionary-tooltip-mode
nil
- "Indicates wheather the dictionary tooltip mode is active.")
+ "Indicates whether the dictionary tooltip mode is active.")
(nconc minor-mode-alist '((dictionary-tooltip-mode " Dict")))
(defcustom dictionary-tooltip-dictionary
diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el
index 66a684d..b07016c 100644
--- a/lisp/net/eudcb-macos-contacts.el
+++ b/lisp/net/eudcb-macos-contacts.el
@@ -108,7 +108,7 @@ RETURN-ATTRS is a list of attributes to return, defaulting
to
(defun eudc-macos-contacts-set-server (dummy)
"Set the EUDC server to macOS Contacts app.
The server in DUMMY is not actually used, since this backend
-always and implicitly connetcs to an instance of the Contacts app
+always and implicitly connects to an instance of the Contacts app
running on the local host."
(interactive)
(eudc-set-server dummy 'macos-contacts)
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index b95cd0f..3097c9a 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -332,7 +332,7 @@ whose car is a symbol, it is `eval'uated to yield the
validity. If it
is a string or list of strings, it represents a shell command to run
to return a true or false shell value for the validity.
-The last matching entry in this structure takes presedence over
+The last matching entry in this structure takes precedence over
preceding entries.")
(put 'mailcap-mime-data 'risky-local-variable t)
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index cf55f66..a2d4d89 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -1626,7 +1626,7 @@ Return t if a new feed was activated, nil otherwise."
(interactive
(list (let ((completion-ignore-case t))
(completing-read
- "Jump to feed: "
+ "Jump to feed/group: "
(append '("new" "obsolete" "immortal" "all")
(mapcar #'car (append newsticker-url-list
newsticker-url-list-defaults)))
@@ -1852,28 +1852,34 @@ of the shift. If MOVE-GROUP is nil the currently
selected feed
`newsticker--treeview-current-feed' is shifted, if it is t then
the current feed's parent group is shifted.."
(let* ((cur-feed newsticker--treeview-current-feed)
- (thing (if move-group
- (newsticker--group-find-parent-group cur-feed)
+ (thing (if (and move-group
+ (not (newsticker--group-get-group cur-feed)))
+ (car (newsticker--group-find-parent-group cur-feed))
cur-feed))
(parent-group (newsticker--group-find-parent-group
- (if move-group (car thing) thing))))
+ ;;(if move-group (car thing) thing)
+ thing)))
(unless parent-group
(error "Group not found!"))
(let* ((siblings (cdr parent-group))
- (pos (cl-position thing siblings :test 'equal))
+ (pos (cl-position thing siblings :test
+ (lambda (o1 o2)
+ (equal (if (listp o1) (car o1) o1)
+ (if (listp o2) (car o2) o2)))))
(tpos (+ pos delta ))
(new-pos (max 0 (min (length siblings) tpos)))
(beg (cl-subseq siblings 0 (min pos new-pos)))
(end (cl-subseq siblings (+ 1 (max pos new-pos))))
(p (elt siblings new-pos)))
(when (not (= pos new-pos))
- (setcdr parent-group
- (cl-concatenate 'list
- beg
- (if (> delta 0)
- (list p thing)
- (list thing p))
- end))
+ (let ((th (or (newsticker--group-get-group thing) thing)))
+ (setcdr parent-group
+ (cl-concatenate 'list
+ beg
+ (if (> delta 0)
+ (list p th)
+ (list th p))
+ end)))
(newsticker--treeview-tree-update)
(newsticker-treeview-update)
(newsticker-treeview-jump cur-feed)))))
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 96fafc8..1da1d31 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -390,6 +390,8 @@
proc)))
(defun socks-send-command (proc command atype address port)
+ "Send COMMAND to SOCKS service PROC for proxying ADDRESS and PORT.
+When ATYPE indicates an IP, param ADDRESS must be given as raw bytes."
(let ((addr (cond
((or (= atype socks-address-type-v4)
(= atype socks-address-type-v6))
@@ -528,7 +530,7 @@
(setq host (socks-nslookup-host host))
(if (not (listp host))
(error "Could not get IP address for: %s" host))
- (setq host (apply #'format "%c%c%c%c" host))
+ (setq host (apply #'unibyte-string host))
socks-address-type-v4)
(t
socks-address-type-name))))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 4519c34..6935955 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1928,7 +1928,7 @@ If ARGUMENT is non-nil, use it as argument for
;; Check whether we still have the same smbclient version.
;; Otherwise, we must delete the connection cache, because
- ;; capabilities migh have changed.
+ ;; capabilities might have changed.
(unless (or argument (processp p))
(let ((default-directory (tramp-compat-temporary-file-directory))
(command (concat tramp-smb-program " -V")))
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 0602943..1bc905c 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -546,7 +546,7 @@ Many aspects this mode can be customized using
(when (and nxml-default-buffer-file-coding-system
(not (local-variable-p 'buffer-file-coding-system)))
(setq buffer-file-coding-system nxml-default-buffer-file-coding-system))
- ;; When starting a new file, insert the XML declaraction.
+ ;; When starting a new file, insert the XML declaration.
(when (and nxml-auto-insert-xml-declaration-flag
(zerop (buffer-size)))
(nxml-insert-xml-declaration)))
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index dc93ef9..dddd19f 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -811,78 +811,7 @@ static char * dot3d_xpm[] = {
(bubbles--initialize-images)
(bubbles--update-faces-or-images))
-;; game theme menu
-(defvar bubbles-game-theme-menu
- (let ((menu (make-sparse-keymap "Game Theme")))
- (define-key menu [bubbles-set-game-userdefined]
- (list 'menu-item "User defined" 'bubbles-set-game-userdefined
- :button '(:radio . (eq bubbles-game-theme 'user-defined))))
- (define-key menu [bubbles-set-game-hard]
- (list 'menu-item "Hard" 'bubbles-set-game-hard
- :button '(:radio . (eq bubbles-game-theme 'hard))))
- (define-key menu [bubbles-set-game-difficult]
- (list 'menu-item "Difficult" 'bubbles-set-game-difficult
- :button '(:radio . (eq bubbles-game-theme 'difficult))))
- (define-key menu [bubbles-set-game-medium]
- (list 'menu-item "Medium" 'bubbles-set-game-medium
- :button '(:radio . (eq bubbles-game-theme 'medium))))
- (define-key menu [bubbles-set-game-easy]
- (list 'menu-item "Easy" 'bubbles-set-game-easy
- :button '(:radio . (eq bubbles-game-theme 'easy))))
- menu)
- "Map for bubbles game theme menu.")
-
-;; graphics theme menu
-(defvar bubbles-graphics-theme-menu
- (let ((menu (make-sparse-keymap "Graphics Theme")))
- (define-key menu [bubbles-set-graphics-theme-ascii]
- (list 'menu-item "ASCII" 'bubbles-set-graphics-theme-ascii
- :button '(:radio . (eq bubbles-graphics-theme 'ascii))))
- (define-key menu [bubbles-set-graphics-theme-emacs]
- (list 'menu-item "Emacs" 'bubbles-set-graphics-theme-emacs
- :button '(:radio . (eq bubbles-graphics-theme 'emacs))))
- (define-key menu [bubbles-set-graphics-theme-balls]
- (list 'menu-item "Balls" 'bubbles-set-graphics-theme-balls
- :button '(:radio . (eq bubbles-graphics-theme 'balls))))
- (define-key menu [bubbles-set-graphics-theme-diamonds]
- (list 'menu-item "Diamonds" 'bubbles-set-graphics-theme-diamonds
- :button '(:radio . (eq bubbles-graphics-theme 'diamonds))))
- (define-key menu [bubbles-set-graphics-theme-squares]
- (list 'menu-item "Squares" 'bubbles-set-graphics-theme-squares
- :button '(:radio . (eq bubbles-graphics-theme 'squares))))
- (define-key menu [bubbles-set-graphics-theme-circles]
- (list 'menu-item "Circles" 'bubbles-set-graphics-theme-circles
- :button '(:radio . (eq bubbles-graphics-theme 'circles))))
- menu)
- "Map for bubbles graphics theme menu.")
-
-;; menu
-(defvar bubbles-menu
- (let ((menu (make-sparse-keymap "Bubbles")))
- (define-key menu [bubbles-quit]
- (list 'menu-item "Quit" 'bubbles-quit))
- (define-key menu [bubbles]
- (list 'menu-item "New game" 'bubbles))
- (define-key menu [bubbles-separator-1]
- '("--"))
- (define-key menu [bubbles-save-settings]
- (list 'menu-item "Save all settings" 'bubbles-save-settings))
- (define-key menu [bubbles-customize]
- (list 'menu-item "Edit all settings" 'bubbles-customize))
- (define-key menu [bubbles-game-theme-menu]
- (list 'menu-item "Game Theme" bubbles-game-theme-menu))
- (define-key menu [bubbles-graphics-theme-menu]
- (list 'menu-item "Graphics Theme" bubbles-graphics-theme-menu
- :enable 'bubbles--playing))
- (define-key menu [bubbles-separator-2]
- '("--"))
- (define-key menu [bubbles-undo]
- (list 'menu-item "Undo last move" 'bubbles-undo
- :enable '(and bubbles--playing (listp buffer-undo-list))))
- menu)
- "Map for bubbles menu.")
-
-;; bubbles mode map
+
(defvar bubbles-mode-map
(let ((map (make-sparse-keymap 'bubbles-mode-map)))
;; (suppress-keymap map t)
@@ -897,12 +826,59 @@ static char * dot3d_xpm[] = {
(define-key map "n" 'next-line)
(define-key map "f" 'forward-char)
(define-key map "b" 'backward-char)
- ;; bind menu to mouse
- (define-key map [down-mouse-3] bubbles-menu)
- ;; Put menu in menu-bar
- (define-key map [menu-bar Bubbles] (cons "Bubbles" bubbles-menu))
map)
- "Mode map for bubbles.")
+ "Mode map for `bubbles'.")
+
+(easy-menu-define bubbles-menu bubbles-mode-map
+ "Menu for `bubbles'."
+ '("Bubbles"
+ ["Undo last move" bubbles-undo
+ :enable '(and bubbles--playing (listp buffer-undo-list))]
+ "---"
+ ("Graphics Theme"
+ :enable bubbles--playing
+ ["Circles" bubbles-set-graphics-theme-circles
+ :style radio
+ :selected (eq bubbles-graphics-theme 'circles)]
+ ["Squares" bubbles-set-graphics-theme-squares
+ :style radio
+ :selected (eq bubbles-graphics-theme 'squares)]
+ ["Diamonds" bubbles-set-graphics-theme-diamonds
+ :style radio
+ :selected (eq bubbles-graphics-theme 'diamonds)]
+ ["Balls" bubbles-set-graphics-theme-balls
+ :style radio
+ :selected (eq bubbles-graphics-theme 'balls)]
+ ["Emacs" bubbles-set-graphics-theme-emacs
+ :style radio
+ :selected (eq bubbles-graphics-theme 'emacs)]
+ ["ASCII" bubbles-set-graphics-theme-ascii
+ :style radio
+ :selected (eq bubbles-graphics-theme 'ascii)])
+ ("Game Theme"
+ ["Easy" bubbles-set-game-easy
+ :style radio
+ :selected (eq bubbles-game-theme 'easy)]
+ ["Medium" bubbles-set-game-medium
+ :style radio
+ :selected (eq bubbles-game-theme 'medium)]
+ ["Difficult" bubbles-set-game-difficult
+ :style radio
+ :selected (eq bubbles-game-theme 'difficult)]
+ ["Hard" bubbles-set-game-hard
+ :style radio
+ :selected (eq bubbles-game-theme 'hard)]
+ ["User defined" bubbles-set-game-userdefined
+ :style radio
+ :selected (eq bubbles-game-theme 'user-defined)])
+ ["Edit all settings" bubbles-customize]
+ ["Save all settings" bubbles-save-settings]
+ "---"
+ ["New game" bubbles]
+ ["Quit" bubbles-quit]))
+
+;; bind menu to mouse
+(define-key bubbles-mode-map [down-mouse-3] bubbles-menu)
(define-derived-mode bubbles-mode nil "Bubbles"
"Major mode for playing bubbles.
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index 98da26c..3cc5d9c 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -90,7 +90,7 @@
(define-key map [handwrite] '("Write by hand" . handwrite))
map))
(fset 'menu-bar-handwrite-map menu-bar-handwrite-map)
-
+(make-obsolete-variable 'menu-bar-handwrite-map nil "28.1")
;; User definable variables
diff --git a/lisp/play/snake.el b/lisp/play/snake.el
index bed7cea..29effa2 100644
--- a/lisp/play/snake.el
+++ b/lisp/play/snake.el
@@ -336,38 +336,38 @@ Argument SNAKE-BUFFER is the name of the buffer."
(defun snake-move-left ()
"Make the snake move left."
- (interactive)
+ (interactive nil snake-mode)
(when (zerop (snake-final-x-velocity))
(push '(-1 0) snake-velocity-queue)))
(defun snake-move-right ()
"Make the snake move right."
- (interactive)
+ (interactive nil snake-mode)
(when (zerop (snake-final-x-velocity))
(push '(1 0) snake-velocity-queue)))
(defun snake-move-up ()
"Make the snake move up."
- (interactive)
+ (interactive nil snake-mode)
(when (zerop (snake-final-y-velocity))
(push '(0 -1) snake-velocity-queue)))
(defun snake-move-down ()
"Make the snake move down."
- (interactive)
+ (interactive nil snake-mode)
(when (zerop (snake-final-y-velocity))
(push '(0 1) snake-velocity-queue)))
(defun snake-end-game ()
"Terminate the current game."
- (interactive)
+ (interactive nil snake-mode)
(gamegrid-kill-timer)
(use-local-map snake-null-map)
(gamegrid-add-score snake-score-file snake-score))
(defun snake-start-game ()
"Start a new game of Snake."
- (interactive)
+ (interactive nil snake-mode)
(snake-reset-game)
(snake-set-dot)
(use-local-map snake-mode-map)
@@ -375,7 +375,7 @@ Argument SNAKE-BUFFER is the name of the buffer."
(defun snake-pause-game ()
"Pause (or resume) the current game."
- (interactive)
+ (interactive nil snake-mode)
(setq snake-paused (not snake-paused))
(message (and snake-paused "Game paused (press p to resume)")))
@@ -386,6 +386,7 @@ Argument SNAKE-BUFFER is the name of the buffer."
(define-derived-mode snake-mode special-mode "Snake"
"A mode for playing Snake."
+ :interactive nil
(add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el
index 05e4ffe..f43aa47 100644
--- a/lisp/play/tetris.el
+++ b/lisp/play/tetris.el
@@ -506,7 +506,7 @@ Drops the shape one square, testing for collision."
(defun tetris-move-bottom ()
"Drop the shape to the bottom of the playing area."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(let ((hit nil))
(tetris-erase-shape)
@@ -519,7 +519,7 @@ Drops the shape one square, testing for collision."
(defun tetris-move-left ()
"Move the shape one square to the left."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-pos-x (1- tetris-pos-x))
@@ -529,7 +529,7 @@ Drops the shape one square, testing for collision."
(defun tetris-move-right ()
"Move the shape one square to the right."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-pos-x (1+ tetris-pos-x))
@@ -539,7 +539,7 @@ Drops the shape one square, testing for collision."
(defun tetris-move-down ()
"Move the shape one square to the bottom."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-pos-y (1+ tetris-pos-y))
@@ -549,7 +549,7 @@ Drops the shape one square, testing for collision."
(defun tetris-rotate-prev ()
"Rotate the shape clockwise."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-rot (% (+ 1 tetris-rot)
@@ -561,7 +561,7 @@ Drops the shape one square, testing for collision."
(defun tetris-rotate-next ()
"Rotate the shape anticlockwise."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-rot (% (+ 3 tetris-rot)
@@ -573,14 +573,14 @@ Drops the shape one square, testing for collision."
(defun tetris-end-game ()
"Terminate the current game."
- (interactive)
+ (interactive nil tetris-mode)
(gamegrid-kill-timer)
(use-local-map tetris-null-map)
(gamegrid-add-score tetris-score-file tetris-score))
(defun tetris-start-game ()
"Start a new game of Tetris."
- (interactive)
+ (interactive nil tetris-mode)
(tetris-reset-game)
(use-local-map tetris-mode-map)
(let ((period (or (tetris-get-tick-period)
@@ -589,7 +589,7 @@ Drops the shape one square, testing for collision."
(defun tetris-pause-game ()
"Pause (or resume) the current game."
- (interactive)
+ (interactive nil tetris-mode)
(setq tetris-paused (not tetris-paused))
(message (and tetris-paused "Game paused (press p to resume)")))
@@ -600,6 +600,7 @@ Drops the shape one square, testing for collision."
(define-derived-mode tetris-mode nil "Tetris"
"A mode for playing Tetris."
+ :interactive nil
(add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
diff --git a/lisp/plstore.el b/lisp/plstore.el
index 4653366..4ca5886 100644
--- a/lisp/plstore.el
+++ b/lisp/plstore.el
@@ -1,4 +1,5 @@
;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
+
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@gnu.org>
@@ -19,7 +20,7 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;; Commentary
+;;; Commentary:
;; Plist based data store providing search and partial encryption.
;;
diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el
index 99b2ec6..2f7d7bf 100644
--- a/lisp/progmodes/asm-mode.el
+++ b/lisp/progmodes/asm-mode.el
@@ -73,19 +73,19 @@
;; Note that the comment character isn't set up until asm-mode is called.
(define-key map ":" 'asm-colon)
(define-key map "\C-c;" 'comment-region)
- (define-key map [menu-bar asm-mode] (cons "Asm" (make-sparse-keymap)))
- (define-key map [menu-bar asm-mode comment-region]
- '(menu-item "Comment Region" comment-region
- :help "Comment or uncomment each line in the region"))
- (define-key map [menu-bar asm-mode newline-and-indent]
- '(menu-item "Insert Newline and Indent" newline-and-indent
- :help "Insert a newline, then indent according to major
mode"))
- (define-key map [menu-bar asm-mode asm-colon]
- '(menu-item "Insert Colon" asm-colon
- :help "Insert a colon; if it follows a label, delete the
label's indentation"))
map)
"Keymap for Asm mode.")
+(easy-menu-define asm-mode-menu asm-mode-map
+ "Menu for Asm mode."
+ '("Asm"
+ ["Insert Colon" asm-colon
+ :help "Insert a colon; if it follows a label, delete the label's
indentation"]
+ ["Insert Newline and Indent" newline-and-indent
+ :help "Insert a newline, then indent according to major mode"]
+ ["Comment Region" comment-region
+ :help "Comment or uncomment each line in the region"]))
+
(defconst asm-font-lock-keywords
(append
'(("^\\(\\(\\sw\\|\\s_\\)+\\)\\>:?[ \t]*\\(\\sw+\\(\\.\\sw+\\)*\\)?"
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 484624b..9038c7b 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -2665,7 +2665,7 @@ comment at the start of cc-engine.el for more info."
;; One of the above "near" caches is associated with each of these functions.
;;
;; When searching this cache, these functions first seek an exact match, then
-;; a "close" match from the assiciated near cache. If neither of these
+;; a "close" match from the associated near cache. If neither of these
;; succeed, the nearest preceding entry in the far cache is used.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 44a7526..db142c0 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1305,7 +1305,7 @@ is a legal variable name).")
(group (regexp ,cperl--normal-identifier-regexp))
(opt
(sequence
- (1+ (regexp ,cperl--ws-or-comment-regexp))
+ (regexp ,cperl--ws-or-comment-regexp)
(group (regexp ,cperl--version-regexp))))))
"A regular expression for package NAME VERSION in Perl.
Contains two groups for the package name and version.")
@@ -1764,12 +1764,12 @@ or as help on variables `cperl-tips', `cperl-problems',
(setq-local syntax-propertize-function
(lambda (start end)
(goto-char start)
- ;; Even if cperl-fontify-syntaxically has already gone
+ ;; Even if cperl-fontify-syntactically has already gone
;; beyond `start', syntax-propertize has just removed
;; syntax-table properties between start and end, so we have
;; to re-apply them.
(setq cperl-syntax-done-to start)
- (cperl-fontify-syntaxically end))))
+ (cperl-fontify-syntactically end))))
(setq cperl-font-lock-multiline t) ; Not localized...
(setq-local font-lock-multiline t)
(setq-local font-lock-fontify-region-function
@@ -8407,7 +8407,7 @@ do extra unwind via `cperl-unwind-to-safe'."
(setq end (point)))
(font-lock-default-fontify-region beg end loudly))
-(defun cperl-fontify-syntaxically (end)
+(defun cperl-fontify-syntactically (end)
;; Some vars for debugging only
;; (message "Syntaxifying...")
(let ((dbg (point)) (iend end) (idone cperl-syntax-done-to)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 431daec..2dd2702 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -920,7 +920,13 @@ non-nil result supersedes the xrefs produced by
(point-marker)))))))
(cl-defmethod xref-location-group ((l xref-elisp-location))
- (xref-elisp-location-file l))
+ (let ((file (xref-elisp-location-file l)))
+ (defvar find-function-C-source-directory)
+ (if (and find-function-C-source-directory
+ (string-match-p "\\`src/" file))
+ (concat find-function-C-source-directory
+ (substring file 3))
+ file)))
(defun elisp-load-path-roots ()
(if (boundp 'package-user-dir)
@@ -1352,6 +1358,7 @@ if it already has a value.)
Return the result of evaluation."
;; FIXME: the print-length/level bindings should only be applied while
;; printing, not while evaluating.
+ (defvar elisp--eval-defun-result)
(let ((debug-on-error eval-expression-debug-on-error)
(print-length eval-expression-print-length)
(print-level eval-expression-print-level)
@@ -1367,19 +1374,22 @@ Return the result of evaluation."
(end-of-defun)
(beginning-of-defun)
(setq beg (point))
- (setq form (read (current-buffer)))
+ (setq form (funcall load-read-function (current-buffer)))
(setq end (point)))
;; Alter the form if necessary.
(let ((form (eval-sexp-add-defvars
(elisp--eval-defun-1
- (macroexpand
- `(setq elisp--eval-defun-result ,form))))))
+ (macroexpand form)))))
(eval-region beg end standard-output
(lambda (_ignore)
;; Skipping to the end of the specified region
;; will make eval-region return.
(goto-char end)
- form)))))
+ ;; This `setq' needs to be added *after* passing
+ ;; form through `elisp--eval-defun-1' since it
+ ;; would otherwise "hide" forms like `defvar's and
+ ;; thus defeat their special treatment.
+ `(setq elisp--eval-defun-result ,form))))))
(let ((str (eval-expression-print-format elisp--eval-defun-result)))
(if str (princ str)))
elisp--eval-defun-result))
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index b8c8a82..d018032 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -483,7 +483,7 @@ Currently, Flymake may provide these keyword-value pairs:
* `:recent-changes', a list of recent changes since the last time
the backend function was called for the buffer. An empty list
- indicates that no changes have been reocrded. If it is the
+ indicates that no changes have been recorded. If it is the
first time that this backend function is called for this
activation of `flymake-mode', then this argument isn't provided
at all (i.e. it's not merely nil).
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index d6ee8bb..3e92c69 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -279,57 +279,39 @@ See `compilation-error-screen-columns'."
(define-key map "}" 'compilation-next-file)
(define-key map "\t" 'compilation-next-error)
(define-key map [backtab] 'compilation-previous-error)
-
- ;; Set up the menu-bar
- (define-key map [menu-bar grep]
- (cons "Grep" (make-sparse-keymap "Grep")))
-
- (define-key map [menu-bar grep grep-find-toggle-abbreviation]
- '(menu-item "Toggle command abbreviation"
- grep-find-toggle-abbreviation
- :help "Toggle showing verbose command options"))
- (define-key map [menu-bar grep compilation-separator3] '("----"))
- (define-key map [menu-bar grep compilation-kill-compilation]
- '(menu-item "Kill Grep" kill-compilation
- :help "Kill the currently running grep process"))
- (define-key map [menu-bar grep compilation-separator2] '("----"))
- (define-key map [menu-bar grep compilation-compile]
- '(menu-item
- "Compile..." compile
- :help
- "Compile the program including the current buffer. Default: run
`make'"))
- (define-key map [menu-bar grep compilation-rgrep]
- '(menu-item "Recursive grep..." rgrep
- :help "User-friendly recursive grep in directory tree"))
- (define-key map [menu-bar grep compilation-lgrep]
- '(menu-item "Local grep..." lgrep
- :help "User-friendly grep in a directory"))
- (define-key map [menu-bar grep compilation-grep-find]
- '(menu-item "Grep via Find..." grep-find
- :help "Run grep via find, with user-specified args"))
- (define-key map [menu-bar grep compilation-grep]
- '(menu-item
- "Another grep..." grep
- :help
- "Run grep, with user-specified args, and collect output in a buffer."))
- (define-key map [menu-bar grep compilation-recompile]
- '(menu-item "Repeat grep" recompile
- :help "Run grep again"))
- (define-key map [menu-bar grep compilation-separator1] '("----"))
- (define-key map [menu-bar grep compilation-first-error]
- '(menu-item
- "First Match" first-error
- :help "Restart at the first match, visit corresponding location"))
- (define-key map [menu-bar grep compilation-previous-error]
- '(menu-item "Previous Match" previous-error
- :help "Visit the previous match and corresponding location"))
- (define-key map [menu-bar grep compilation-next-error]
- '(menu-item "Next Match" next-error
- :help "Visit the next match and corresponding location"))
map)
"Keymap for grep buffers.
`compilation-minor-mode-map' is a cdr of this.")
+(easy-menu-define grep-menu-map grep-mode-map
+ "Menu for grep buffers."
+ '("Grep"
+ ["Next Match" next-error
+ :help "Visit the next match and corresponding location"]
+ ["Previous Match" previous-error
+ :help "Visit the previous match and corresponding location"]
+ ["First Match" first-error
+ :help "Restart at the first match, visit corresponding location"]
+ "----"
+ ["Repeat grep" recompile
+ :help "Run grep again"]
+ ["Another grep..." grep
+ :help "Run grep, with user-specified args, and collect output in a
buffer."]
+ ["Grep via Find..." grep-find
+ :help "Run grep via find, with user-specified args"]
+ ["Local grep..." lgrep
+ :help "User-friendly grep in a directory"]
+ ["Recursive grep..." rgrep
+ :help "User-friendly recursive grep in directory tree"]
+ ["Compile..." compile
+ :help "Compile the program including the current buffer. Default: run
`make'"]
+ "----"
+ ["Kill Grep" kill-compilation
+ :help "Kill the currently running grep process"]
+ "----"
+ ["Toggle command abbreviation" grep-find-toggle-abbreviation
+ :help "Toggle showing verbose command options"]))
+
(defvar grep-mode-tool-bar-map
;; When bootstrapping, tool-bar-map is not properly initialized yet,
;; so don't do anything.
diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el
index 7dfaed4..d9c09f6 100644
--- a/lisp/progmodes/m4-mode.el
+++ b/lisp/progmodes/m4-mode.el
@@ -122,22 +122,22 @@ If m4 is not in your PATH, set this to an absolute file
name."
(string-to-syntax "."))))))
(defvar m4-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap)))
+ (let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-b" 'm4-m4-buffer)
(define-key map "\C-c\C-r" 'm4-m4-region)
(define-key map "\C-c\C-c" 'comment-region)
- (define-key map [menu-bar m4-mode] (cons "M4" menu-map))
- (define-key menu-map [m4c]
- '(menu-item "Comment Region" comment-region
- :help "Comment Region"))
- (define-key menu-map [m4b]
- '(menu-item "M4 Buffer" m4-m4-buffer
- :help "Send contents of the current buffer to m4"))
- (define-key menu-map [m4r]
- '(menu-item "M4 Region" m4-m4-region
- :help "Send contents of the current region to m4"))
- map))
+ map)
+ "Keymap for M4 Mode.")
+
+(easy-menu-define m4-mode-menu m4-mode-map
+ "Menu for M4 Mode."
+ '("M4"
+ ["M4 Region" m4-m4-region
+ :help "Send contents of the current region to m4"]
+ ["M4 Buffer" m4-m4-buffer
+ :help "Send contents of the current buffer to m4"]
+ ["Comment Region" comment-region
+ :help "Comment Region"]))
(defun m4-m4-buffer ()
"Send contents of the current buffer to m4."
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 3d1e7d6..3f466e1 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -573,8 +573,7 @@ The function must satisfy this calling convention:
"Abbrev table in use in Makefile buffers.")
(defvar makefile-mode-map
- (let ((map (make-sparse-keymap))
- (opt-map (make-sparse-keymap)))
+ (let ((map (make-sparse-keymap)))
;; set up the keymap
(define-key map "\C-c:" 'makefile-insert-target-ref)
(if makefile-electric-keys
@@ -599,72 +598,62 @@ The function must satisfy this calling convention:
(define-key map "\M-p" 'makefile-previous-dependency)
(define-key map "\M-n" 'makefile-next-dependency)
(define-key map "\e\t" 'completion-at-point)
-
- ;; Make menus.
- (define-key map [menu-bar makefile-mode]
- (cons "Makefile" (make-sparse-keymap "Makefile")))
-
- (define-key map [menu-bar makefile-mode makefile-type]
- (cons "Switch Makefile Type" opt-map))
- (define-key opt-map [makefile-makepp-mode]
- '(menu-item "Makepp" makefile-makepp-mode
- :help "An adapted `makefile-mode' that knows about makepp"
- :button (:radio . (eq major-mode 'makefile-makepp-mode))))
- (define-key opt-map [makefile-imake-mode]
- '(menu-item "Imake" makefile-imake-mode
- :help "An adapted `makefile-mode' that knows about imake"
- :button (:radio . (eq major-mode 'makefile-imake-mode))))
- (define-key opt-map [makefile-mode]
- '(menu-item "Classic" makefile-mode
- :help "`makefile-mode' with no special functionality"
- :button (:radio . (eq major-mode 'makefile-mode))))
- (define-key opt-map [makefile-bsdmake-mode]
- '(menu-item "BSD" makefile-bsdmake-mode
- :help "An adapted `makefile-mode' that knows about BSD make"
- :button (:radio . (eq major-mode 'makefile-bsdmake-mode))))
- (define-key opt-map [makefile-automake-mode]
- '(menu-item "Automake" makefile-automake-mode
- :help "An adapted `makefile-mode' that knows about automake"
- :button (:radio . (eq major-mode 'makefile-automake-mode))))
- (define-key opt-map [makefile-gmake-mode]
- '(menu-item "GNU make" makefile-gmake-mode
- :help "An adapted `makefile-mode' that knows about GNU make"
- :button (:radio . (eq major-mode 'makefile-gmake-mode))))
- (define-key map [menu-bar makefile-mode browse]
- '(menu-item "Pop up Makefile Browser" makefile-switch-to-browser
- ;; XXX: this needs a better string, the function is not
documented...
- :help "Pop up Makefile Browser"))
- (define-key map [menu-bar makefile-mode overview]
- '(menu-item "Up To Date Overview" makefile-create-up-to-date-overview
- :help "Create a buffer containing an overview of the state of
all known targets"))
- ;; Target related
- (define-key map [menu-bar makefile-mode separator1] '("----"))
- (define-key map [menu-bar makefile-mode pickup-file]
- '(menu-item "Pick File Name as Target"
makefile-pickup-filenames-as-targets
- :help "Scan the current directory for filenames to use as
targets"))
- (define-key map [menu-bar makefile-mode function]
- '(menu-item "Insert GNU make function" makefile-insert-gmake-function
- :help "Insert a GNU make function call"))
- (define-key map [menu-bar makefile-mode pickup]
- '(menu-item "Find Targets and Macros" makefile-pickup-everything
- :help "Notice names of all macros and targets in Makefile"))
- (define-key map [menu-bar makefile-mode complete]
- '(menu-item "Complete Target or Macro" completion-at-point
- :help "Perform completion on Makefile construct preceding
point"))
- (define-key map [menu-bar makefile-mode backslash]
- '(menu-item "Backslash Region" makefile-backslash-region
- :help "Insert, align, or delete end-of-line backslashes on
the lines in the region"))
- ;; Motion
- (define-key map [menu-bar makefile-mode separator] '("----"))
- (define-key map [menu-bar makefile-mode prev]
- '(menu-item "Move to Previous Dependency" makefile-previous-dependency
- :help "Move point to the beginning of the previous dependency
line"))
- (define-key map [menu-bar makefile-mode next]
- '(menu-item "Move to Next Dependency" makefile-next-dependency
- :help "Move point to the beginning of the next dependency
line"))
map)
"The keymap that is used in Makefile mode.")
+(easy-menu-define makefile-mode-menu makefile-mode-map
+ "Menu for Makefile mode."
+ '("Makefile"
+ ;; Motion
+ ["Move to Next Dependency" makefile-next-dependency
+ :help "Move point to the beginning of the next dependency line"]
+ ["Move to Previous Dependency" makefile-previous-dependency
+ :help "Move point to the beginning of the previous dependency line"]
+ "----"
+ ;; Target related
+ ["Backslash Region" makefile-backslash-region
+ :help "Insert, align, or delete end-of-line backslashes on the lines in
the region"]
+ ["Complete Target or Macro" completion-at-point
+ :help "Perform completion on Makefile construct preceding point"]
+ ["Find Targets and Macros" makefile-pickup-everything
+ :help "Notice names of all macros and targets in Makefile"]
+ ["Insert GNU make function" makefile-insert-gmake-function
+ :help "Insert a GNU make function call"]
+ ["Pick File Name as Target" makefile-pickup-filenames-as-targets
+ :help "Scan the current directory for filenames to use as targets"]
+ "----"
+ ;; Other.
+ ["Up To Date Overview" makefile-create-up-to-date-overview
+ :help "Create a buffer containing an overview of the state of all known
targets"]
+ ["Pop up Makefile Browser" makefile-switch-to-browser
+ ;; XXX: this needs a better string, the function is not documented...
+ :help "Pop up Makefile Browser"]
+ ("Switch Makefile Type"
+ ["GNU make" makefile-gmake-mode
+ :help "An adapted `makefile-mode' that knows about GNU make"
+ :style radio
+ :selected (eq major-mode 'makefile-gmake-mode)]
+ ["Automake" makefile-automake-mode
+ :help "An adapted `makefile-mode' that knows about automake"
+ :style radio
+ :selected (eq major-mode 'makefile-automake-mode)]
+ ["BSD" makefile-bsdmake-mode
+ :help "An adapted `makefile-mode' that knows about BSD make"
+ :style radio
+ :selected (eq major-mode 'makefile-bsdmake-mode)]
+ ["Classic" makefile-mode
+ :help "`makefile-mode' with no special functionality"
+ :style radio
+ :selected (eq major-mode 'makefile-mode)]
+ ["Imake" makefile-imake-mode
+ :help "An adapted `makefile-mode' that knows about imake"
+ :style radio
+ :selected (eq major-mode 'makefile-imake-mode)]
+ ["Makepp" makefile-makepp-mode
+ :help "An adapted `makefile-mode' that knows about makepp"
+ :style radio
+ :selected (eq major-mode 'makefile-makepp-mode)])))
+
(defvar makefile-browser-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index f588ad9..ba59f9c 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -403,8 +403,7 @@ This is buffer-local in every such buffer.")
"Syntax-table used in Shell-Script mode. See `sh-feature'.")
(defvar sh-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap)))
+ (let ((map (make-sparse-keymap)))
(define-key map "\C-c(" 'sh-function)
(define-key map "\C-c\C-w" 'sh-while)
(define-key map "\C-c\C-u" 'sh-until)
@@ -434,74 +433,57 @@ This is buffer-local in every such buffer.")
(define-key map "\C-c:" 'sh-set-shell)
(define-key map [remap backward-sentence] 'sh-beginning-of-command)
(define-key map [remap forward-sentence] 'sh-end-of-command)
- (define-key map [menu-bar sh-script] (cons "Sh-Script" menu-map))
- (define-key menu-map [smie-config-guess]
- '(menu-item "Learn buffer indentation" smie-config-guess
- :help "Learn how to indent the buffer the way it currently is."))
- (define-key menu-map [smie-config-show-indent]
- '(menu-item "Show indentation" smie-config-show-indent
- :help "Show the how the current line would be indented"))
- (define-key menu-map [smie-config-set-indent]
- '(menu-item "Set indentation" smie-config-set-indent
- :help "Set the indentation for the current line"))
-
- (define-key menu-map [sh-pair]
- '(menu-item "Insert braces and quotes in pairs"
- electric-pair-mode
- :button (:toggle . (bound-and-true-p electric-pair-mode))
- :help "Inserting a brace or quote automatically inserts the matching
pair"))
-
- (define-key menu-map [sh-s0] '("--"))
- ;; Insert
- (define-key menu-map [sh-function]
- '(menu-item "Function..." sh-function
- :help "Insert a function definition"))
- (define-key menu-map [sh-add]
- '(menu-item "Addition..." sh-add
- :help "Insert an addition of VAR and prefix DELTA for Bourne (type)
shell"))
- (define-key menu-map [sh-until]
- '(menu-item "Until Loop" sh-until
- :help "Insert an until loop"))
- (define-key menu-map [sh-repeat]
- '(menu-item "Repeat Loop" sh-repeat
- :help "Insert a repeat loop definition"))
- (define-key menu-map [sh-while]
- '(menu-item "While Loop" sh-while
- :help "Insert a while loop"))
- (define-key menu-map [sh-getopts]
- '(menu-item "Options Loop" sh-while-getopts
- :help "Insert a while getopts loop."))
- (define-key menu-map [sh-indexed-loop]
- '(menu-item "Indexed Loop" sh-indexed-loop
- :help "Insert an indexed loop from 1 to n."))
- (define-key menu-map [sh-select]
- '(menu-item "Select Statement" sh-select
- :help "Insert a select statement "))
- (define-key menu-map [sh-if]
- '(menu-item "If Statement" sh-if
- :help "Insert an if statement"))
- (define-key menu-map [sh-for]
- '(menu-item "For Loop" sh-for
- :help "Insert a for loop"))
- (define-key menu-map [sh-case]
- '(menu-item "Case Statement" sh-case
- :help "Insert a case/switch statement"))
- (define-key menu-map [sh-s1] '("--"))
- (define-key menu-map [sh-exec]
- '(menu-item "Execute region" sh-execute-region
- :help "Pass optional header and region to a subshell for
noninteractive execution"))
- (define-key menu-map [sh-exec-interpret]
- '(menu-item "Execute script..." executable-interpret
- :help "Run script with user-specified args, and collect output in a
buffer"))
- (define-key menu-map [sh-set-shell]
- '(menu-item "Set shell type..." sh-set-shell
- :help "Set this buffer's shell to SHELL (a string)"))
- (define-key menu-map [sh-backslash-region]
- '(menu-item "Backslash region" sh-backslash-region
- :help "Insert, align, or delete end-of-line backslashes on the lines
in the region."))
map)
"Keymap used in Shell-Script mode.")
+(easy-menu-define sh-mode-menu sh-mode-map
+ "Menu for Shell-Script mode."
+ '("Sh-Script"
+ ["Backslash region" sh-backslash-region
+ :help "Insert, align, or delete end-of-line backslashes on the lines in
the region."]
+ ["Set shell type..." sh-set-shell
+ :help "Set this buffer's shell to SHELL (a string)"]
+ ["Execute script..." executable-interpret
+ :help "Run script with user-specified args, and collect output in a
buffer"]
+ ["Execute region" sh-execute-region
+ :help "Pass optional header and region to a subshell for noninteractive
execution"]
+ "---"
+ ;; Insert
+ ["Case Statement" sh-case
+ :help "Insert a case/switch statement"]
+ ["For Loop" sh-for
+ :help "Insert a for loop"]
+ ["If Statement" sh-if
+ :help "Insert an if statement"]
+ ["Select Statement" sh-select
+ :help "Insert a select statement "]
+ ["Indexed Loop" sh-indexed-loop
+ :help "Insert an indexed loop from 1 to n."]
+ ["Options Loop" sh-while-getopts
+ :help "Insert a while getopts loop."]
+ ["While Loop" sh-while
+ :help "Insert a while loop"]
+ ["Repeat Loop" sh-repeat
+ :help "Insert a repeat loop definition"]
+ ["Until Loop" sh-until
+ :help "Insert an until loop"]
+ ["Addition..." sh-add
+ :help "Insert an addition of VAR and prefix DELTA for Bourne (type)
shell"]
+ ["Function..." sh-function
+ :help "Insert a function definition"]
+ "---"
+ ;; Other
+ ["Insert braces and quotes in pairs" electric-pair-mode
+ :style toggle
+ :selected (bound-and-true-p electric-pair-mode)
+ :help "Inserting a brace or quote automatically inserts the matching
pair"]
+ ["Set indentation" smie-config-set-indent
+ :help "Set the indentation for the current line"]
+ ["Show indentation" smie-config-show-indent
+ :help "Show the how the current line would be indented"]
+ ["Learn buffer indentation" smie-config-guess
+ :help "Learn how to indent the buffer the way it currently is."]))
+
(defvar sh-skeleton-pair-default-alist '((?\( _ ?\)) (?\))
(?\[ ?\s _ ?\s ?\]) (?\])
(?{ _ ?}) (?\}))
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index f934ef7..55c04e1 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -134,7 +134,7 @@
(interactive)
(message "Using verilog-mode version %s" verilog-mode-version))
-(defmacro verilog--supressed-warnings (warnings &rest body)
+(defmacro verilog--suppressed-warnings (warnings &rest body)
(declare (indent 1) (debug t))
(cond
((fboundp 'with-suppressed-warnings)
@@ -5550,7 +5550,7 @@ FILENAME to find directory to run in, or defaults to
`buffer-file-name'."
;; font-lock-fontify-buffer, but IIUC the problem this is supposed to
;; solve only appears in Emacsen older than font-lock-ensure anyway.
(when fontlocked
- (verilog--supressed-warnings
+ (verilog--suppressed-warnings
((interactive-only font-lock-fontify-buffer))
(font-lock-fontify-buffer))))))))
diff --git a/lisp/simple.el b/lisp/simple.el
index e54cbed..26710e6 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -549,7 +549,7 @@ It must be called via `run-hook-with-args-until-success'
with no arguments.
If any function on this hook returns a non-nil value, `delete-selection-mode'
will act on that value (see `delete-selection-helper') and will
usually delete the region. If all the functions on this hook return
-nil, it is an indiction that `self-insert-command' needs the region
+nil, it is an indication that `self-insert-command' needs the region
untouched by `delete-selection-mode' and will itself do whatever is
appropriate with the region.
Any function on `post-self-insert-hook' that acts on the region should
@@ -1278,7 +1278,19 @@ that uses or sets the mark."
;; Counting lines, one way or another.
-(defvar-local goto-line-history nil
+(defcustom goto-line-history-local nil
+ "If this option is nil, `goto-line-history' is shared between all buffers.
+If it is non-nil, each buffer has its own value of this history list.
+
+Note that on changing from non-nil to nil, the former contents of
+`goto-line-history' for each buffer are discarded on use of
+`goto-line' in that buffer."
+ :group 'editing
+ :type 'boolean
+ :safe #'booleanp
+ :version "28.1")
+
+(defvar goto-line-history nil
"History of values entered with `goto-line'.")
(defun goto-line-read-args (&optional relative)
@@ -1296,6 +1308,11 @@ that uses or sets the mark."
(if buffer
(concat " in " (buffer-name buffer))
"")))
+ ;; Has the buffer locality of `goto-line-history' changed?
+ (cond ((and goto-line-history-local (not (local-variable-p
'goto-line-history)))
+ (make-local-variable 'goto-line-history))
+ ((and (not goto-line-history-local) (local-variable-p
'goto-line-history))
+ (kill-local-variable 'goto-line-history)))
;; Read the argument, offering that number (if any) as default.
(list (read-number (format "Goto%s line%s: "
(if (buffer-narrowed-p)
@@ -1907,13 +1924,13 @@ to get different commands to edit and resubmit."
(defcustom read-extended-command-predicate nil
"Predicate to use to determine which commands to include when completing.
If it's nil, include all the commands.
-If it's a functoion, it will be called with two parameters: the
+If it's a function, it will be called with two parameters: the
symbol of the command and a buffer. The predicate should return
non-nil if the command should be present when doing `M-x TAB'
in that buffer."
:version "28.1"
:group 'completion
- :type `(choice (const :tag "Don't exclude any commands" nil)
+ :type '(choice (const :tag "Don't exclude any commands" nil)
(const :tag "Exclude commands irrelevant to current buffer's
mode"
command-completion-default-include-p)
(function :tag "Other function")))
@@ -1977,6 +1994,26 @@ This function uses the `read-extended-command-predicate'
user option."
(funcall read-extended-command-predicate sym buffer)))))
t nil 'extended-command-history))))
+(defun command-completion-using-modes-p (symbol buffer)
+ "Say whether SYMBOL has been marked as a mode-specific command in BUFFER."
+ ;; Check the modes.
+ (let ((modes (command-modes symbol)))
+ ;; Common case: Just a single mode.
+ (if (null (cdr modes))
+ (or (provided-mode-derived-p
+ (buffer-local-value 'major-mode buffer) (car modes))
+ (memq (car modes)
+ (buffer-local-value 'local-minor-modes buffer))
+ (memq (car modes) global-minor-modes))
+ ;; Uncommon case: Multiple modes.
+ (apply #'provided-mode-derived-p
+ (buffer-local-value 'major-mode buffer)
+ modes)
+ (seq-intersection modes
+ (buffer-local-value 'local-minor-modes buffer)
+ #'eq)
+ (seq-intersection modes global-minor-modes #'eq))))
+
(defun command-completion-default-include-p (symbol buffer)
"Say whether SYMBOL should be offered as a completion.
If there's a `completion-predicate' for SYMBOL, the result from
@@ -1987,24 +2024,8 @@ BUFFER."
(if (get symbol 'completion-predicate)
;; An explicit completion predicate takes precedence.
(funcall (get symbol 'completion-predicate) symbol buffer)
- ;; Check the modes.
- (let ((modes (command-modes symbol)))
- (or (null modes)
- ;; Common case: Just a single mode.
- (if (null (cdr modes))
- (or (provided-mode-derived-p
- (buffer-local-value 'major-mode buffer) (car modes))
- (memq (car modes)
- (buffer-local-value 'local-minor-modes buffer))
- (memq (car modes) global-minor-modes))
- ;; Uncommon case: Multiple modes.
- (apply #'provided-mode-derived-p
- (buffer-local-value 'major-mode buffer)
- modes)
- (seq-intersection modes
- (buffer-local-value 'local-minor-modes buffer)
- #'eq)
- (seq-intersection modes global-minor-modes #'eq))))))
+ (or (null (command-modes symbol))
+ (command-completion-using-modes-p symbol buffer))))
(defun command-completion-with-modes-p (modes buffer)
"Say whether MODES are in action in BUFFER.
@@ -2172,6 +2193,38 @@ invoking, give a prefix argument to
`execute-extended-command'."
suggest-key-bindings
2))))))))
+(defun execute-extended-command-for-buffer (prefixarg &optional
+ command-name typed)
+ "Query user for a command relevant for the current mode, and then execute it.
+This is like `execute-extended-command', but it limits the
+completions to commands that are particularly relevant to the
+current buffer. This includes commands that have been marked as
+being specially designed for the current major mode (and enabled
+minor modes), as well as commands bound in the active local key
+maps."
+ (declare (interactive-only command-execute))
+ (interactive
+ (let* ((execute-extended-command--last-typed nil)
+ (keymaps
+ ;; The major mode's keymap and any active minor modes.
+ (cons
+ (current-local-map)
+ (mapcar
+ #'cdr
+ (seq-filter
+ (lambda (elem)
+ (symbol-value (car elem)))
+ minor-mode-map-alist))))
+ (read-extended-command-predicate
+ (lambda (symbol buffer)
+ (or (command-completion-using-modes-p symbol buffer)
+ (where-is-internal symbol keymaps)))))
+ (list current-prefix-arg
+ (read-extended-command)
+ execute-extended-command--last-typed)))
+ (with-suppressed-warnings ((interactive-only execute-extended-command))
+ (execute-extended-command prefixarg command-name typed)))
+
(defun command-execute (cmd &optional record-flag keys special)
;; BEWARE: Called directly from the C code.
"Execute CMD as an editor command.
@@ -5959,8 +6012,9 @@ START and END specify the portion of the current buffer
to be copied."
(defvar activate-mark-hook nil
"Hook run when the mark becomes active.
-It is also run at the end of a command, if the mark is active and
-it is possible that the region may have changed.")
+It is also run when the region is reactivated, for instance after
+using a command that switches back to a buffer that has an active
+mark.")
(defvar deactivate-mark-hook nil
"Hook run when the mark becomes inactive.")
diff --git a/lisp/subr.el b/lisp/subr.el
index a6e39e7..0c70858 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -378,10 +378,18 @@ PREFIX is a string, and defaults to \"g\"."
(defun ignore (&rest _arguments)
"Do nothing and return nil.
-This function accepts any number of ARGUMENTS, but ignores them."
+This function accepts any number of ARGUMENTS, but ignores them.
+Also see `always'."
+ (declare (completion #'ignore))
(interactive)
nil)
+(defun always (&rest _arguments)
+ "Do nothing and return t.
+This function accepts any number of ARGUMENTS, but ignores them.
+Also see `ignore'."
+ t)
+
;; Signal a compile-error if the first arg is missing.
(defun error (&rest args)
"Signal an error, making a message by passing ARGS to `format-message'.
@@ -920,6 +928,7 @@ For an approximate inverse of this, see `key-description'."
(defun undefined ()
"Beep to tell the user this binding is undefined."
+ (declare (completion #'ignore))
(interactive)
(ding)
(if defining-kbd-macro
@@ -1303,6 +1312,7 @@ in a cleaner way with command remapping, like this:
(define-key map "l" #'downcase-word)
(define-key map "c" #'capitalize-word)
(define-key map "x" #'execute-extended-command)
+ (define-key map "X" #'execute-extended-command-for-buffer)
map)
"Default keymap for ESC (meta) commands.
The normal global definition of the character ESC indirects to this keymap.")
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index a22cd97..301f701 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -3327,7 +3327,7 @@ Use `bibtex-summary-function' to generate summary."
(message "%s %s" key summary))))))
(defun bibtex-copy-summary-as-kill (&optional arg)
- "Push summery of current BibTeX entry to kill ring.
+ "Push summary of current BibTeX entry to kill ring.
Use `bibtex-summary-function' to generate summary.
If prefix ARG is non-nil push BibTeX entry's URL to kill ring
that is generated by calling `bibtex-url'."
diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el
index ea35641..04778ee 100644
--- a/lisp/textmodes/texnfo-upd.el
+++ b/lisp/textmodes/texnfo-upd.el
@@ -1033,7 +1033,7 @@ However, there does not need to be a title field."
(save-excursion
;; `master-menu-inserted-p' is a kludge to tell
- ;; whether to insert @end detailmenu (see bleow)
+ ;; whether to insert @end detailmenu (see below)
(let (master-menu-inserted-p)
;; Handle top of menu
(insert "\n@menu\n")
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 8cebd4e..e3c1786 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1292,7 +1292,7 @@ passing it an updated value of CBARGS as arguments. The
first
element in CBARGS should be a plist describing what has happened
so far during the request, as described in the docstring of
`url-retrieve' (if in doubt, specify nil). The current buffer
-then CALLBACK is executed is the retrieval buffer.
+when CALLBACK is executed is the retrieval buffer.
Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a
previous `url-http' call, which is being re-attempted.
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 9ef2da7..2548fa4 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -255,6 +255,7 @@ bit output with no translation."
(w32-add-charset-info "iso8859-2" 'w32-charset-easteurope 28592)
(w32-add-charset-info "iso8859-3" 'w32-charset-turkish 28593)
(w32-add-charset-info "iso8859-4" 'w32-charset-baltic 28594)
+ (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595)
(w32-add-charset-info "iso8859-6" 'w32-charset-arabic 28596)
(w32-add-charset-info "iso8859-7" 'w32-charset-greek 28597)
(w32-add-charset-info "iso8859-8" 'w32-charset-hebrew 1255)
diff --git a/lisp/wdired.el b/lisp/wdired.el
index a096abd..3829ff1 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -169,9 +169,9 @@ nonexistent directory will fail."
(define-key map "\C-c\C-k" 'wdired-abort-changes)
(define-key map "\C-c\C-[" 'wdired-abort-changes)
(define-key map "\C-x\C-q" 'wdired-exit)
- (define-key map "\C-m" 'ignore)
- (define-key map "\C-j" 'ignore)
- (define-key map "\C-o" 'ignore)
+ (define-key map "\C-m" 'undefined)
+ (define-key map "\C-j" 'undefined)
+ (define-key map "\C-o" 'undefined)
(define-key map [up] 'wdired-previous-line)
(define-key map "\C-p" 'wdired-previous-line)
(define-key map [down] 'wdired-next-line)
diff --git a/lisp/woman.el b/lisp/woman.el
index 9a03d30..d4f7e8c 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -69,13 +69,7 @@
;; Recommended use
;; ===============
-;; Put this in your .emacs:
-;; (autoload 'woman "woman"
-;; "Decode and browse a UN*X man page." t)
-;; (autoload 'woman-find-file "woman"
-;; "Find, decode and browse a specific UN*X man-page file." t)
-
-;; Then either (1 -- *RECOMMENDED*): If the `MANPATH' environment
+;; Either (1 -- *RECOMMENDED*): If the `MANPATH' environment
;; variable is set then WoMan will use it; otherwise you may need to
;; reset the Lisp variable `woman-manpath', and you may also want to
;; set the Lisp variable `woman-path'. Please see the online
@@ -139,14 +133,8 @@
;; ==============================
;; WoMan supports the GNU Emacs customization facility, and puts
-;; a customization group called `WoMan' in the `Help' group under the
-;; top-level `Emacs' group. In order to be able to customize WoMan
-;; without first loading it, add the following sexp to your .emacs:
-
-;; (defgroup woman nil
-;; "Browse UNIX manual pages `wo (without) man'."
-;; :tag "WoMan" :group 'help :load "woman")
-
+;; a customization group called `woman' in the `help' group under the
+;; top-level `emacs' group.
;; WoMan currently runs two hooks: `woman-pre-format-hook' immediately
;; before formatting a buffer and `woman-post-format-hook' immediately
@@ -1868,13 +1856,15 @@ Argument EVENT is the invoking mouse event."
(defvar bookmark-make-record-function)
-(define-derived-mode woman-mode special-mode "WoMan"
+(define-derived-mode woman-mode man-common "WoMan"
"Turn on (most of) Man mode to browse a buffer formatted by WoMan.
WoMan is an ELisp emulation of much of the functionality of the Emacs
`man' command running the standard UN*X man and ?roff programs.
WoMan author: F.J.Wright@Maths.QMW.ac.uk
See `Man-mode' for additional details.
\\{woman-mode-map}"
+ ;; FIXME: Should all this just be re-arranged so that this can just
+ ;; inherit `man-common' and be done with it?
(let ((Man-build-page-list (symbol-function 'Man-build-page-list))
(Man-strip-page-headers (symbol-function 'Man-strip-page-headers))
(Man-unindent (symbol-function 'Man-unindent))
diff --git a/src/alloc.c b/src/alloc.c
index 0ed5b93..af08336 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3519,6 +3519,38 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH
&optional DOCSTRING INT
return val;
}
+DEFUN ("make-closure", Fmake_closure, Smake_closure, 1, MANY, 0,
+ doc: /* Create a byte-code closure from PROTOTYPE and CLOSURE-VARS.
+Return a copy of PROTOTYPE, a byte-code object, with CLOSURE-VARS
+replacing the elements in the beginning of the constant-vector.
+usage: (make-closure PROTOTYPE &rest CLOSURE-VARS) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ Lisp_Object protofun = args[0];
+ CHECK_TYPE (COMPILEDP (protofun), Qbyte_code_function_p, protofun);
+
+ /* Create a copy of the constant vector, filling it with the closure
+ variables in the beginning. (The overwritten part should just
+ contain placeholder values.) */
+ Lisp_Object proto_constvec = AREF (protofun, COMPILED_CONSTANTS);
+ ptrdiff_t constsize = ASIZE (proto_constvec);
+ ptrdiff_t nvars = nargs - 1;
+ if (nvars > constsize)
+ error ("Closure vars do not fit in constvec");
+ Lisp_Object constvec = make_uninit_vector (constsize);
+ memcpy (XVECTOR (constvec)->contents, args + 1, nvars * word_size);
+ memcpy (XVECTOR (constvec)->contents + nvars,
+ XVECTOR (proto_constvec)->contents + nvars,
+ (constsize - nvars) * word_size);
+
+ /* Return a copy of the prototype function with the new constant vector. */
+ ptrdiff_t protosize = PVSIZE (protofun);
+ struct Lisp_Vector *v = allocate_vectorlike (protosize, false);
+ v->header = XVECTOR (protofun)->header;
+ memcpy (v->contents, XVECTOR (protofun)->contents, protosize * word_size);
+ v->contents[COMPILED_CONSTANTS] = constvec;
+ return make_lisp_ptr (v, Lisp_Vectorlike);
+}
/***********************************************************************
@@ -7605,6 +7637,7 @@ N should be nonnegative. */);
defsubr (&Srecord);
defsubr (&Sbool_vector);
defsubr (&Smake_byte_code);
+ defsubr (&Smake_closure);
defsubr (&Smake_list);
defsubr (&Smake_vector);
defsubr (&Smake_record);
diff --git a/src/callproc.c b/src/callproc.c
index cb72b07..cd0f67f 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -411,7 +411,11 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
/* If the buffer is (still) a list, it might be a (:file "file") spec. */
if (CONSP (buffer) && EQ (XCAR (buffer), QCfile))
{
- output_file = Fexpand_file_name (XCAR (XCDR (buffer)),
+ Lisp_Object ofile = XCDR (buffer);
+ if (CONSP (ofile))
+ ofile = XCAR (ofile);
+ CHECK_STRING (ofile);
+ output_file = Fexpand_file_name (ofile,
BVAR (current_buffer, directory));
CHECK_STRING (output_file);
buffer = Qnil;
diff --git a/src/data.c b/src/data.c
index 5177a7c..50d4374 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1031,9 +1031,17 @@ The value, if non-nil, is a list of mode name symbols.
*/)
if (NILP (fun))
return Qnil;
+ /* Use a `command-modes' property if present, analogous to the
+ function-documentation property. */
fun = command;
while (SYMBOLP (fun))
- fun = Fsymbol_function (fun);
+ {
+ Lisp_Object modes = Fget (fun, Qcommand_modes);
+ if (!NILP (modes))
+ return modes;
+ else
+ fun = Fsymbol_function (fun);
+ }
if (COMPILEDP (fun))
{
@@ -4056,6 +4064,8 @@ syms_of_data (void)
DEFSYM (Qinteractive_form, "interactive-form");
DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
+ DEFSYM (Qbyte_code_function_p, "byte-code-function-p");
+
defsubr (&Sindirect_variable);
defsubr (&Sinteractive_form);
defsubr (&Scommand_modes);
diff --git a/src/dispnew.c b/src/dispnew.c
index e603c67..b3e4587 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -3328,7 +3328,7 @@ update_frame_with_menu (struct frame *f, int row, int col)
}
/* Update the mouse position for a frame F. This handles both
- updating the display for mouse-face propreties and updating the
+ updating the display for mouse-face properties and updating the
help echo text.
Returns the number of events generated. */
diff --git a/src/font.c b/src/font.c
index a59ebe2..7c1d1ff 100644
--- a/src/font.c
+++ b/src/font.c
@@ -4122,7 +4122,7 @@ representing the OpenType features supported by the font
by this form:
SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
Layout tags.
-In addition to the keys listed abobe, the following keys are reserved
+In addition to the keys listed above, the following keys are reserved
for the specific meanings as below:
The value of :combining-capability is non-nil if the font-backend of
diff --git a/src/indent.c b/src/indent.c
index 0a6b460..6246b54 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1315,7 +1315,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte,
EMACS_INT fromvpos,
j ^---- next after the point
^--- next char. after the point.
----------
- In case of sigle-column character
+ In case of single-column character
----------
abcdefgh\\
diff --git a/src/nsterm.m b/src/nsterm.m
index b0cf595..88317f8 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -8377,6 +8377,11 @@ not_in_argv (NSString *arg)
surface = [[EmacsSurface alloc] initWithSize:s
ColorSpace:[[[self window] colorSpace]
CGColorSpace]];
+
+ /* Since we're using NSViewLayerContentsRedrawOnSetNeedsDisplay
+ the layer's scale factor is not set automatically, so do it
+ now. */
+ [[self layer] setContentsScale:[[self window] backingScaleFactor]];
}
CGContextRef context = [surface getContext];
@@ -9762,7 +9767,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
for (id object in cache)
CFRelease ((IOSurfaceRef)object);
- [cache removeAllObjects];
+ [cache release];
[super dealloc];
}
diff --git a/src/process.c b/src/process.c
index 3beb9cf..b98bc29 100644
--- a/src/process.c
+++ b/src/process.c
@@ -8255,7 +8255,7 @@ init_process_emacs (int sockfd)
private SIGCHLD handler, allowing catch_child_signal to copy
it into lib_child_handler.
- Unfortunatly in glib commit 2e471acf, the behavior changed to
+ Unfortunately in glib commit 2e471acf, the behavior changed to
always install a signal handler when g_child_watch_source_new
is called and not just the first time it's called. Glib also
now resets signal handlers to SIG_DFL when it no longer has a
diff --git a/src/w32.c b/src/w32.c
index 202acb7..96eba1e 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -346,6 +346,7 @@ static BOOL g_b_init_get_adapters_addresses;
static BOOL g_b_init_reg_open_key_ex_w;
static BOOL g_b_init_reg_query_value_ex_w;
static BOOL g_b_init_expand_environment_strings_w;
+static BOOL g_b_init_get_user_default_ui_language;
BOOL g_b_init_compare_string_w;
BOOL g_b_init_debug_break_process;
@@ -533,6 +534,7 @@ DWORD multiByteToWideCharFlags;
typedef LONG (WINAPI *RegOpenKeyExW_Proc) (HKEY,LPCWSTR,DWORD,REGSAM,PHKEY);
typedef LONG (WINAPI *RegQueryValueExW_Proc)
(HKEY,LPCWSTR,LPDWORD,LPDWORD,LPBYTE,LPDWORD);
typedef DWORD (WINAPI *ExpandEnvironmentStringsW_Proc) (LPCWSTR,LPWSTR,DWORD);
+typedef LANGID (WINAPI *GetUserDefaultUILanguage_Proc) (void);
/* ** A utility function ** */
static BOOL
@@ -1489,6 +1491,28 @@ expand_environment_strings_w (LPCWSTR lpSrc, LPWSTR
lpDst, DWORD nSize)
return s_pfn_Expand_Environment_Strings_w (lpSrc, lpDst, nSize);
}
+static LANGID WINAPI
+get_user_default_ui_language (void)
+{
+ static GetUserDefaultUILanguage_Proc s_pfn_GetUserDefaultUILanguage = NULL;
+ HMODULE hm_kernel32 = NULL;
+
+ if (is_windows_9x () == TRUE)
+ return 0;
+
+ if (g_b_init_get_user_default_ui_language == 0)
+ {
+ g_b_init_get_user_default_ui_language = 1;
+ hm_kernel32 = LoadLibrary ("Kernel32.dll");
+ if (hm_kernel32)
+ s_pfn_GetUserDefaultUILanguage = (GetUserDefaultUILanguage_Proc)
+ get_proc_addr (hm_kernel32, "GetUserDefaultUILanguage");
+ }
+ if (s_pfn_GetUserDefaultUILanguage == NULL)
+ return 0;
+ return s_pfn_GetUserDefaultUILanguage ();
+}
+
/* Return 1 if P is a valid pointer to an object of size SIZE. Return
@@ -2947,6 +2971,32 @@ init_environment (char ** argv)
LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
locale_name, sizeof (locale_name)))
{
+ /* Microsoft are migrating away of locale IDs, replacing them
+ with locale names, such as "en-US", and are therefore
+ deprecating the APIs which use LCID etc. As part of that
+ deprecation, they don't bother inventing LCID and LANGID
+ codes for new locales and language/culture combinations;
+ instead, those get LCID of 0xC000 and LANGID of 0x2000, for
+ which the LCID/LANGID oriented APIs return "ZZZ" as the
+ "language name". Such "language name" is useless for our
+ purposes. So we instead use the default UI language, in the
+ hope of getting something usable. */
+ if (strcmp (locale_name, "ZZZ") == 0)
+ {
+ LANGID lang_id = get_user_default_ui_language ();
+
+ if (lang_id != 0)
+ {
+ /* Disregard the sorting order differences between cultures. */
+ LCID def_lcid = MAKELCID (lang_id, SORT_DEFAULT);
+ char locale_name_def[32];
+
+ if (GetLocaleInfo (def_lcid,
+ LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
+ locale_name_def, sizeof (locale_name_def)))
+ strcpy (locale_name, locale_name_def);
+ }
+ }
for (i = 0; i < N_ENV_VARS; i++)
{
if (strcmp (env_vars[i].name, "LANG") == 0)
@@ -10580,6 +10630,7 @@ globals_of_w32 (void)
g_b_init_expand_environment_strings_w = 0;
g_b_init_compare_string_w = 0;
g_b_init_debug_break_process = 0;
+ g_b_init_get_user_default_ui_language = 0;
num_of_processors = 0;
/* The following sets a handler for shutdown notifications for
console apps. This actually applies to Emacs in both console and
diff --git a/src/w32fns.c b/src/w32fns.c
index 86c3db6..9db367b 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -3893,7 +3893,7 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg,
UINT wParam,
Essentially, we have no information about the "role" of
modifiers on this key: which contribute into the
produced character (so "are consumed"), and which are
- "extra" (must attache to bindable events).
+ "extra" (must attach to bindable events).
The default above would consume ALL modifiers, so the
character is reported "as is". However, on many layouts
diff --git a/test/Makefile.in b/test/Makefile.in
index 3b6c18d..c7501fa 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -72,6 +72,15 @@ am__v_at_1 =
HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@
+# Load any GNU ELPA dependencies that are present, for optional tests.
+GNU_ELPA_DIRECTORY ?= $(srcdir)/../../elpa
+# Keep elpa_dependencies dependency-ordered.
+elpa_dependencies = \
+ url-http-ntlm/url-http-ntlm.el \
+ web-server/web-server.el
+elpa_els = $(addprefix $(GNU_ELPA_DIRECTORY)/packages/,$(elpa_dependencies))
+elpa_opts = $(foreach el,$(elpa_els),$(and $(wildcard $(el)),-L $(dir $(el))
-l $(el)))
+
# We never change directory before running Emacs, so a relative file
# name is fine, and makes life easier. If we need to change
# directory, we can use emacs --chdir.
@@ -82,7 +91,7 @@ EMACS_EXTRAOPT=
# Command line flags for Emacs.
# Apparently MSYS bash would convert "-L :" to "-L ;" anyway,
# but we might as well be explicit.
-EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L
"$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT)
+EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L
"$(SEPCHAR)$(srcdir)" $(elpa_opts) $(EMACS_EXTRAOPT)
# Prevent any settings in the user environment causing problems.
unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS
@@ -106,7 +115,7 @@ export TEST_LOAD_EL ?= \
$(if $(findstring $(MAKECMDGOALS), all check check-maybe),no,yes)
# Additional settings for ert.
-ert_opts =
+ert_opts += $(elpa_opts)
# Maximum length of lines in ert backtraces; nil for no limit.
# (if empty, use the default ert-batch-backtrace-right-margin).
@@ -255,7 +264,7 @@ endef
$(foreach test,${TESTS},$(eval $(call test_template,${test})))
## Get the tests for only a specific directory.
-SUBDIRS = $(sort $(shell find lib-src lisp src -type d ! -path "*resources*"
-print))
+SUBDIRS = $(sort $(shell find lib-src lisp misc src -type d ! -path
"*resources*" -print))
define subdir_template
.PHONY: check-$(subst /,-,$(1))
diff --git a/test/README b/test/README
index 5f3c10a..1e0e43a 100644
--- a/test/README
+++ b/test/README
@@ -106,8 +106,13 @@ tramp-tests.el). Per default, a mock-up connection method
is used
to test a real remote connection, set $REMOTE_TEMPORARY_FILE_DIRECTORY
to a suitable value in order to overwrite the default value:
- env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ...
+ env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ...
+Some optional tests require packages from GNU ELPA. By default
+../../elpa will be checked for these packages. If GNU ELPA is checked
+out somewhere else, use
+
+ make GNU_ELPA_DIRECTORY=/path/to/elpa ...
There are also continuous integration tests on
<https://hydra.nixos.org/jobset/gnu/emacs-trunk> (see
diff --git a/test/file-organization.org b/test/file-organization.org
index 7cf5b88..d1f92da 100644
--- a/test/file-organization.org
+++ b/test/file-organization.org
@@ -43,6 +43,10 @@ Similarly, tests of features implemented in C should reside
in
~-tests.el~ added to the base-name of the tested source file. Thus,
tests for ~src/fileio.c~ should be in ~test/src/fileio-tests.el~.
+Some tests do not belong to any one particular file. Such tests
+should be put in the ~misc~ directory and be given a descriptive name
+that does /not/ end with ~-tests.el~.
+
There are also some test materials that cannot be run automatically
(i.e. via ert). These should be placed in ~/test/manual~; they are
not run by the "make check" command and its derivatives.
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el
index 10854c7..09f79c1 100644
--- a/test/lisp/custom-tests.el
+++ b/test/lisp/custom-tests.el
@@ -145,17 +145,6 @@
(widget-apply field :value-to-internal
origvalue)
"bar"))))))
-(defconst custom-test-admin-cus-test
- (expand-file-name "admin/cus-test.el" source-directory))
-
-(declare-function cus-test-opts custom-test-admin-cus-test)
-
-(ert-deftest check-for-wrong-custom-types ()
- :tags '(:expensive-test)
- (skip-unless (file-readable-p custom-test-admin-cus-test))
- (load custom-test-admin-cus-test)
- (should (null (cus-test-opts t))))
-
(ert-deftest custom-test-enable-theme-keeps-settings ()
"Test that enabling a theme doesn't change its settings."
(let* ((custom-theme-load-path `(,(ert-resource-directory)))
diff --git a/test/lisp/emacs-lisp/edebug-tests.el
b/test/lisp/emacs-lisp/edebug-tests.el
index daac433..dcb261c 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -219,16 +219,16 @@ index."
(with-current-buffer (find-file-noselect edebug-tests-temp-file)
(setq saved-local-map overriding-local-map)
(setq overriding-local-map edebug-tests-keymap)
- (add-hook 'post-command-hook 'edebug-tests-post-command))
+ (add-hook 'post-command-hook #'edebug-tests-post-command))
(advice-add 'exit-recursive-edit
- :around 'edebug-tests-preserve-keyboard-macro-state)
+ :around #'edebug-tests-preserve-keyboard-macro-state)
(unwind-protect
(kmacro-call-macro nil nil nil kbdmac)
(advice-remove 'exit-recursive-edit
- 'edebug-tests-preserve-keyboard-macro-state)
+ #'edebug-tests-preserve-keyboard-macro-state)
(with-current-buffer (find-file-noselect edebug-tests-temp-file)
(setq overriding-local-map saved-local-map)
- (remove-hook 'post-command-hook 'edebug-tests-post-command)))))
+ (remove-hook 'post-command-hook #'edebug-tests-post-command)))))
(defun edebug-tests-preserve-keyboard-macro-state (orig &rest args)
"Call ORIG with ARGS preserving the value of `executing-kbd-macro'.
@@ -857,12 +857,14 @@ test and possibly others should be updated."
(ert-deftest edebug-tests-trivial-backquote ()
"Edebug can instrument a trivial backquote expression (Bug#23651)."
(edebug-tests-with-normal-env
- (read-only-mode -1)
- (delete-region (point-min) (point-max))
- (insert "`1")
- (read-only-mode)
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max))
+ (insert "`1"))
(edebug-eval-defun nil)
- (should (string-match-p (regexp-quote "1 (#o1, #x1, ?\\C-a)")
+ ;; `eval-defun' outputs its message to the echo area in a rather
+ ;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed
+ ;; there in separate pieces (via `print' rather than via `message').
+ (should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)")
edebug-tests-messages))
(setq edebug-tests-messages "")
@@ -912,13 +914,17 @@ test and possibly others should be updated."
(ert-deftest edebug-tests-cl-macrolet ()
"Edebug can instrument `cl-macrolet' expressions. (Bug#29919)"
(edebug-tests-with-normal-env
- (edebug-tests-setup-@ "use-cl-macrolet" '(10) t)
+ (edebug-tests-locate-def "use-cl-macrolet")
(edebug-tests-run-kbd-macro
- "@ SPC SPC"
+ "C-u C-M-x SPC"
(edebug-tests-should-be-at "use-cl-macrolet" "func")
- (edebug-tests-should-match-result-in-messages "+")
- "g"
- (should (equal edebug-tests-@-result "The result of applying + to (1 x) is
11")))))
+ (edebug-tests-should-match-result-in-messages "+"))
+ (let ((edebug-initial-mode 'Go-nonstop))
+ (edebug-tests-setup-@ "use-cl-macrolet" '(10) t))
+ (edebug-tests-run-kbd-macro
+ "@ SPC g"
+ (should (equal edebug-tests-@-result "The result of applying + to (1 x) is
11"))
+ )))
(ert-deftest edebug-tests-backtrace-goto-source ()
"Edebug can jump to instrumented source from its *Edebug-Backtrace* buffer."
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 63d7c7b..12bf4f7 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -388,6 +388,8 @@
(ert-deftest rx-regexp ()
(should (equal (rx (regexp "abc") (regex "[de]"))
"\\(?:abc\\)[de]"))
+ (should (equal (rx "a" (regexp "$"))
+ "a\\(?:$\\)"))
(let ((x "a*"))
(should (equal (rx (regexp x) "b")
"\\(?:a*\\)b"))
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el
index 11b61d8..9886dc0 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -421,12 +421,21 @@ Point is moved to beginning of the buffer."
"\"\\nasdфыв\\u001f\u007ffgh\\t\"")))
(ert-deftest test-json-encode-key ()
- (should (equal (json-encode-key "") "\"\""))
(should (equal (json-encode-key '##) "\"\""))
(should (equal (json-encode-key :) "\"\""))
- (should (equal (json-encode-key "foo") "\"foo\""))
- (should (equal (json-encode-key 'foo) "\"foo\""))
- (should (equal (json-encode-key :foo) "\"foo\""))
+ (should (equal (json-encode-key "") "\"\""))
+ (should (equal (json-encode-key 'a) "\"a\""))
+ (should (equal (json-encode-key :a) "\"a\""))
+ (should (equal (json-encode-key "a") "\"a\""))
+ (should (equal (json-encode-key t) "\"t\""))
+ (should (equal (json-encode-key :t) "\"t\""))
+ (should (equal (json-encode-key "t") "\"t\""))
+ (should (equal (json-encode-key nil) "\"nil\""))
+ (should (equal (json-encode-key :nil) "\"nil\""))
+ (should (equal (json-encode-key "nil") "\"nil\""))
+ (should (equal (json-encode-key ":a") "\":a\""))
+ (should (equal (json-encode-key ":t") "\":t\""))
+ (should (equal (json-encode-key ":nil") "\":nil\""))
(should (equal (should-error (json-encode-key 5))
'(json-key-format 5)))
(should (equal (should-error (json-encode-key ["foo"]))
@@ -572,6 +581,39 @@ Point is moved to beginning of the buffer."
(should (equal (json-encode-hash-table #s(hash-table)) "{}"))
(should (equal (json-encode-hash-table #s(hash-table data (a 1)))
"{\"a\":1}"))
+ (should (equal (json-encode-hash-table #s(hash-table data (t 1)))
+ "{\"t\":1}"))
+ (should (equal (json-encode-hash-table #s(hash-table data (nil 1)))
+ "{\"nil\":1}"))
+ (should (equal (json-encode-hash-table #s(hash-table data (:a 1)))
+ "{\"a\":1}"))
+ (should (equal (json-encode-hash-table #s(hash-table data (:t 1)))
+ "{\"t\":1}"))
+ (should (equal (json-encode-hash-table #s(hash-table data (:nil 1)))
+ "{\"nil\":1}"))
+ (should (equal (json-encode-hash-table
+ #s(hash-table test equal data ("a" 1)))
+ "{\"a\":1}"))
+ (should (equal (json-encode-hash-table
+ #s(hash-table test equal data ("t" 1)))
+ "{\"t\":1}"))
+ (should (equal (json-encode-hash-table
+ #s(hash-table test equal data ("nil" 1)))
+ "{\"nil\":1}"))
+ (should (equal (json-encode-hash-table
+ #s(hash-table test equal data (":a" 1)))
+ "{\":a\":1}"))
+ (should (equal (json-encode-hash-table
+ #s(hash-table test equal data (":t" 1)))
+ "{\":t\":1}"))
+ (should (equal (json-encode-hash-table
+ #s(hash-table test equal data (":nil" 1)))
+ "{\":nil\":1}"))
+ (should (member (json-encode-hash-table #s(hash-table data (t 2 :nil 1)))
+ '("{\"nil\":1,\"t\":2}" "{\"t\":2,\"nil\":1}")))
+ (should (member (json-encode-hash-table
+ #s(hash-table test equal data (:t 2 ":t" 1)))
+ '("{\":t\":1,\"t\":2}" "{\"t\":2,\":t\":1}")))
(should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
'("{\"a\":1,\"b\":2}" "{\"b\":2,\"a\":1}")))
(should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1)))
@@ -638,7 +680,16 @@ Point is moved to beginning of the buffer."
(let ((json-encoding-object-sort-predicate nil)
(json-encoding-pretty-print nil))
(should (equal (json-encode-alist ()) "{}"))
- (should (equal (json-encode-alist '((a . 1))) "{\"a\":1}"))
+ (should (equal (json-encode-alist '((a . 1) (t . 2) (nil . 3)))
+ "{\"a\":1,\"t\":2,\"nil\":3}"))
+ (should (equal (json-encode-alist '((:a . 1) (:t . 2) (:nil . 3)))
+ "{\"a\":1,\"t\":2,\"nil\":3}"))
+ (should (equal (json-encode-alist '(("a" . 1) ("t" . 2) ("nil" . 3)))
+ "{\"a\":1,\"t\":2,\"nil\":3}"))
+ (should (equal (json-encode-alist '((":a" . 1) (":t" . 2) (":nil" . 3)))
+ "{\":a\":1,\":t\":2,\":nil\":3}"))
+ (should (equal (json-encode-alist '((t . 1) (:nil . 2) (":nil" . 3)))
+ "{\"t\":1,\"nil\":2,\":nil\":3}"))
(should (equal (json-encode-alist '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}"))
(should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1)))
"{\"c\":3,\"b\":2,\"a\":1}"))))
@@ -687,8 +738,14 @@ Point is moved to beginning of the buffer."
(should (equal (json-encode-plist ()) "{}"))
(should (equal (json-encode-plist '(:a 1)) "{\"a\":1}"))
(should (equal (json-encode-plist '(:b 2 :a 1)) "{\"b\":2,\"a\":1}"))
- (should (equal (json-encode-plist '(:c 3 :b 2 :a 1))
- "{\"c\":3,\"b\":2,\"a\":1}"))))
+ (should (equal (json-encode-plist '(":d" 4 "c" 3 b 2 :a 1))
+ "{\":d\":4,\"c\":3,\"b\":2,\"a\":1}"))
+ (should (equal (json-encode-plist '(nil 2 t 1))
+ "{\"nil\":2,\"t\":1}"))
+ (should (equal (json-encode-plist '(:nil 2 :t 1))
+ "{\"nil\":2,\"t\":1}"))
+ (should (equal (json-encode-plist '(":nil" 4 "nil" 3 ":t" 2 "t" 1))
+ "{\":nil\":4,\"nil\":3,\":t\":2,\"t\":1}"))))
(ert-deftest test-json-encode-plist-pretty ()
(let ((json-encoding-object-sort-predicate nil)
@@ -950,7 +1007,13 @@ nil, ORIGINAL should stay unchanged by pretty-printing."
;; Nested array.
(json-tests-equal-pretty-print
"{\"key\":[1,2]}"
- "{\n \"key\": [\n 1,\n 2\n ]\n}"))
+ "{\n \"key\": [\n 1,\n 2\n ]\n}")
+ ;; Confusable keys (bug#24252, bug#42545).
+ (json-tests-equal-pretty-print
+ (concat "{\"t\":1,\"nil\":2,\":t\":3,\":nil\":4,"
+ "\"null\":5,\":json-null\":6,\":json-false\":7}")
+ (concat "{\n \"t\": 1,\n \"nil\": 2,\n \":t\": 3,\n \":nil\": 4,"
+ "\n \"null\": 5,\n \":json-null\": 6,\n \":json-false\": 7\n}")))
(ert-deftest test-json-pretty-print-array ()
;; Empty.
diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el
index ea340c3..92306d1 100644
--- a/test/lisp/jsonrpc-tests.el
+++ b/test/lisp/jsonrpc-tests.el
@@ -244,7 +244,7 @@
:timeout 1)
;; Wait another 0.5 secs just in case the success handlers of
;; one of these last two requests didn't quite have a chance to
- ;; run (Emacs 25.2 apparentely needs this).
+ ;; run (Emacs 25.2 apparently needs this).
(accept-process-output nil 0.5)
(should second-deferred-went-through-p)
(should (eq 1 n-deferred-1))
diff --git a/test/lisp/net/ntlm-resources/authinfo
b/test/lisp/net/ntlm-resources/authinfo
new file mode 100644
index 0000000..698391e
--- /dev/null
+++ b/test/lisp/net/ntlm-resources/authinfo
@@ -0,0 +1 @@
+machine localhost port http user ntlm password ntlm
diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el
index 6408ac1..2420b3b 100644
--- a/test/lisp/net/ntlm-tests.el
+++ b/test/lisp/net/ntlm-tests.el
@@ -17,11 +17,26 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+;;; Commentary:
+
+;; Run this with `NTLM_TESTS_VERBOSE=1' to get verbose debugging.
+
+;;; Code:
+
(require 'ert)
+(require 'ert-x)
(require 'ntlm)
+(defsubst ntlm-tests-message (format-string &rest arguments)
+ "Print a message conditional on an environment variable being set.
+FORMAT-STRING and ARGUMENTS are passed to the message function."
+ (when (getenv "NTLM_TESTS_VERBOSE")
+ (apply #'message (concat "ntlm-tests: " format-string) arguments)))
+
+
;; This is the Lisp bignum implementation of `ntlm--time-to-timestamp',
;; for reference.
+
(defun ntlm-tests--time-to-timestamp (time)
"Convert TIME to an NTLMv2 timestamp.
Return a unibyte string representing the number of tenths of a
@@ -49,4 +64,357 @@ signed integer. TIME must be on the form (HIGH LOW USEC
PSEC)."
(should (equal (ntlm--time-to-timestamp time)
(ntlm-tests--time-to-timestamp time)))))
+(defvar ntlm-tests--username-oem "ntlm"
+ "The username for NTLM authentication tests, in OEM string encoding.")
+(defvar ntlm-tests--username-unicode
+ (ntlm-ascii2unicode ntlm-tests--username-oem
+ (length ntlm-tests--username-oem))
+ "The username for NTLM authentication tests, in Unicode string encoding.")
+
+(defvar ntlm-tests--password "ntlm"
+ "The password used for NTLM authentication tests.")
+
+(defvar ntlm-tests--client-supports-unicode nil
+ "Non-nil if client supports Unicode strings.
+If client only supports OEM strings, nil.")
+
+(defvar ntlm-tests--challenge nil "The global random challenge.")
+
+(defun ntlm-server-build-type-2 ()
+ "Return an NTLM Type 2 message as a string.
+This string will be returned from the NTLM server to the NTLM client."
+ (let ((target (if ntlm-tests--client-supports-unicode
+ (ntlm-ascii2unicode "DOMAIN" (length "DOMAIN"))
+ "DOMAIN"))
+ (target-information ntlm-tests--password)
+ ;; Flag byte 1 flags.
+ (_negotiate-unicode 1)
+ (negotiate-oem 2)
+ (request-target 4)
+ ;; Flag byte 2 flags.
+ (negotiate-ntlm 2)
+ (_negotiate-local-call 4)
+ (_negotiate-always-sign 8)
+ ;; Flag byte 3 flags.
+ (_target-type-domain 1)
+ (_target-type-server 2)
+ (target-type-share 4)
+ (_negotiate-ntlm2-key 8)
+ (negotiate-target-information 128)
+ ;; Flag byte 4 flags, unused.
+ (_negotiate-128 32)
+ (_negotiate-56 128))
+ (concat
+ ;; Signature.
+ "NTLMSSP" (unibyte-string 0)
+ ;; Type 2.
+ (unibyte-string 2 0 0 0)
+ ;; Target length
+ (unibyte-string (length target) 0)
+ ;; Target allocated space.
+ (unibyte-string (length target) 0)
+ ;; Target offset.
+ (unibyte-string 48 0 0 0)
+ ;; Flags.
+ ;; Flag byte 1.
+ ;; Tell the client that this test server only supports OEM
+ ;; strings. This test server will handle Unicode strings
+ ;; anyway though.
+ (unibyte-string (logior negotiate-oem request-target))
+ ;; Flag byte 2.
+ (unibyte-string negotiate-ntlm)
+ ;; Flag byte 3.
+ (unibyte-string (logior negotiate-target-information target-type-share))
+ ;; Flag byte 4. Not sure what 2 means here.
+ (unibyte-string 2)
+ ;; Challenge. Set this to (unibyte-string 1 2 3 4 5 6 7 8)
+ ;; instead of (ntlm-generate-nonce) to hold constant for
+ ;; debugging.
+ (setq ntlm-tests--challenge (ntlm-generate-nonce))
+ ;; Context.
+ (make-string 8 0)
+ (unibyte-string (length target-information) 0)
+ (unibyte-string (length target-information) 0)
+ (unibyte-string 54 0 0 0)
+ target
+ target-information)))
+
+(defun ntlm-server-hash (challenge blob username password)
+ "Hash CHALLENGE, BLOB, USERNAME and PASSWORD for a Type 3 check."
+ (hmac-md5 (concat challenge blob)
+ (hmac-md5 (concat
+ (upcase
+ ;; This calculation always uses
+ ;; Unicode username, even when the
+ ;; server only supports OEM strings.
+ (ntlm-ascii2unicode username (length username))) "")
+ (cadr (ntlm-get-password-hashes password)))))
+
+(defun ntlm-server-check-authorization (authorization-string)
+ "Return t if AUTHORIZATION-STRING correctly authenticates the user."
+ (let* ((binary (base64-decode-string
+ (caddr (split-string authorization-string " "))))
+ (_lm-response-length (md4-unpack-int16 (substring binary 12 14)))
+ (_lm-response-offset
+ (cdr (md4-unpack-int32 (substring binary 16 20))))
+ (ntlm-response-length (md4-unpack-int16 (substring binary 20 22)))
+ (ntlm-response-offset
+ (cdr (md4-unpack-int32 (substring binary 24 28))))
+ (ntlm-hash
+ (substring binary ntlm-response-offset (+ ntlm-response-offset 16)))
+ (username-length (md4-unpack-int16 (substring binary 36 38)))
+ (username-offset (cdr (md4-unpack-int32 (substring binary 40 44))))
+ (username (substring binary username-offset
+ (+ username-offset username-length))))
+ (if (equal ntlm-response-length 24)
+ (let* ((expected
+ (ntlm-smb-owf-encrypt
+ (cadr (ntlm-get-password-hashes ntlm-tests--password))
+ ntlm-tests--challenge))
+ (received (substring binary ntlm-response-offset
+ (+ ntlm-response-offset
+ ntlm-response-length))))
+ (ntlm-tests-message "Got NTLMv1 response:")
+ (ntlm-tests-message "Expected hash: ===%S===" expected)
+ (ntlm-tests-message "Got hash: ===%S===" received)
+ (ntlm-tests-message "Expected username: ===%S==="
+ ntlm-tests--username-oem)
+ (ntlm-tests-message "Got username: ===%S===" username)
+ (and (or (equal username ntlm-tests--username-oem)
+ (equal username ntlm-tests--username-unicode))
+ (equal expected received)))
+ (let* ((ntlm-response-blob
+ (substring binary (+ ntlm-response-offset 16)
+ (+ (+ ntlm-response-offset 16)
+ (- ntlm-response-length 16))))
+ (_ntlm-timestamp (substring ntlm-response-blob 8 16))
+ (_ntlm-nonce (substring ntlm-response-blob 16 24))
+ (_target-length (md4-unpack-int16 (substring binary 28 30)))
+ (_target-offset
+ (cdr (md4-unpack-int32 (substring binary 32 36))))
+ (_workstation-length (md4-unpack-int16 (substring binary 44 46)))
+ (_workstation-offset
+ (cdr (md4-unpack-int32 (substring binary 48 52)))))
+ (cond
+ ;; This test server claims to only support OEM strings,
+ ;; but also checks Unicode strings.
+ ((or (equal username ntlm-tests--username-oem)
+ (equal username ntlm-tests--username-unicode))
+ (let* ((password ntlm-tests--password)
+ (ntlm-hash-from-type-3 (ntlm-server-hash
+ ntlm-tests--challenge
+ ntlm-response-blob
+ ;; Always -oem since
+ ;; `ntlm-server-hash'
+ ;; always converts it to
+ ;; Unicode.
+ ntlm-tests--username-oem
+ password)))
+ (ntlm-tests-message "Got NTLMv2 response:")
+ (ntlm-tests-message "Expected hash: ==%S==" ntlm-hash)
+ (ntlm-tests-message "Got hash: ==%S==" ntlm-hash-from-type-3)
+ (ntlm-tests-message "Expected username: ===%S==="
+ ntlm-tests--username-oem)
+ (ntlm-tests-message " or username: ===%S==="
+ ntlm-tests--username-unicode)
+ (ntlm-tests-message "Got username: ===%S===" username)
+ (equal ntlm-hash ntlm-hash-from-type-3)))
+ (t
+ nil))))))
+
+(require 'eieio)
+(require 'cl-lib)
+
+;; Silence some byte-compiler warnings that occur when
+;; web-server/web-server.el is not found.
+(declare-function ws-send nil)
+(declare-function ws-parse-request nil)
+(declare-function ws-start nil)
+(declare-function ws-stop-all nil)
+
+(require 'web-server nil t)
+(require 'url-http-ntlm nil t)
+
+(defun ntlm-server-do-token (request _process)
+ "Process an NTLM client's REQUEST.
+PROCESS is unused."
+ (with-slots (process headers) request
+ (let* ((header-alist (cdr headers))
+ (authorization-header (assoc ':AUTHORIZATION header-alist))
+ (authorization-string (cdr authorization-header)))
+ (if (and (stringp authorization-string)
+ (string-match "NTLM " authorization-string))
+ (let* ((challenge (substring authorization-string (match-end 0)))
+ (binary (base64-decode-string challenge))
+ (type (aref binary 8))
+ ;; Flag byte 1 flags.
+ (negotiate-unicode 1)
+ (negotiate-oem 2)
+ (flags-byte-1 (aref binary 12))
+ (client-supports-unicode
+ (not (zerop (logand flags-byte-1 negotiate-unicode))))
+ (client-supports-oem
+ (not (zerop (logand flags-byte-1 negotiate-oem))))
+ (connection-header (assoc ':CONNECTION header-alist))
+ (_keep-alive
+ (when connection-header (cdr connection-header)))
+ (response
+ (cl-case type
+ (1
+ ;; Return Type 2 message.
+ (when (and (not client-supports-unicode)
+ (not client-supports-oem))
+ (warn (concat
+ "Weird client supports neither Unicode"
+ " nor OEM strings, using OEM.")))
+ (setq ntlm-tests--client-supports-unicode
+ client-supports-unicode)
+ (concat
+ "HTTP/1.1 401 Unauthorized\r\n"
+ "WWW-Authenticate: NTLM "
+ (base64-encode-string
+ (ntlm-server-build-type-2) t) "\r\n"
+ "WWW-Authenticate: Negotiate\r\n"
+ "WWW-Authenticate: Basic realm=\"domain\"\r\n"
+ "Content-Length: 0\r\n\r\n"))
+ (3
+ (if (ntlm-server-check-authorization
+ authorization-string)
+ "HTTP/1.1 200 OK\r\n\r\nAuthenticated.\r\n"
+ (progn
+ (if process
+ (set-process-filter process nil)
+ (error "Type 3 message found first?"))
+ (concat "HTTP/1.1 401 Unauthorized\r\n\r\n"
+ "Access Denied.\r\n")))))))
+ (if response
+ (ws-send process response)
+ (when process
+ (set-process-filter process nil)))
+ (when (equal type 3)
+ (set-process-filter process nil)
+ (process-send-eof process)))
+ (progn
+ ;; Did not get NTLM anything.
+ (set-process-filter process nil)
+ (process-send-eof process)
+ (concat "HTTP/1.1 401 Unauthorized\r\n\r\n"
+ "Access Denied.\r\n"))))))
+
+(defun ntlm-server-filter (process string)
+ "Read from PROCESS a STRING and treat it as a request from an NTLM client."
+ (let ((request (make-instance 'ws-request
+ :process process :pending string)))
+ (if (ws-parse-request request)
+ (ntlm-server-do-token request process)
+ (error "Failed to parse request"))))
+
+(defun ntlm-server-handler (request)
+ "Handle an HTTP REQUEST."
+ (with-slots (process headers) request
+ (let* ((header-alist (cdr headers))
+ (authorization-header (assoc ':AUTHORIZATION header-alist))
+ (connection-header (assoc ':CONNECTION header-alist))
+ (keep-alive (when connection-header (cdr connection-header)))
+ (response (concat
+ "HTTP/1.1 401 Unauthorized\r\n"
+ "WWW-Authenticate: Negotiate\r\n"
+ "WWW-Authenticate: NTLM\r\n"
+ "WWW-Authenticate: Basic realm=\"domain\"\r\n"
+ "Content-Length: 0\r\n\r\n")))
+ (if (null authorization-header)
+ ;; Tell client to use NTLM. Firefox will create a new
+ ;; connection.
+ (progn
+ (process-send-string process response)
+ (process-send-eof process))
+ (progn
+ (ntlm-server-do-token request nil)
+ (set-process-filter process #'ntlm-server-filter)
+ (if (equal (upcase keep-alive) "KEEP-ALIVE")
+ :keep-alive
+ (error "NTLM server expects keep-alive connection header")))))))
+
+(defun ntlm-server-start ()
+ "Start an NTLM server on port 8080 for testing."
+ (ws-start 'ntlm-server-handler 8080))
+
+(defun ntlm-server-stop ()
+ "Stop the NTLM server."
+ (ws-stop-all))
+
+(defvar ntlm-tests--result-buffer nil "Final NTLM result buffer.")
+
+(require 'url)
+
+(defun ntlm-tests--url-retrieve-internal-around (original &rest arguments)
+ "Save the result buffer from a `url-retrieve-internal' to a global variable.
+ORIGINAL is the original `url-retrieve-internal' function and
+ARGUMENTS are passed to it."
+ (setq ntlm-tests--result-buffer (apply original arguments)))
+
+(defun ntlm-tests--authenticate ()
+ "Authenticate using credentials from the authinfo resource file."
+ (setq ntlm-tests--result-buffer nil)
+ (let ((auth-sources (list (ert-resource-file "authinfo")))
+ (auth-source-do-cache nil)
+ (auth-source-debug (when (getenv "NTLM_TESTS_VERBOSE") 'trivia)))
+ (ntlm-tests-message "Using auth-sources: %S" auth-sources)
+ (url-retrieve-synchronously "http://localhost:8080";))
+ (sleep-for 0.1)
+ (ntlm-tests-message "Results are in: %S" ntlm-tests--result-buffer)
+ (with-current-buffer ntlm-tests--result-buffer
+ (buffer-string)))
+
+(defun ntlm-tests--start-server-authenticate-stop-server ()
+ "Start an NTLM server, authenticate against it, then stop the server."
+ (advice-add #'url-retrieve-internal
+ :around #'ntlm-tests--url-retrieve-internal-around)
+ (ntlm-server-stop)
+ (ntlm-server-start)
+ (let ((result (ntlm-tests--authenticate)))
+ (advice-remove #'url-retrieve-internal
+ #'ntlm-tests--url-retrieve-internal-around)
+ (ntlm-server-stop)
+ result))
+
+(defvar ntlm-tests--successful-result
+ (concat "HTTP/1.1 200 OK\n\nAuthenticated." (unibyte-string 13) "\n")
+ "Expected result of successful NTLM authentication.")
+
+(require 'find-func)
+(defun ntlm-tests--ensure-ws-parse-ntlm-support ()
+ "Ensure NTLM special-case in `ws-parse'."
+ (let* ((hit (find-function-search-for-symbol
+ 'ws-parse nil (locate-file "web-server.el" load-path)))
+ (buffer (car hit))
+ (position (cdr hit)))
+ (with-current-buffer buffer
+ (goto-char position)
+ (search-forward-regexp
+ ":NTLM" (save-excursion (forward-sexp) (point)) t))))
+
+(require 'lisp-mnt)
+(defvar ntlm-tests--dependencies-present
+ (and (featurep 'url-http-ntlm)
+ (version<= "2.0.4"
+ (lm-version (locate-file "url-http-ntlm.el" load-path)))
+ (featurep 'web-server)
+ (ntlm-tests--ensure-ws-parse-ntlm-support))
+ "Non-nil if GNU ELPA test dependencies were loaded.")
+
+(ert-deftest ntlm-authentication ()
+ "Check ntlm.el's implementation of NTLM authentication over HTTP."
+ (skip-unless ntlm-tests--dependencies-present)
+ (should (equal (ntlm-tests--start-server-authenticate-stop-server)
+ ntlm-tests--successful-result)))
+
+(ert-deftest ntlm-authentication-old-compatibility-level ()
+ (skip-unless ntlm-tests--dependencies-present)
+ (setq ntlm-compatibility-level 0)
+ (should (equal (ntlm-tests--start-server-authenticate-stop-server)
+ ntlm-tests--successful-result)))
+
(provide 'ntlm-tests)
+
+;;; ntlm-tests.el ends here
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index b378ed2..71bdd74 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -21,68 +21,151 @@
;;; Code:
+(require 'ert)
(require 'socks)
(require 'url-http)
-(defvar socks-tests-canned-server-port nil)
+(ert-deftest socks-tests-auth-registration-and-suite-offer ()
+ (ert-info ("Default favors user/pass auth")
+ (should (equal socks-authentication-methods
+ '((2 "Username/Password" . socks-username/password-auth)
+ (0 "No authentication" . identity))))
+ (should (equal "\2\0\2" (socks-build-auth-list)))) ; length [offer ...]
+ (let (socks-authentication-methods)
+ (ert-info ("Empty selection/no methods offered")
+ (should (equal "\0" (socks-build-auth-list))))
+ (ert-info ("Simulate library defaults")
+ (socks-register-authentication-method 0 "No authentication"
+ 'identity)
+ (should (equal socks-authentication-methods
+ '((0 "No authentication" . identity))))
+ (should (equal "\1\0" (socks-build-auth-list)))
+ (socks-register-authentication-method 2 "Username/Password"
+ 'socks-username/password-auth)
+ (should (equal socks-authentication-methods
+ '((2 "Username/Password" . socks-username/password-auth)
+ (0 "No authentication" . identity))))
+ (should (equal "\2\0\2" (socks-build-auth-list))))
+ (ert-info ("Removal")
+ (socks-unregister-authentication-method 2)
+ (should (equal socks-authentication-methods
+ '((0 "No authentication" . identity))))
+ (should (equal "\1\0" (socks-build-auth-list)))
+ (socks-unregister-authentication-method 0)
+ (should-not socks-authentication-methods)
+ (should (equal "\0" (socks-build-auth-list))))))
-(defun socks-tests-canned-server-create (verbatim patterns)
- "Create a fake SOCKS server and return the process.
+(ert-deftest socks-tests-filter-response-parsing-v4 ()
+ "Ensure new chunks added on right (Bug#45162)."
+ (let* ((buf (generate-new-buffer "*test-socks-filter*"))
+ (proc (start-process "test-socks-filter" buf "sleep" "1")))
+ (process-put proc 'socks t)
+ (process-put proc 'socks-state socks-state-waiting)
+ (process-put proc 'socks-server-protocol 4)
+ (ert-info ("Receive initial incomplete segment")
+ (socks-filter proc (concat [0 90 0 0 93 184 216]))
+ ;; From example.com: OK status ^ ^ msg start
+ (ert-info ("State still set to waiting")
+ (should (eq (process-get proc 'socks-state) socks-state-waiting)))
+ (ert-info ("Response field is nil because processing incomplete")
+ (should-not (process-get proc 'socks-response)))
+ (ert-info ("Scratch field holds stashed partial payload")
+ (should (string= (concat [0 90 0 0 93 184 216])
+ (process-get proc 'socks-scratch)))))
+ (ert-info ("Last part arrives")
+ (socks-filter proc "\42") ; ?\" 34
+ (ert-info ("State transitions to complete (length check passes)")
+ (should (eq (process-get proc 'socks-state) socks-state-connected)))
+ (ert-info ("Scratch and response fields hold stash w. last chunk")
+ (should (string= (concat [0 90 0 0 93 184 216 34])
+ (process-get proc 'socks-response)))
+ (should (string= (process-get proc 'socks-response)
+ (process-get proc 'socks-scratch)))))
+ (delete-process proc)
+ (kill-buffer buf)))
-`VERBATIM' and `PATTERNS' are dotted alists containing responses.
-Requests are tried in order. On failure, an error is raised."
- (let* ((buf (generate-new-buffer "*canned-socks-server*"))
+(ert-deftest socks-tests-filter-response-parsing-v5 ()
+ "Ensure new chunks added on right (Bug#45162)."
+ (let* ((buf (generate-new-buffer "*test-socks-filter*"))
+ (proc (start-process "test-socks-filter" buf "sleep" "1")))
+ (process-put proc 'socks t)
+ (process-put proc 'socks-state socks-state-waiting)
+ (process-put proc 'socks-server-protocol 5)
+ (ert-info ("Receive initial incomplete segment")
+ ;; From fedora.org: 2605:bc80:3010:600:dead:beef:cafe:fed9
+ ;; 5004 ~~> Version Status (OK) NOOP Addr-Type (4 -> IPv6)
+ (socks-filter proc "\5\0\0\4\x26\x05\xbc\x80\x30\x10\x00\x60")
+ (ert-info ("State still waiting and response emtpy")
+ (should (eq (process-get proc 'socks-state) socks-state-waiting))
+ (should-not (process-get proc 'socks-response)))
+ (ert-info ("Scratch field holds partial payload of pending msg")
+ (should (string= "\5\0\0\4\x26\x05\xbc\x80\x30\x10\x00\x60"
+ (process-get proc 'socks-scratch)))))
+ (ert-info ("Middle chunk arrives")
+ (socks-filter proc "\xde\xad\xbe\xef\xca\xfe\xfe\xd9")
+ (ert-info ("State and response fields still untouched")
+ (should (eq (process-get proc 'socks-state) socks-state-waiting))
+ (should-not (process-get proc 'socks-response)))
+ (ert-info ("Scratch contains new arrival appended (on RHS)")
+ (should (string= (concat "\5\0\0\4"
+ "\x26\x05\xbc\x80\x30\x10\x00\x60"
+ "\xde\xad\xbe\xef\xca\xfe\xfe\xd9")
+ (process-get proc 'socks-scratch)))))
+ (ert-info ("Final part arrives (port number)")
+ (socks-filter proc "\0\0")
+ (ert-info ("State transitions to complete")
+ (should (eq (process-get proc 'socks-state) socks-state-connected)))
+ (ert-info ("Scratch and response fields show last chunk appended")
+ (should (string= (concat "\5\0\0\4"
+ "\x26\x05\xbc\x80\x30\x10\x00\x60"
+ "\xde\xad\xbe\xef\xca\xfe\xfe\xd9"
+ "\0\0")
+ (process-get proc 'socks-scratch)))
+ (should (string= (process-get proc 'socks-response)
+ (process-get proc 'socks-scratch)))))
+ (delete-process proc)
+ (kill-buffer buf)))
+
+(defvar socks-tests-canned-server-patterns nil
+ "Alist containing request/response cons pairs to be tried in order.
+Vectors must match verbatim. Strings are considered regex patterns.")
+
+(defun socks-tests-canned-server-create ()
+ "Create and return a fake SOCKS server."
+ (let* ((port (nth 2 socks-server))
+ (name (format "socks-server:%d" port))
+ (pats socks-tests-canned-server-patterns)
(filt (lambda (proc line)
- (let ((resp (or (assoc-default line verbatim
- (lambda (k s) ; s is line
- (string= (concat k) s)))
- (assoc-default line patterns
- (lambda (p s)
- (string-match-p p s))))))
- (unless resp
+ (pcase-let ((`(,pat . ,resp) (pop pats)))
+ (unless (or (and (vectorp pat) (equal pat (vconcat line)))
+ (string-match-p pat line))
(error "Unknown request: %s" line))
(let ((print-escape-control-characters t))
- (princ (format "<- %s\n" (prin1-to-string line)) buf)
- (princ (format "-> %s\n" (prin1-to-string resp)) buf))
+ (message "[%s] <- %s" name (prin1-to-string line))
+ (message "[%s] -> %s" name (prin1-to-string resp)))
(process-send-string proc (concat resp)))))
- (srv (make-network-process :server 1
- :buffer buf
- :filter filt
- :name "server"
- :family 'ipv4
- :host 'local
- :service socks-tests-canned-server-port)))
- (set-process-query-on-exit-flag srv nil)
- (princ (format "[%s] Listening on localhost:10080\n" srv) buf)
- srv))
-
-;; Add ([5 3 0 1 2] . [5 2]) to the `verbatim' list below to validate
-;; against curl 7.71 with the following options:
-;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com
-;;
-;; If later implementing version 4a, try these:
-;; [4 1 0 80 0 0 0 1 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] . [0 90 0 0 0 0 0 0]
-;; $ curl --verbose --proxy socks4a://127.0.0.1:10080 example.com
+ (serv (make-network-process :server 1
+ :buffer (get-buffer-create name)
+ :filter filt
+ :name name
+ :family 'ipv4
+ :host 'local
+ :coding 'binary
+ :service port)))
+ (set-process-query-on-exit-flag serv nil)
+ serv))
-(ert-deftest socks-tests-auth-filter-url-http ()
- "Verify correct handling of SOCKS5 user/pass authentication."
- (let* ((socks-server '("server" "127.0.0.1" 10080 5))
- (socks-username "foo")
- (socks-password "bar")
- (url-gateway-method 'socks)
+(defvar socks-tests--hello-world-http-request-pattern
+ (cons "^GET /" (concat "HTTP/1.1 200 OK\r\n"
+ "Content-Type: text/plain\r\n"
+ "Content-Length: 13\r\n\r\n"
+ "Hello World!\n")))
+
+(defun socks-tests-perform-hello-world-http-request ()
+ "Start canned server, validate hello-world response, and finalize."
+ (let* ((url-gateway-method 'socks)
(url (url-generic-parse-url "http://example.com";))
- (verbatim '(([5 2 0 2] . [5 2])
- ([1 3 ?f ?o ?o 3 ?b ?a ?r] . [1 0])
- ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
- . [5 0 0 1 0 0 0 0 0 0])))
- (patterns
- `(("^GET /" . ,(concat "HTTP/1.1 200 OK\r\n"
- "Content-Type: text/plain; charset=UTF-8\r\n"
- "Content-Length: 13\r\n\r\n"
- "Hello World!\n"))))
- (socks-tests-canned-server-port 10080)
- (server (socks-tests-canned-server-create verbatim patterns))
- (tries 10)
+ (server (socks-tests-canned-server-create))
;;
done
;;
@@ -90,14 +173,112 @@ Requests are tried in order. On failure, an error is
raised."
(goto-char (point-min))
(should (search-forward "Hello World" nil t))
(setq done t)))
- (buf (url-http url cb '(nil))))
- (ert-info ("Connect to HTTP endpoint over SOCKS5 with USER/PASS method")
- (while (and (not done) (< 0 (cl-decf tries))) ; cl-lib via url-http
- (sleep-for 0.1)))
+ (inhibit-message noninteractive)
+ (buf (url-http url cb '(nil)))
+ (proc (get-buffer-process buf))
+ (attempts 10))
+ (while (and (not done) (< 0 (cl-decf attempts)))
+ (sleep-for 0.1))
(should done)
(delete-process server)
+ (delete-process proc) ; otherwise seems client proc is sometimes reused
(kill-buffer (process-buffer server))
(kill-buffer buf)
(ignore url-gateway-method)))
+;; Unlike curl, socks.el includes the ID field (but otherwise matches):
+;; $ curl --proxy socks4://127.0.0.1:1080 example.com
+
+(ert-deftest socks-tests-v4-basic ()
+ "Show correct preparation of SOCKS4 connect command (Bug#46342)."
+ (let ((socks-server '("server" "127.0.0.1" 10079 4))
+ (url-user-agent "Test/4-basic")
+ (socks-tests-canned-server-patterns
+ `(([4 1 0 80 93 184 216 34 ?f ?o ?o 0] . [0 90 0 0 0 0 0 0])
+ ,socks-tests--hello-world-http-request-pattern))
+ socks-nslookup-program)
+ (ert-info ("Make HTTP request over SOCKS4")
+ (cl-letf (((symbol-function 'socks-nslookup-host)
+ (lambda (host)
+ (should (equal host "example.com"))
+ (list 93 184 216 34)))
+ ((symbol-function 'user-full-name)
+ (lambda () "foo")))
+ (socks-tests-perform-hello-world-http-request)))))
+
+;; Replace first pattern below with ([5 3 0 1 2] . [5 2]) to validate
+;; against curl 7.71 with the following options:
+;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com
+
+(ert-deftest socks-tests-v5-auth-user-pass ()
+ "Verify correct handling of SOCKS5 user/pass authentication."
+ (should (assq 2 socks-authentication-methods))
+ (let ((socks-server '("server" "127.0.0.1" 10080 5))
+ (socks-username "foo")
+ (socks-password "bar")
+ (url-user-agent "Test/auth-user-pass")
+ (socks-tests-canned-server-patterns
+ `(([5 2 0 2] . [5 2])
+ ([1 3 ?f ?o ?o 3 ?b ?a ?r] . [1 0])
+ ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
+ . [5 0 0 1 0 0 0 0 0 0])
+ ,socks-tests--hello-world-http-request-pattern)))
+ (ert-info ("Make HTTP request over SOCKS5 with USER/PASS auth method")
+ (socks-tests-perform-hello-world-http-request))))
+
+;; Services (like Tor) may be configured without auth but for some
+;; reason still prefer the user/pass method over none when offered both.
+;; Given this library's defaults, the scenario below is possible.
+;;
+;; FYI: RFC 1929 doesn't say that a username or password is required
+;; but notes that the length of both fields should be at least one.
+;; However, both socks.el and curl send zero-length fields (though
+;; curl drops the user part too when the password is empty).
+;;
+;; From Tor's docs /socks-extensions.txt, 1.1 Extent of support:
+;; > We allow username/password fields of this message to be empty ...
+;; line 41 in blob 5fd1f828f3e9d014f7b65fa3bd1d33c39e4129e2
+;; https://gitweb.torproject.org/torspec.git/tree/socks-extensions.txt
+;;
+;; To verify against curl 7.71, swap out the first two pattern pairs
+;; with ([5 3 0 1 2] . [5 2]) and ([1 0 0] . [1 0]), then run:
+;; $ curl verbose -U "foo:" --proxy socks5h://127.0.0.1:10081 example.com
+
+(ert-deftest socks-tests-v5-auth-user-pass-blank ()
+ "Verify correct SOCKS5 user/pass authentication with empty pass."
+ (should (assq 2 socks-authentication-methods))
+ (let ((socks-server '("server" "127.0.0.1" 10081 5))
+ (socks-username "foo") ; defaults to (user-login-name)
+ (socks-password "") ; simulate user hitting enter when prompted
+ (url-user-agent "Test/auth-user-pass-blank")
+ (socks-tests-canned-server-patterns
+ `(([5 2 0 2] . [5 2])
+ ([1 3 ?f ?o ?o 0] . [1 0])
+ ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
+ . [5 0 0 1 0 0 0 0 0 0])
+ ,socks-tests--hello-world-http-request-pattern)))
+ (ert-info ("Make HTTP request over SOCKS5 with USER/PASS auth method")
+ (socks-tests-perform-hello-world-http-request))))
+
+;; Swap out ([5 2 0 1] . [5 0]) with the first pattern below to validate
+;; against curl 7.71 with the following options:
+;; $ curl --verbose --proxy socks5h://127.0.0.1:10082 example.com
+
+(ert-deftest socks-tests-v5-auth-none ()
+ "Verify correct handling of SOCKS5 when auth method 0 requested."
+ (let ((socks-server '("server" "127.0.0.1" 10082 5))
+ (socks-authentication-methods (append socks-authentication-methods
+ nil))
+ (url-user-agent "Test/auth-none")
+ (socks-tests-canned-server-patterns
+ `(([5 1 0] . [5 0])
+ ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
+ . [5 0 0 1 0 0 0 0 0 0])
+ ,socks-tests--hello-world-http-request-pattern)))
+ (socks-unregister-authentication-method 2)
+ (should-not (assq 2 socks-authentication-methods))
+ (ert-info ("Make HTTP request over SOCKS5 with no auth method")
+ (socks-tests-perform-hello-world-http-request)))
+ (should (assq 2 socks-authentication-methods)))
+
;;; socks-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 9a83fa6..016b4d3 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -5102,8 +5102,10 @@ INPUT, if non-nil, is a string sent to the process."
(string-match-p
(regexp-quote envvar)
;; We must remove PS1, the output is truncated otherwise.
+ ;; We must suppress "_=VAR...".
(funcall
- this-shell-command-to-string "printenv | grep -v PS1")))))))))
+ this-shell-command-to-string
+ "printenv | grep -v PS1 | grep -v _=")))))))))
(tramp--test--deftest-direct-async-process tramp-test33-environment-variables
"Check that remote processes set / unset environment variables properly.
diff --git a/test/lisp/textmodes/dns-mode-tests.el
b/test/lisp/textmodes/dns-mode-tests.el
index 92b6cc9..8bc4873 100644
--- a/test/lisp/textmodes/dns-mode-tests.el
+++ b/test/lisp/textmodes/dns-mode-tests.el
@@ -37,7 +37,7 @@
(dns-mode-soa-increment-serial)
;; Number is updated from 2015080302 to the current date
;; (actually, just ensure the year part is later than 2020).
- (should (string-match "$TTL 86400
+ (should (string-match "\\$TTL 86400
@ IN SOA ns.icann.org. noc.dns.icann.org. (
20[2-9][0-9]+ ;Serial
7200 ;Refresh
diff --git a/test/misc/test-custom-deps.el b/test/misc/test-custom-deps.el
new file mode 100644
index 0000000..f072add
--- /dev/null
+++ b/test/misc/test-custom-deps.el
@@ -0,0 +1,42 @@
+;;; test-custom-deps.el --- Test custom deps -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The command `cus-test-deps' loads all (!) custom dependencies and
+;; reports about load errors.
+
+;;; Code:
+
+(require 'ert)
+
+(defconst custom-test-admin-cus-test
+ (expand-file-name "admin/cus-test.el" source-directory))
+
+(declare-function cus-test-deps custom-test-admin-cus-test)
+(defvar cus-test-deps-errors) ; from admin/cus-tests.el
+
+(ert-deftest test-custom-deps ()
+ :tags '(:expensive-test)
+ (skip-unless (file-readable-p custom-test-admin-cus-test))
+ (load custom-test-admin-cus-test)
+ (cus-test-deps)
+ (should-not cus-test-deps-errors))
+
+;;; test-custom-deps.el ends here
diff --git a/test/misc/test-custom-libs.el b/test/misc/test-custom-libs.el
new file mode 100644
index 0000000..70f043d
--- /dev/null
+++ b/test/misc/test-custom-libs.el
@@ -0,0 +1,46 @@
+;;; test-custom-libs.el --- Test custom loads -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file runs for all libraries with autoloads separate emacs
+;; processes of the form "emacs -batch -l LIB".
+
+;;; Code:
+
+(require 'ert)
+
+(defconst custom-test-admin-cus-test
+ (expand-file-name "admin/cus-test.el" source-directory))
+
+(declare-function cus-test-libs custom-test-admin-cus-test)
+(defvar cus-test-libs-errors) ; from admin/cus-tests.el
+
+;; FIXME: Currently fails for:
+;; - lisp/term/ns-win.el
+;; - lisp/org/org-num.el
+(ert-deftest test-custom-libs ()
+ :tags '(:expensive-test)
+ :expected-result :failed ; FIXME: See above.
+ (skip-unless (file-readable-p custom-test-admin-cus-test))
+ (load custom-test-admin-cus-test)
+ (cus-test-libs t)
+ (should-not cus-test-libs-errors))
+
+;;; test-custom-deps.el ends here
diff --git a/test/misc/test-custom-noloads.el b/test/misc/test-custom-noloads.el
new file mode 100644
index 0000000..e999fe2
--- /dev/null
+++ b/test/misc/test-custom-noloads.el
@@ -0,0 +1,45 @@
+;;; test-custom-deps.el --- Test custom noloads -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The command `cus-test-noloads' returns a list of variables which
+;; are somewhere declared as custom options, but not loaded by
+;; `custom-load-symbol'.
+
+;;; Code:
+
+(require 'ert)
+
+(defconst custom-test-admin-cus-test
+ (expand-file-name "admin/cus-test.el" source-directory))
+
+(declare-function cus-test-noloads custom-test-admin-cus-test)
+(defvar cus-test-vars-not-cus-loaded) ; from admin/cus-tests.el
+
+;; FIXME: Multiple failures here.
+(ert-deftest custom-test-load ()
+ :tags '(:expensive-test)
+ :expected-result :failed ; FIXME: See above.
+ (skip-unless (file-readable-p custom-test-admin-cus-test))
+ (load custom-test-admin-cus-test)
+ (cus-test-noloads)
+ (should-not cus-test-vars-not-cus-loaded))
+
+;;; test-custom-deps.el ends here
diff --git a/test/misc/test-custom-opts.el b/test/misc/test-custom-opts.el
new file mode 100644
index 0000000..fa6b9e6
--- /dev/null
+++ b/test/misc/test-custom-opts.el
@@ -0,0 +1,39 @@
+;;; test-custom-opts.el --- Test custom opts -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The command `cus-test-opts' tests many (all?) custom options.
+
+;;; Code:
+
+(require 'ert)
+
+(defconst custom-test-admin-cus-test
+ (expand-file-name "admin/cus-test.el" source-directory))
+
+(declare-function cus-test-opts custom-test-admin-cus-test)
+
+(ert-deftest check-for-wrong-custom-opts ()
+ :tags '(:expensive-test)
+ (skip-unless (file-readable-p custom-test-admin-cus-test))
+ (load custom-test-admin-cus-test)
+ (should (null (cus-test-opts t))))
+
+;;; test-custom-opts.el ends here
diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el
index 607d2ea..41c8cdd 100644
--- a/test/src/keyboard-tests.el
+++ b/test/src/keyboard-tests.el
@@ -23,14 +23,15 @@
(ert-deftest keyboard-unread-command-events ()
"Test `unread-command-events'."
- (should (equal (progn (push ?\C-a unread-command-events)
- (read-event nil nil 1))
- ?\C-a))
- (should (equal (progn (run-with-timer
- 1 nil
- (lambda () (push '(t . ?\C-b) unread-command-events)))
- (read-event nil nil 2))
- ?\C-b)))
+ (let ((unread-command-events nil))
+ (should (equal (progn (push ?\C-a unread-command-events)
+ (read-event nil nil 1))
+ ?\C-a))
+ (should (equal (progn (run-with-timer
+ 1 nil
+ (lambda () (push '(t . ?\C-b)
unread-command-events)))
+ (read-event nil nil 2))
+ ?\C-b))))
(ert-deftest keyboard-lossage-size ()
"Test `lossage-size'."
@@ -46,6 +47,28 @@
(should-error (lossage-size (1- min-value)))
(should (= lossage-orig (lossage-size lossage-orig)))))
+;; FIXME: This test doesn't currently work :-(
+;; (ert-deftest keyboard-tests--echo-keystrokes-bug15332 ()
+;; (let ((msgs '())
+;; (unread-command-events nil)
+;; (redisplay--interactive t)
+;; (echo-keystrokes 2))
+;; (setq unread-command-events '(?\C-u))
+;; (let* ((timer1
+;; (run-with-timer 3 1
+;; (lambda ()
+;; (setq unread-command-events '(?5)))))
+;; (timer2
+;; (run-with-timer 2.5 1
+;; (lambda ()
+;; (push (current-message) msgs)))))
+;; (run-with-timer 5 nil
+;; (lambda ()
+;; (cancel-timer timer1)
+;; (cancel-timer timer2)
+;; (throw 'exit msgs)))
+;; (recursive-edit)
+;; (should (equal msgs '("C-u 55-" "C-u 5-" "C-u-"))))))
(provide 'keyboard-tests)
;;; keyboard-tests.el ends here