[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 06acf68 1/3: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 06acf68 1/3: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Sat, 26 Sep 2020 09:47:44 -0400 (EDT) |
branch: feature/native-comp
commit 06acf681d6fd8e2c5c6a9584b5df6b98eccda20b
Merge: e5b052d e00936b
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into HEAD
---
CONTRIBUTE | 9 +-
admin/cus-test.el | 11 +-
build-aux/update-subdirs | 2 +-
doc/emacs/basic.texi | 5 +-
doc/emacs/display.texi | 7 +-
doc/emacs/frames.texi | 24 +--
doc/lispref/processes.texi | 3 +-
doc/lispref/strings.texi | 10 ++
doc/misc/tramp.texi | 78 ++++-----
etc/NEWS | 66 ++++++--
etc/TODO | 7 +-
etc/compilation.txt | 8 +
lisp/allout-widgets.el | 85 ----------
lisp/allout.el | 146 +---------------
lisp/apropos.el | 14 +-
lisp/cedet/ede/detect.el | 10 --
lisp/cedet/ede/proj-elisp.el | 15 +-
lisp/cedet/semantic/bovine/grammar.el | 3 +-
lisp/cedet/semantic/ede-grammar.el | 17 +-
lisp/cedet/semantic/lex.el | 3 -
lisp/completion.el | 121 --------------
lisp/dired.el | 4 +-
lisp/emacs-lisp/byte-opt.el | 4 +-
lisp/emacs-lisp/eldoc.el | 4 +
lisp/emacs-lisp/lisp.el | 177 ++++++++++++++------
lisp/erc/erc-status-sidebar.el | 3 +-
lisp/gnus/gnus-art.el | 1 +
lisp/gnus/gnus-topic.el | 4 +-
lisp/gnus/gnus-util.el | 2 +-
lisp/gnus/message.el | 2 +-
lisp/gnus/nnselect.el | 232 +++++++++++++++++---------
lisp/help-fns.el | 2 +-
lisp/info.el | 1 +
lisp/man.el | 19 ++-
lisp/misc.el | 4 +-
lisp/mwheel.el | 20 ++-
lisp/net/dbus.el | 295 ++++++++++++++++++++++++++-------
lisp/net/shr.el | 10 +-
lisp/net/soap-client.el | 1 +
lisp/net/tramp-crypt.el | 2 +-
lisp/net/tramp-sh.el | 4 +-
lisp/play/gamegrid.el | 2 +
lisp/progmodes/antlr-mode.el | 5 +-
lisp/progmodes/compile.el | 6 +-
lisp/progmodes/gdb-mi.el | 5 +-
lisp/progmodes/idlwave.el | 3 +-
lisp/progmodes/prolog.el | 82 ++++-----
lisp/progmodes/python.el | 4 +-
lisp/progmodes/ruby-mode.el | 40 ++---
lisp/progmodes/sql.el | 7 +-
lisp/repeat.el | 4 -
lisp/simple.el | 91 ++++++----
lisp/subr.el | 46 ++---
lisp/term/ns-win.el | 22 ++-
lisp/textmodes/artist.el | 24 +--
lisp/whitespace.el | 8 +-
lisp/wid-edit.el | 11 +-
src/dbusbind.c | 139 ++++++++++++----
src/fns.c | 52 ++++++
src/nsfont.m | 240 ---------------------------
src/nsimage.m | 12 +-
src/nsterm.h | 41 ++---
src/nsterm.m | 105 +++++++-----
src/process.c | 39 ++---
src/syntax.c | 7 +
src/xdisp.c | 13 ++
test/lisp/allout-tests.el | 148 +++++++++++++++++
test/lisp/allout-widgets-tests.el | 87 ++++++++++
test/lisp/arc-mode-tests.el | 2 +-
test/lisp/completion-tests.el | 170 +++++++++++++++++++
test/lisp/custom-tests.el | 11 ++
test/lisp/emacs-lisp/ert-x-tests.el | 21 +--
test/lisp/emacs-lisp/lisp-tests.el | 5 +-
test/lisp/help-fns-tests.el | 3 +
test/lisp/net/dbus-tests.el | 37 +++--
test/lisp/progmodes/compile-tests.el | 5 +-
test/lisp/progmodes/ps-mode-tests.el | 2 +-
test/lisp/progmodes/ruby-mode-tests.el | 2 -
test/lisp/subr-tests.el | 12 +-
test/lisp/textmodes/css-mode-tests.el | 2 -
test/lisp/wdired-tests.el | 1 -
test/lisp/wid-edit-tests.el | 16 ++
test/lisp/xml-tests.el | 21 +++
test/src/fns-tests.el | 59 ++++++-
test/src/xdisp-tests.el | 52 ++++++
test/src/xml-tests.el | 21 +--
86 files changed, 1823 insertions(+), 1297 deletions(-)
diff --git a/CONTRIBUTE b/CONTRIBUTE
index 4e42c7a..cb09391 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -257,13 +257,12 @@ them right the first time, so here are guidelines for
formatting them:
- There is no standard or recommended way to identify revisions in
ChangeLog entries. Using Git SHA1 values limits the usability of
the references to Git, and will become much less useful if Emacs
- switches to a different VCS. So we recommend against that.
+ switches to a different VCS. So we recommend against doing only that.
One way to identify revisions is by quoting their summary line.
- Another is with an action stamp - an RFC3339 date followed by !
- followed by the committer's email - for example,
- "2014-01-16T05:43:35Z!esr@thyrsus.com". Often, "my previous commit"
- will suffice.
+ Prefixing the summary with the commit date can give useful context
+ (use 'git show -s "--pretty=format:%cd \"%s\"" --date=short HASH' to
+ produce that). Often, "my previous commit" will suffice.
- There is no need to mention files such as NEWS and MAINTAINERS, or
to indicate regeneration of files such as 'lib/gnulib.mk', in the
diff --git a/admin/cus-test.el b/admin/cus-test.el
index 8422409..cee8c19 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -370,7 +370,9 @@ This function is suitable for batch mode. E.g., invoke
in the Emacs source directory.
Normally only tests options belonging to files in loaddefs.el.
-If optional argument ALL is non-nil, test all files with defcustoms."
+If optional argument ALL is non-nil, test all files with defcustoms.
+
+Returns a list of variables with suspicious types."
(interactive)
(and noninteractive
command-line-args-left
@@ -382,9 +384,12 @@ If optional argument ALL is non-nil, test all files with
defcustoms."
(message "Running %s" 'cus-test-apropos)
(cus-test-apropos "")
(if (not cus-test-errors)
- (message "No problems found")
+ (progn
+ (message "No problems found")
+ nil)
(message "The following options might have problems:")
- (cus-test-message cus-test-errors)))
+ (cus-test-message cus-test-errors)
+ cus-test-errors))
(defun cus-test-deps ()
"Run a verbose version of `custom-load-symbol' on all atoms.
diff --git a/build-aux/update-subdirs b/build-aux/update-subdirs
index 336029f..96712f0 100755
--- a/build-aux/update-subdirs
+++ b/build-aux/update-subdirs
@@ -26,7 +26,7 @@ for file in *; do
*.elc | *.el | term | RCS | CVS | Old | . | .. | =* | *~ | *.orig |
*.rej)
;;
*)
- if [ -d $file ]; then
+ if [ -d "$file" ]; then
if [ "$file" = "obsolete" ]; then
subdirs="$subdirs \"$file\""
else
diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index 444b246..cde7b47 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -311,13 +311,16 @@ Position 1 is the beginning of the buffer.
@kindex M-g M-g
@kindex M-g g
@findex goto-line
+@findex goto-line-relative
Read a number @var{n} and move point to the beginning of line number
@var{n} (@code{goto-line}). Line 1 is the beginning of the buffer. If
point is on or just after a number in the buffer, that is the default
for @var{n}. Just type @key{RET} in the minibuffer to use it. You can
also specify @var{n} by giving @kbd{M-g M-g} a numeric prefix argument.
@xref{Select Buffer}, for the behavior of @kbd{M-g M-g} when you give it
-a plain prefix argument.
+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.
@item M-g @key{TAB}
@kindex M-g TAB
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index e7b8745..6f1bc80 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -1452,9 +1452,10 @@ the displayed column number to count from one, you may
set
@cindex narrowing, and line number display
If you have narrowed the buffer (@pxref{Narrowing}), the displayed
line number is relative to the accessible portion of the buffer.
-Thus, it isn't suitable as an argument to @code{goto-line}. (Use
-@code{what-line} command to see the line number relative to the whole
-file.)
+Thus, it isn't suitable as an argument to @code{goto-line}. (The
+command @code{what-line} shows the line number relative to the whole
+file.) You can use @code{goto-line-relative} command to move point to
+the line relative to the accessible portion of the narrowed buffer.
@vindex line-number-display-limit
If the buffer is very large (larger than the value of
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index b748876..1a44d8d 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -214,22 +214,24 @@ speed is linked to how fast you move the wheel. This
mode also
supports increasing or decreasing the height of the default face, by
default bound to scrolling with the @key{Ctrl} modifier.
+Emacs also supports horizontal scrolling with the @key{Shift} modifier.
+
@vindex mouse-wheel-tilt-scroll
@vindex mouse-wheel-flip-direction
-Emacs can also support horizontal scrolling if your mouse's wheel can
-be tilted, or if your touchpad supports it. This feature is off by
-default; the variable @code{mouse-wheel-tilt-scroll} turns it on, if
-you customize it to a non-@code{nil} value. By default, tilting the
-mouse wheel scrolls the window's view horizontally in the direction of
-the tilt: e.g., tilting to the right scrolls the window to the right,
-so that the text displayed in the window moves horizontally to the
-left. If you'd like to reverse the direction of horizontal scrolling,
-customize the variable @code{mouse-wheel-flip-direction} to a
-non-@code{nil} value.
+If your mouse's wheel can be tilted, or if your touchpad supports it,
+then you can also enable horizontal scrolling by customizing the
+variable @code{mouse-wheel-tilt-scroll} to a non-@code{nil} value.
+By default, tilting the mouse wheel scrolls the window's view
+horizontally in the direction of the tilt: e.g., tilting to the right
+scrolls the window to the right, so that the text displayed in the
+window moves horizontally to the left. If you'd like to reverse the
+direction of horizontal scrolling, customize the variable
+@code{mouse-wheel-flip-direction} to a non-@code{nil} value.
When the mouse pointer is over an image in Image mode, @pxref{Image Mode},
scrolling the mouse wheel with the @key{Ctrl} modifier scales the image
-under the mouse pointer.
+under the mouse pointer, and scrolling the mouse wheel with the
+@key{Shift} modifier scrolls the image horizontally.
@node Word and Line Mouse
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 4556f8a..855df4b 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -1576,7 +1576,8 @@ from previous output.
@defun set-process-buffer process buffer
This function sets the buffer associated with @var{process} to
@var{buffer}. If @var{buffer} is @code{nil}, the process becomes
-associated with no buffer.
+associated with no buffer; if non-@code{nil}, the process mark will be
+set to point to the end of @var{buffer}.
@end defun
@defun get-buffer-process buffer-or-name
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 8de6255..0f157c3 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -656,6 +656,16 @@ optional argument @var{ignore-case} is non-@code{nil}, the
comparison
ignores case differences.
@end defun
+@defun string-search needle haystack &optional start-pos
+Return the position of the first instance of @var{needle} in
+@var{haystack}, both of which are strings. If @var{start-pos} is
+non-@code{nil}, start searching from that position in @var{needle}.
+Return @code{nil} if no match was found.
+This function only considers the characters in the strings when doing
+the comparison; text properties are ignored. Matching is always
+case-sensitive.
+@end defun
+
@defun compare-strings string1 start1 end1 string2 start2 end2 &optional
ignore-case
This function compares a specified part of @var{string1} with a
specified part of @var{string2}. The specified part of @var{string1}
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 538f85f..806a1dd 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -1622,7 +1622,7 @@ support this command.
@subsection Tunneling with ssh
-With ssh, you could use the @code{ProxyCommand} entry in
+With @command{ssh}, you could use the @option{ProxyCommand} entry in
@file{~/.ssh/config}:
@example
@@ -1802,8 +1802,8 @@ in such files, it can return host names only.
@item @code{tramp-parse-sconfig}
@findex tramp-parse-sconfig
-This function returns the host nicknames defined by @code{Host} entries
-in @file{~/.ssh/config} style files.
+This function returns the host nicknames defined by @option{Host}
+entries in @file{~/.ssh/config} style files.
@item @code{tramp-parse-shostkeys}
@findex tramp-parse-shostkeys
@@ -2281,10 +2281,10 @@ example below:
@end lisp
@vindex password-word-equivalents
-This variable is, by default, initialised from
+This user option is, by default, initialised from
@code{password-word-equivalents} when @value{tramp} is loaded, and it
-is usually more convenient to add new passphrases to that variable
-instead of altering this variable.
+is usually more convenient to add new passphrases to that user option
+instead of altering this user option.
Similar localization may be necessary for handling wrong password
prompts, for which @value{tramp} uses @code{tramp-wrong-passwd-regexp}.
@@ -2725,7 +2725,7 @@ corresponding password; otherwise there is no way to
decrypt your
encrypted files.
@defopt tramp-crypt-save-encfs-config-remote
-If this user option is non-nil (the default), the @option{encfs}
+If this user option is non-@code{nil} (the default), the @option{encfs}
configuration file @file{.encfs6.xml} is also kept in the encrypted
remote directory. It depends on you, whether you regard the password
protection of this file as sufficient. The advantage would be, that
@@ -3186,7 +3186,7 @@ or a string describing the signal, when the process has
been
interrupted. Since it cannot be determined reliably whether a remote
process has been interrupted, @code{process-file} returns always the
exit code. When the user option
-@code{process-file-return-signal-string} is non-nil,
+@code{process-file-return-signal-string} is non-@code{nil},
@code{process-file} regards all exit codes greater than 128 as an
indication that the process has been interrupted, and returns a
respective string.
@@ -3317,8 +3317,8 @@ whatever reason, then replace @code{(getenv "DISPLAY")}
with a
hard-coded, fixed name. Note that using @code{:0} for X11 display name
here will not work as expected.
-An alternate approach is specify @code{ForwardX11 yes} or
-@code{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local
+An alternate approach is specify @option{ForwardX11 yes} or
+@option{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local
host.
@@ -3392,22 +3392,22 @@ continuous output.
@vindex shell-file-name
@vindex shell-command-switch
-@code{shell-command} uses the variables @code{shell-file-name} and
-@code{shell-command-switch} in order to determine which shell to run.
-For remote hosts, their default values are @file{/bin/sh} and
-@option{-c}, respectively (except for the @option{adb} method, which
-uses @file{/system/bin/sh}). Like the variables in the previous
-section, these variables can be changed via connection-local
-variables.
+@code{shell-command} uses the user option @code{shell-file-name} and
+the variable @code{shell-command-switch} in order to determine which
+shell to run. For remote hosts, their default values are
+@file{/bin/sh} and @option{-c}, respectively (except for the
+@option{adb} method, which uses @file{/system/bin/sh}). Like the
+variables in the previous section, these variables can be changed via
+connection-local variables.
@vindex async-shell-command-width
@vindex COLUMNS@r{, environment variable}
-If Emacs supports the variable @code{async-shell-command-width} (since
-@w{Emacs 27}), @value{tramp} cares about its value for asynchronous
-shell commands. It specifies the number of display columns for
-command output. For synchronous shell commands, a similar effect can
-be achieved by adding the environment variable @env{COLUMNS} to
-@code{tramp-remote-process-environment}.
+If Emacs supports the user option @code{async-shell-command-width}
+(since @w{Emacs 27}), @value{tramp} cares about its value for
+asynchronous shell commands. It specifies the number of display
+columns for command output. For synchronous shell commands, a similar
+effect can be achieved by adding the environment variable
+@env{COLUMNS} to @code{tramp-remote-process-environment}.
@subsection Running @code{eshell} on a remote host
@@ -3583,7 +3583,7 @@ It works only for connection methods defined in
@file{tramp-sh.el} and
It does not support interactive user authentication. With
@option{ssh}-based methods, this can be avoided by using a password
agent like @command{ssh-agent}, using public key authentication, or
-using @code{ControlMaster} options.
+using @option{ControlMaster} options.
@item
It cannot be killed via @code{interrupt-process}.
@@ -3606,7 +3606,7 @@ In order to gain even more performance, it is recommended
to bind
@code{tramp-verbose} to 0 when running @code{make-process} or
@code{start-file-process}. Furthermore, you might set
@code{tramp-use-ssh-controlmaster-options} to @code{nil} in order to
-bypass @value{tramp}'s handling of the @code{ControlMaster} options,
+bypass @value{tramp}'s handling of the @option{ControlMaster} options,
and use your own settings in @file{~/.ssh/config}.
@@ -3681,8 +3681,8 @@ On all buffers, which have a @code{buffer-file-name}
matching
prompted for modification in the minibuffer. The buffers are marked
modified, and must be saved explicitly.
-If user option @code{tramp-confirm-rename-file-names} is nil, changing
-the file name happens without confirmation. This requires a
+If user option @code{tramp-confirm-rename-file-names} is @code{nil},
+changing the file name happens without confirmation. This requires a
matching entry in @code{tramp-default-rename-alist}.
Remote buffers related to the remote connection identified by
@@ -3721,8 +3721,8 @@ Tramp infers by default, such as
@samp{@trampfn{method,user@@host,}}).
name of @code{source} when calling @code{tramp-rename-files}.
@code{source} could also be a Lisp form, which will be evaluated. The
-result must be a string or nil, which is interpreted as a regular
-expression which always matches.
+result must be a string or @code{nil}, which is interpreted as a
+regular expression which always matches.
Example entries:
@@ -4302,17 +4302,17 @@ Host *
@item
-@value{tramp} does not use default @command{ssh} @code{ControlPath}
+@value{tramp} does not use default @command{ssh} @option{ControlPath}
-@value{tramp} overwrites @code{ControlPath} settings when initiating
+@value{tramp} overwrites @option{ControlPath} settings when initiating
@command{ssh} sessions. @value{tramp} does this to fend off a stall
if a master session opened outside the Emacs session is no longer
open. That is why @value{tramp} prompts for the password again even
if there is an @command{ssh} already open.
@vindex tramp-ssh-controlmaster-options
-Some @command{ssh} versions support a @code{ControlPersist} option,
-which allows you to set the @code{ControlPath} provided the variable
+Some @command{ssh} versions support a @option{ControlPersist} option,
+which allows you to set the @option{ControlPath} provided the variable
@code{tramp-ssh-controlmaster-options} is customized as follows:
@lisp
@@ -4337,12 +4337,16 @@ this @code{nil} setting:
(customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
@end lisp
+This shall also be set to @code{nil} if you use the
+@option{ProxyCommand} or @option{ProxyJump} options in your
+@command{ssh} configuration.
+
@item
On multi-hop connections, @value{tramp} does not use @command{ssh}
-@code{ControlMaster}
+@option{ControlMaster}
-In order to use the @code{ControlMaster} option, @value{tramp} must
+In order to use the @option{ControlMaster} option, @value{tramp} must
check whether the @command{ssh} client supports this option. This is
only possible on the local host, for the first hop. @value{tramp}
does not use this option on proxy hosts.
@@ -4365,7 +4369,7 @@ supported on your proxy host.
@item
@value{tramp} does not connect to Samba or MS Windows hosts running
-SMB1 connection protocol.
+SMB1 connection protocol
@vindex tramp-smb-options
Recent versions of @command{smbclient} do not support old connection
@@ -4592,7 +4596,7 @@ completion can further reduce key strokes: @kbd{C-x C-f
@value{prefix}ssh@value{postfixhop}x @key{TAB}}.
@item
-Use environment variables to expand long strings
+Use environment variables to expand long strings:
For long file names, set up environment variables that are expanded in
the minibuffer. Environment variables are set either outside Emacs or
diff --git a/etc/NEWS b/etc/NEWS
index 6bfe45a..d3a9748 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -135,6 +135,13 @@ and mode line. ('mwheel-mode' is enabled by default on
most graphical
displays.)
---
+** Mouse wheel scrolling now defaults to one line at a time.
+
++++
+** Mouse wheel scrolling with Shift modifier now scrolls horizontally.
+This works in text buffers and over images.
+
+---
** The default value of 'frame-title-format' and 'icon-title-format' has
changed.
These variables are used to display the title bar of visible frames
and the title bar of an iconified frame. They now show the name of
@@ -172,6 +179,13 @@ Each buffer will keep a separate history of line numbers
used with
line numbers that were previously jumped to.
+++
+** New command 'goto-line-relative' to use in a narrowed buffer.
+It moves point to the line relative to the accessible portion of the
+narrowed buffer. 'M-g M-g' in Info is rebound to this command.
+When 'widen-automatically' is non-nil, 'goto-line' widens the narrowed
+buffer to be able to move point to the inaccessible portion.
+
++++
** When 'suggest-key-bindings' is non-nil, the completion list of 'M-x'
shows equivalent key bindings for all commands that have them.
@@ -204,6 +218,12 @@ trying to be non-destructive.
* Changes in Specialized Modes and Packages in Emacs 28.1
+** Ruby mode
+
+*** 'ruby-use-smie' is declared obsolete.
+SMIE is now always enabled and 'ruby-use-smie' only controls whether
+indentation is done using SMIE or with the old ad-hoc code.
+
---
** Specific warnings can now be disabled from the warning buffer.
When a warning is displayed to the user, the resulting buffer now has
@@ -468,7 +488,7 @@ changed so that all the recipients are put in the "To"
header in these
instances.
+++
-*** New function to start Emacs in Message mode to send an email.
+*** New command to start Emacs in Message mode to send an email.
Emacs can be defined as a handler for the "x-scheme-handler/mailto"
MIME type with the following command: "emacs -f message-mailto %u".
An "emacs-mail.desktop" file has been included, suitable for
@@ -551,7 +571,7 @@ definition.
*** New user option 'eldoc-display-truncation-message'.
If non-nil (the default), eldoc will display a message saying
something like "(Documentation truncated. Use `M-x eldoc-doc-buffer'
-to see rest" when a message has been truncated. If nil, truncated
+to see rest)" when a message has been truncated. If nil, truncated
messages will be marked with just "..." at the end.
+++
@@ -633,7 +653,7 @@ equivalent to '(map (:sym sym))'.
** Package
+++
-*** New functions to filter the package list.
+*** New commands to filter the package list.
The filter command key bindings are as follows:
key binding
@@ -690,6 +710,9 @@ required, but the recommended solution is to use a
correctly matching
regexp instead.
---
+*** Messages from ShellCheck are now recognized.
+
+---
*** Messages from Visual Studio that mention column numbers are now recognized.
** Hi Lock mode
@@ -790,12 +813,12 @@ Formerly, one could do the same by setting
'browse-url-browser-function' to such an alist. This usage is still
supported but deprecated.
-*** Categorization of browsing functions in internal vs. external.
-All standard browsing functions such as 'browse-url-firefox',
+*** Categorization of browsing commands in internal vs. external.
+All standard browsing commands such as 'browse-url-firefox',
'browse-url-mail', or 'eww' have been categorized into internal (URL
is browsed in Emacs) or external (an external application is spawned
with the URL). This is done by adding a 'browse-url-browser-kind'
-symbol property to the browsing functions. With a new command
+symbol property to the browsing commands. With a new command
'browse-url-with-browser-kind', an URL can explicitly be browsed with
either an internal or external browser.
@@ -874,7 +897,7 @@ This can be used to download data via an external command.
If nil
(the default), then 'url-retrieve' is used.
+++
-*** New Emacs command line convenience function.
+*** New Emacs command line convenience command.
The 'eww-browse' command has been added, which allows you to register
Emacs as a MIME handler for "text/x-uri", and will call 'eww' on the
supplied URL. Usage example: "emacs -f eww-browse https://gnu.org";.
@@ -1042,11 +1065,18 @@ window after starting). This variable defaults to nil.
** Miscellaneous
+---
+*** 'zap-up-to-char' now uses 'read-char-from-minibuffer'.
+This allows navigating through the history of characters that have
+been input. This is mostly useful for characters that have complex
+input methods where inputting the character again may involve many
+keystrokes.
+
+++
*** Interactive regular expression search now uses faces for sub-groups.
E.g., 'C-M-s foo-\([0-9]+\)' will now use the 'isearch-group-1' face
on the part of the regexp that matches the sub-expression "[0-9]+".
-This is controlled by the 'search-highlight-submatches' variable.
+This is controlled by the 'search-highlight-submatches' user option.
---
*** New user option 'reveal-auto-hide'.
@@ -1148,7 +1178,7 @@ to 'tab-bar-new-tab-choice' for new tabs to show the
bookmark list.
** xwidget-webkit mode
-*** New xwidget functions.
+*** New xwidget commands.
'xwidget-webkit-uri' (return the current URL), 'xwidget-webkit-title'
(return the current title), and 'xwidget-webkit-goto-history' (goto a
point in history).
@@ -1190,7 +1220,7 @@ Clicking the dictionary name changes the current
dictionary.
several time zones. It is hoped that the new names are more
discoverable.
-The following functions have been renamed:
+The following commands have been renamed:
'display-time-world' to 'world-clock'
'display-time-world-mode' to 'world-clock-mode'
@@ -1225,7 +1255,13 @@ type symbols. Both functions propagate D-Bus errors.
messages, contain the error name of that message now.
---
-*** D-Bus events keep the type information of their arguments.
+*** D-Bus messages can be monitored with new function 'dbus-register-monitor'.
+
+---
+*** D-Bus events have changed their internal structure.
+They carry now the destination and the error-name of an event. They
+also keep the type information of their arguments. Use the
+'dbus-event-*' accessor functions.
** CPerl Mode
@@ -1267,6 +1303,9 @@ directory instead of the default directory.
* Incompatible Lisp Changes in Emacs 28.1
+** 'set-process-buffer' now updates the process mark.
+The mark will be set to point to the end of the new buffer.
+
+++
** Some properties from completion tables are now preserved.
If 'minibuffer-allow-text-properties' is non-nil, doing completion
@@ -1395,6 +1434,11 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
* Lisp Changes in Emacs 28.1
+++
+*** New function 'string-search'.
+This function takes two string parameters and returns the position of
+the first instance of the first string in the latter.
+
++++
*** New function 'process-lines-ignore-status'.
This is like 'process-lines', but does not signal an error if the
return status is non-zero. 'process-lines-handling-status' has also
diff --git a/etc/TODO b/etc/TODO
index 152a299..467b08e 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -924,17 +924,14 @@ features of that interface could be implemented NS.
**** Smooth scrolling -- maybe not a good idea
Today, by default, scrolling with a trackpad makes the text move in
-steps of five lines. (Scrolling with SHIFT scrolls one line at a time.)
+steps of one line. (Scrolling with SHIFT scrolls horizontally.)
The "mac" port provides smooth, pixel-based, scrolling. This is a very
-popular features. However, there are drawbacks to this method: what
+popular feature. However, there are drawbacks to this method: what
happens if only a fraction of a line is visible at the top of a
window, is the partially visible text considered part of the window or
not? (Technically, what should 'window-start' return.)
-An alternative would be to make one-line scrolling the default on NS
-(or in Emacs in general).
-
Note: This feature might not be allowed to be implemented until also
implemented in Emacs for a free system.
diff --git a/etc/compilation.txt b/etc/compilation.txt
index 11aefc6..df0b82e 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -536,6 +536,14 @@ cc-1070 cc: WARNING File = linkl.c, Line = 38
cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3
+* ShellCheck
+
+In autogen.sh line 38:
+autoconf_min=`sed -n 's/^ *AC_PREREQ(\([0-9\.]*\)).*/\1/p' configure.ac`
+^----------^ SC2034: autoconf_min appears unused. Verify use (or export if
used externally).
+ ^-- SC2006: Use $(...) notation instead of legacy backticked
`...`.
+
+
* Sun Ada (VADS, Solaris)
symbol: sun-ada
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index 03fc3e2..ac49d3b 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -209,21 +209,6 @@ See `allout-widgets-mode' for allout widgets mode
features."
:group 'allout-widgets)
(make-obsolete-variable 'allout-widgets-item-image-properties-xemacs nil
"28.1")
;;;_ . Developer
-;;;_ = allout-widgets-run-unit-tests-on-load
-(defcustom allout-widgets-run-unit-tests-on-load nil
- "When non-nil, unit tests will be run at end of loading allout-widgets.
-
-Generally, allout widgets code developers are the only ones who'll want to
-set this.
-
-\(If set, this makes it an even better practice to exercise changes by
-doing byte-compilation with a repeat count, so the file is loaded after
-compilation.)
-
-See `allout-widgets-run-unit-tests' to see what's run."
- :version "24.1"
- :type 'boolean
- :group 'allout-widgets-developer)
;;;_ = allout-widgets-time-decoration-activity
(defcustom allout-widgets-time-decoration-activity nil
"Retain timing info of the last cooperative redecoration.
@@ -1353,64 +1338,6 @@ FROM and TO must be in increasing order, as must be the
pairs in RANGES."
(setq new-ranges (nreverse new-ranges))
(if ranges (setq new-ranges (append new-ranges ranges)))
(list (if included-from t) new-ranges)))
-;;;_ > allout-test-range-overlaps ()
-(defun allout-test-range-overlaps ()
- "`allout-range-overlaps' unit tests."
- (let* (ranges
- got
- (try (lambda (from to)
- (setq got (allout-range-overlaps from to ranges))
- (setq ranges (cadr got))
- got)))
-;; ;; biggie:
-;; (setq ranges nil)
-;; ;; ~ .02 to .1 seconds for just repeated listing args instead of funcall
-;; ;; ~ 13 seconds for doing repeated funcall
-;; (message "time-trial: %s, resulting size %s"
-;; (time-trial
-;; '(let ((size 10000)
-;; doing)
-;; (dotimes (count size)
-;; (setq doing (random size))
-;; (funcall try doing (+ doing (random 5)))
-;; ;;(list doing (+ doing (random 5)))
-;; )))
-;; (length ranges))
-;; (sit-for 2)
-
- ;; fresh:
- (setq ranges nil)
- (cl-assert (equal (funcall try 3 5) '(nil ((3 5)))))
- ;; add range at end:
- (cl-assert (equal (funcall try 10 12) '(nil ((3 5) (10 12)))))
- ;; add range at beginning:
- (cl-assert (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12)))))
- ;; insert range somewhere in the middle:
- (cl-assert (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12)))))
- ;; consolidate some:
- (cl-assert (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12)))))
- ;; add more:
- (cl-assert (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15
17)))))
- ;; add more:
- (cl-assert (equal (funcall try 20 22)
- '(nil ((1 2) (3 9) (10 12) (15 17) (20 22)))))
- ;; encompass more:
- (cl-assert (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22)))))
- ;; encompass all:
- (cl-assert (equal (funcall try 2 25) '(t ((1 25)))))
-
- ;; fresh slate:
- (setq ranges nil)
- (cl-assert (equal (funcall try 20 25) '(nil ((20 25)))))
- (cl-assert (equal (funcall try 30 35) '(nil ((20 25) (30 35)))))
- (cl-assert (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35)))))
- (cl-assert (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35)))))
- (cl-assert (equal (funcall try 10 30) '(t ((10 35)))))
- (cl-assert (equal (funcall try 5 6) '(nil ((5 6) (10 35)))))
- (cl-assert (equal (funcall try 2 100) '(t ((2 100)))))
-
- (setq ranges nil)
- ))
;;;_ > allout-widgetize-buffer (&optional doing)
(defun allout-widgetize-buffer (&optional doing)
"EXAMPLE FUNCTION. Widgetize items in buffer using allout-chart-subtree.
@@ -2380,18 +2307,6 @@ The elements of LIST are not copied, just the list
structure itself."
(overlays-in start end)))))
(length button-overlays)))
-;;;_ : Run unit tests:
-(defun allout-widgets-run-unit-tests ()
- (message "Running allout-widget tests...")
-
- (allout-test-range-overlaps)
-
- (message "Running allout-widget tests... Done.")
- (sit-for .5))
-
-(when allout-widgets-run-unit-tests-on-load
- (allout-widgets-run-unit-tests))
-
;;;_ : provide
(provide 'allout-widgets)
diff --git a/lisp/allout.el b/lisp/allout.el
index 955b700..044c82a 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -77,7 +77,6 @@
;;;_* Dependency loads
(require 'overlay)
-(eval-when-compile (require 'cl-lib))
;;;_* USER CUSTOMIZATION VARIABLES:
@@ -840,20 +839,6 @@ for restoring when all encryptions are established.")
(defgroup allout-developer nil
"Allout settings developers care about, including topic encryption and more."
:group 'allout)
-;;;_ = allout-run-unit-tests-on-load
-(defcustom allout-run-unit-tests-on-load nil
- "When non-nil, unit tests will be run at end of loading the allout module.
-
-Generally, allout code developers are the only ones who'll want to set this.
-
-\(If set, this makes it an even better practice to exercise changes by
-doing byte-compilation with a repeat count, so the file is loaded after
-compilation.)
-
-See `allout-run-unit-tests' to see what's run."
- :type 'boolean
- :group 'allout-developer)
-
;;;_ + Miscellaneous customization
;;;_ = allout-enable-file-variable-adjustment
@@ -6518,136 +6503,7 @@ If BEG is bigger than END we return 0."
(isearch-repeat 'forward)
(isearch-mode t)))
-;;;_ #11 Unit tests -- this should be last item before "Provide"
-;;;_ > allout-run-unit-tests ()
-(defun allout-run-unit-tests ()
- "Run the various allout unit tests."
- (message "Running allout tests...")
- (allout-test-resumptions)
- (message "Running allout tests... Done.")
- (sit-for .5))
-;;;_ : test resumptions:
-;;;_ > allout-tests-obliterate-variable (name)
-(defun allout-tests-obliterate-variable (name)
- "Completely unbind variable with NAME."
- (if (local-variable-p name (current-buffer)) (kill-local-variable name))
- (while (boundp name) (makunbound name)))
-;;;_ > allout-test-resumptions ()
-(defvar allout-tests-globally-unbound nil
- "Fodder for allout resumptions tests -- defvar just for byte compiler.")
-(defvar allout-tests-globally-true nil
- "Fodder for allout resumptions tests -- defvar just for byte compiler.")
-(defvar allout-tests-locally-true nil
- "Fodder for allout resumptions tests -- defvar just for byte compiler.")
-(defun allout-test-resumptions ()
- ;; FIXME: Use ERT.
- "Exercise allout resumptions."
- ;; for each resumption case, we also test that the right local/global
- ;; scopes are affected during resumption effects:
-
- ;; ensure that previously unbound variables return to the unbound state.
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
- (allout-add-resumptions '(allout-tests-globally-unbound t))
- (cl-assert (not (default-boundp 'allout-tests-globally-unbound)))
- (cl-assert (local-variable-p 'allout-tests-globally-unbound
(current-buffer)))
- (cl-assert (boundp 'allout-tests-globally-unbound))
- (cl-assert (equal allout-tests-globally-unbound t))
- (allout-do-resumptions)
- (cl-assert (not (local-variable-p 'allout-tests-globally-unbound
- (current-buffer))))
- (cl-assert (not (boundp 'allout-tests-globally-unbound))))
-
- ;; ensure that variable with prior global value is resumed
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-globally-true)
- (setq allout-tests-globally-true t)
- (allout-add-resumptions '(allout-tests-globally-true nil))
- (cl-assert (equal (default-value 'allout-tests-globally-true) t))
- (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
- (cl-assert (equal allout-tests-globally-true nil))
- (allout-do-resumptions)
- (cl-assert (not (local-variable-p 'allout-tests-globally-true
- (current-buffer))))
- (cl-assert (boundp 'allout-tests-globally-true))
- (cl-assert (equal allout-tests-globally-true t)))
-
- ;; ensure that prior local value is resumed
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
- (cl-assert (not (default-boundp 'allout-tests-locally-true))
- nil (concat "Test setup mistake -- variable supposed to"
- " not have global binding, but it does."))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))
- nil (concat "Test setup mistake -- variable supposed to have"
- " local binding, but it lacks one."))
- (allout-add-resumptions '(allout-tests-locally-true nil))
- (cl-assert (not (default-boundp 'allout-tests-locally-true)))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true nil))
- (allout-do-resumptions)
- (cl-assert (boundp 'allout-tests-locally-true))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true t))
- (cl-assert (not (default-boundp 'allout-tests-locally-true))))
-
- ;; ensure that last of multiple resumptions holds, for various scopes.
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
- (allout-tests-obliterate-variable 'allout-tests-globally-true)
- (setq allout-tests-globally-true t)
- (allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
- (allout-add-resumptions '(allout-tests-globally-unbound t)
- '(allout-tests-globally-true nil)
- '(allout-tests-locally-true nil))
- (allout-add-resumptions '(allout-tests-globally-unbound 2)
- '(allout-tests-globally-true 3)
- '(allout-tests-locally-true 4))
- ;; reestablish many of the basic conditions are maintained after re-add:
- (cl-assert (not (default-boundp 'allout-tests-globally-unbound)))
- (cl-assert (local-variable-p 'allout-tests-globally-unbound
(current-buffer)))
- (cl-assert (equal allout-tests-globally-unbound 2))
- (cl-assert (default-boundp 'allout-tests-globally-true))
- (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
- (cl-assert (equal allout-tests-globally-true 3))
- (cl-assert (not (default-boundp 'allout-tests-locally-true)))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true 4))
- (allout-do-resumptions)
- (cl-assert (not (local-variable-p 'allout-tests-globally-unbound
- (current-buffer))))
- (cl-assert (not (boundp 'allout-tests-globally-unbound)))
- (cl-assert (not (local-variable-p 'allout-tests-globally-true
- (current-buffer))))
- (cl-assert (boundp 'allout-tests-globally-true))
- (cl-assert (equal allout-tests-globally-true t))
- (cl-assert (boundp 'allout-tests-locally-true))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true t))
- (cl-assert (not (default-boundp 'allout-tests-locally-true))))
-
- ;; ensure that deliberately unbinding registered variables doesn't foul
things
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
- (allout-tests-obliterate-variable 'allout-tests-globally-true)
- (setq allout-tests-globally-true t)
- (allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
- (allout-add-resumptions '(allout-tests-globally-unbound t)
- '(allout-tests-globally-true nil)
- '(allout-tests-locally-true nil))
- (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
- (allout-tests-obliterate-variable 'allout-tests-globally-true)
- (allout-tests-obliterate-variable 'allout-tests-locally-true)
- (allout-do-resumptions))
- )
-;;;_ % Run unit tests if `allout-run-unit-tests-after-load' is true:
-(when allout-run-unit-tests-on-load
- (allout-run-unit-tests))
-
-;;;_ #12 Provide
+;;;_ #11 Provide
(provide 'allout)
;;;_* Local emacs vars.
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 6d8c784..e7e8955 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -863,14 +863,12 @@ Optional arg BUFFER (default: current buffer) is the
buffer to check."
(setq apropos-accumulator (cons (list symb (apropos-score-str var)
nil var)
apropos-accumulator))))))
(let ((apropos-multi-type nil))
- (if (> emacs-major-version 20)
- (apropos-print
- nil "\n----------------\n"
- (format "Buffer `%s' has the following local variables\nmatching
%s`%s':"
- (buffer-name buffer)
- (if (consp pattern) "keywords " "")
- pattern))
- (apropos-print nil "\n----------------\n"))))
+ (apropos-print
+ nil "\n----------------\n"
+ (format "Buffer `%s' has the following local variables\nmatching %s`%s':"
+ (buffer-name buffer)
+ (if (consp pattern) "keywords " "")
+ pattern))))
;;;###autoload
(defun apropos-documentation (pattern &optional do-all)
diff --git a/lisp/cedet/ede/detect.el b/lisp/cedet/ede/detect.el
index b870624..f1152fd 100644
--- a/lisp/cedet/ede/detect.el
+++ b/lisp/cedet/ede/detect.el
@@ -35,16 +35,6 @@
(require 'ede/auto) ;; Autoload settings.
-(when (or (<= emacs-major-version 23)
- ;; predicate as name added in Emacs 24.2
- (and (= emacs-major-version 24)
- (< emacs-minor-version 2)))
- (message "Loading CEDET fallback autoload library.")
- (require 'cedet/dominate
- (expand-file-name "../../../etc/fallback-libraries/dominate.el"
- (file-name-directory load-file-name))))
-
-
;;; BASIC PROJECT SCAN
;;
(defun ede--detect-stop-scan-p (dir)
diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el
index a0af4a4..bcd6721 100644
--- a/lisp/cedet/ede/proj-elisp.el
+++ b/lisp/cedet/ede/proj-elisp.el
@@ -153,18 +153,9 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)."
(let* ((fsrc (expand-file-name src dir))
(elc (concat (file-name-sans-extension fsrc) ".elc")))
(with-no-warnings
- (if (< emacs-major-version 24)
- ;; Does not have `byte-recompile-file'
- (if (or (not (file-exists-p elc))
- (file-newer-than-file-p fsrc elc))
- (progn
- (setq comp (1+ comp))
- (byte-compile-file fsrc))
- (setq utd (1+ utd)))
-
- (if (eq (byte-recompile-file fsrc nil 0) t)
- (setq comp (1+ comp))
- (setq utd (1+ utd)))))))
+ (if (eq (byte-recompile-file fsrc nil 0) t)
+ (setq comp (1+ comp))
+ (setq utd (1+ utd))))))
(oref obj source))
(message "All Emacs Lisp sources are up to date in %s" (eieio-object-name
obj))
diff --git a/lisp/cedet/semantic/bovine/grammar.el
b/lisp/cedet/semantic/bovine/grammar.el
index 7b835b8..10afb06 100644
--- a/lisp/cedet/semantic/bovine/grammar.el
+++ b/lisp/cedet/semantic/bovine/grammar.el
@@ -143,8 +143,7 @@ expanded from elsewhere."
form (cdr form))
;; Hack for dealing with new reading of unquotes outside of
;; backquote (introduced in
2010-12-06T16:37:26Z!monnier@iro.umontreal.ca).
- (when (and (>= emacs-major-version 24)
- (listp first)
+ (when (and (listp first)
(or (equal (car first) '\,)
(equal (car first) '\,@)))
(if (listp (cadr first))
diff --git a/lisp/cedet/semantic/ede-grammar.el
b/lisp/cedet/semantic/ede-grammar.el
index 2464833..d435ff6 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -142,19 +142,10 @@ Lays claim to all -by.el, and -wy.el files."
(match-string 1 package)))
(src (ede-expand-filename obj fname))
(csrc (concat (file-name-sans-extension src) ".elc")))
- (if (< emacs-major-version 24)
- ;; Does not have `byte-recompile-file'
- (if (or (not (file-exists-p csrc))
- (file-newer-than-file-p src csrc))
- (progn
- (setq comp (1+ comp))
- (byte-compile-file src))
- (setq utd (1+ utd)))
- ;; Emacs 24 and newer
- (with-no-warnings
- (if (eq (byte-recompile-file src nil 0) t)
- (setq comp (1+ comp))
- (setq utd (1+ utd))))))))
+ (with-no-warnings
+ (if (eq (byte-recompile-file src nil 0) t)
+ (setq comp (1+ comp))
+ (setq utd (1+ utd)))))))
(oref obj source))
(message "All Semantic Grammar sources are up to date in %s"
(eieio-object-name obj))
(cons comp utd)))
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index 799aa45..809271d 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -1701,9 +1701,6 @@ If there is no error, then the last value of FORMS is
returned."
`(let* ((semantic-lex-unterminated-syntax-end-function
(lambda (,syntax ,start ,end)
(throw ',symbol ,syntax)))
- ;; Delete the below when semantic-flex is fully retired.
- (semantic-flex-unterminated-syntax-end-function
- semantic-lex-unterminated-syntax-end-function)
(,ret (catch ',symbol
(save-excursion
,@forms
diff --git a/lisp/completion.el b/lisp/completion.el
index ed13455..e4a004f 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -399,13 +399,6 @@ Used to decide whether to save completions.")
:up)
(t :neither))))))
-;; Tests -
-;; (cmpl-string-case-type "123ABCDEF456") --> :up
-;; (cmpl-string-case-type "123abcdef456") --> :down
-;; (cmpl-string-case-type "123aBcDeF456") --> :mixed
-;; (cmpl-string-case-type "123456") --> :neither
-;; (cmpl-string-case-type "Abcde123") --> :capitalized
-
(defun cmpl-coerce-string-case (string case-type)
(cond ((eq case-type :down) (downcase string))
((eq case-type :up) (upcase string))
@@ -424,12 +417,6 @@ Used to decide whether to save completions.")
;; as is
string-to-coerce))))
-;; Tests -
-;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456
-;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456
-;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456
-;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456
-
(defun cmpl-hours-since-origin ()
(floor (time-convert nil 'integer) 3600))
@@ -1226,45 +1213,6 @@ String must be longer than
`completion-prefix-min-length'."
(set cmpl-db-prefix-symbol nil)))))
(error "Unknown completion `%s'" completion-string))))
-;; Tests --
-;; - Add and Find -
-;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
-;; (find-exact-completion "banana") --> ("banana" 0 nil 0)
-;; (find-exact-completion "bana") --> nil
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (add-completion-to-head "banish") --> ("banish" 0 nil 0)
-;; (find-exact-completion "banish") --> ("banish" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
-;;
-;; - Deleting -
-;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
-;; (delete-completion "banner")
-;; (find-exact-completion "banner") --> nil
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
-;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
-;; (delete-completion "banana")
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
-;; (delete-completion "banner")
-;; (delete-completion "banish")
-;; (find-cmpl-prefix-entry "ban") --> nil
-;; (delete-completion "banner") --> error
-;;
-;; - Tail -
-;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...))
-;;
-
;;---------------------------------------------------------------------------
;; Database Update :: Interface level routines
@@ -1361,29 +1309,6 @@ Completions added this way will automatically be saved if
(set-completion-num-uses entry 1)
(setq cmpl-completions-accepted-p t)))))))
-;; Tests --
-;; - Add and Find -
-;; (add-completion "banana" 5 10)
-;; (find-exact-completion "banana") --> ("banana" 5 10 0)
-;; (add-completion "banana" 6)
-;; (find-exact-completion "banana") --> ("banana" 6 10 0)
-;; (add-completion "banish")
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
-;;
-;; - Accepting -
-;; (setq completion-to-accept "banana")
-;; (accept-completion)
-;; (find-exact-completion "banana") --> ("banana" 7 10)
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
-;; (setq completion-to-accept "banish")
-;; (add-completion "banner")
-;; (car (find-cmpl-prefix-entry "ban"))
-;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...))
-;;
-;; - Deleting -
-;; (kill-completion "banish")
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...))
-
;;---------------------------------------------------------------------------
;; Searching the database
@@ -1505,46 +1430,6 @@ If there are no more entries, try cdabbrev and then
return only a string."
;; Completely unsuccessful, return nil
))
-;; Tests --
-;; - Add and Find -
-;; (add-completion "banana")
-;; (completion-search-reset "ban")
-;; (completion-search-next 0) --> "banana"
-;;
-;; - Discrimination -
-;; (add-completion "cumberland")
-;; (add-completion "cumberbund")
-;; cumbering
-;; (completion-search-reset "cumb")
-;; (completion-search-peek t) --> "cumberbund"
-;; (completion-search-next 0) --> "cumberbund"
-;; (completion-search-peek t) --> "cumberland"
-;; (completion-search-next 1) --> "cumberland"
-;; (completion-search-peek nil) --> nil
-;; (completion-search-next 2) --> "cumbering" {cdabbrev}
-;; (completion-search-next 3) --> nil or "cumming"{depends on context}
-;; (completion-search-next 1) --> "cumberland"
-;; (completion-search-peek t) --> "cumbering" {cdabbrev}
-;;
-;; - Accepting -
-;; (completion-search-next 1) --> "cumberland"
-;; (setq completion-to-accept "cumberland")
-;; (completion-search-reset "foo")
-;; (completion-search-reset "cum")
-;; (completion-search-next 0) --> "cumberland"
-;;
-;; - Deleting -
-;; (kill-completion "cumberland")
-;; cummings
-;; (completion-search-reset "cum")
-;; (completion-search-next 0) --> "cumberbund"
-;; (completion-search-next 1) --> "cummings"
-;;
-;; - Ignoring Capitalization -
-;; (completion-search-reset "CuMb")
-;; (completion-search-next 0) --> "cumberbund"
-
-
;;-----------------------------------------------
;; COMPLETE
@@ -1733,12 +1618,6 @@ Prefix args ::
"\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*"
"A regexp that searches for Lisp definition form.")
-;; Tests -
-;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8
-;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9
-;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10
-;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9
-
;; Parses all the definition names from a Lisp mode buffer and adds them to
;; the completion database.
(defun add-completions-from-lisp-buffer ()
diff --git a/lisp/dired.el b/lisp/dired.el
index 7839ace..1ed949d 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -4062,10 +4062,10 @@ only in the active region if `dired-mark-region' is
non-nil."
(if fn (backup-file-name-p fn))))
"backup file")))
-(defun dired-change-marks (old new)
+(defun dired-change-marks (&optional old new)
"Change all OLD marks to NEW marks.
OLD and NEW are both characters used to mark files."
- (declare (advertised-calling-convention '(old new) "28.1"))
+ (declare (advertised-calling-convention (old new) "28.1"))
(interactive
(let* ((cursor-in-echo-area t)
(old (progn (message "Change (old mark): ") (read-char)))
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 4987596..8a6c0b9 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1173,7 +1173,8 @@
degrees-to-radians
radians-to-degrees rassq rassoc read-from-string regexp-quote
region-beginning region-end reverse round
- sin sqrt string string< string= string-equal string-lessp
string-to-char
+ sin sqrt string string< string= string-equal string-lessp
+ string-search string-to-char
string-to-number substring
sxhash sxhash-equal sxhash-eq sxhash-eql
symbol-function symbol-name symbol-plist symbol-value
string-make-unibyte
@@ -1263,6 +1264,7 @@
floor ceiling round truncate
ffloor fceiling fround ftruncate
string= string-equal string< string-lessp
+ string-search
consp atom listp nlistp propert-list-p
sequencep arrayp vectorp stringp bool-vector-p hash-table-p
null not
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 8fc8db6..9e38e59 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -510,6 +510,10 @@ Honor most of `eldoc-echo-area-use-multiline-p'."
(> (+ (length single-doc) (length single-doc-sym) 2) width))
single-doc)
((> available 1)
+ ;; The message takes one extra line, so if we don't
+ ;; display that, we have one extra line to use.
+ (unless eldoc-display-truncation-message
+ (setq available (1+ available)))
(with-current-buffer (eldoc-doc-buffer)
(cl-loop
initially
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 8c18557..3559012 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -55,7 +55,7 @@ This affects `insert-parentheses' and `insert-pair'."
"If non-nil, `forward-sexp' delegates to this function.
Should take the same arguments and behave similarly to `forward-sexp'.")
-(defun forward-sexp (&optional arg)
+(defun forward-sexp (&optional arg interactive)
"Move forward across one balanced expression (sexp).
With ARG, do it that many times. Negative arg -N means move
backward across N balanced expressions. This command assumes
@@ -64,23 +64,32 @@ point is not in a string or comment. Calls
If unable to move over a sexp, signal `scan-error' with three
arguments: a message, the start of the obstacle (usually a
parenthesis or list marker of some kind), and end of the
-obstacle."
- (interactive "^p")
- (or arg (setq arg 1))
- (if forward-sexp-function
- (funcall forward-sexp-function arg)
- (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
- (if (< arg 0) (backward-prefix-chars))))
-
-(defun backward-sexp (&optional arg)
+obstacle. If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "^p\nd")
+ (if interactive
+ (condition-case _
+ (forward-sexp arg nil)
+ (scan-error (user-error (if (> arg 0)
+ "No next sexp"
+ "No previous sexp"))))
+ (or arg (setq arg 1))
+ (if forward-sexp-function
+ (funcall forward-sexp-function arg)
+ (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
+ (if (< arg 0) (backward-prefix-chars)))))
+
+(defun backward-sexp (&optional arg interactive)
"Move backward across one balanced expression (sexp).
With ARG, do it that many times. Negative arg -N means
move forward across N balanced expressions.
This command assumes point is not in a string or comment.
-Uses `forward-sexp' to do the work."
- (interactive "^p")
+Uses `forward-sexp' to do the work.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "^p\nd")
(or arg (setq arg 1))
- (forward-sexp (- arg)))
+ (forward-sexp (- arg) interactive))
(defun mark-sexp (&optional arg allow-extend)
"Set mark ARG sexps from point.
@@ -99,50 +108,78 @@ This command assumes point is not in a string or comment."
(set-mark
(save-excursion
(goto-char (mark))
- (forward-sexp arg)
+ (condition-case error
+ (forward-sexp arg)
+ (scan-error
+ (user-error (if (equal (cadr error)
+ "Containing expression ends prematurely")
+ "No more sexp to select"
+ (cadr error)))))
(point))))
(t
(push-mark
(save-excursion
- (forward-sexp (prefix-numeric-value arg))
+ (condition-case error
+ (forward-sexp (prefix-numeric-value arg))
+ (scan-error
+ (user-error (if (equal (cadr error)
+ "Containing expression ends prematurely")
+ "No sexp to select"
+ (cadr error)))))
(point))
nil t))))
-(defun forward-list (&optional arg)
+(defun forward-list (&optional arg interactive)
"Move forward across one balanced group of parentheses.
This command will also work on other parentheses-like expressions
defined by the current language mode.
With ARG, do it that many times.
Negative arg -N means move backward across N groups of parentheses.
-This command assumes point is not in a string or comment."
- (interactive "^p")
- (or arg (setq arg 1))
- (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
-
-(defun backward-list (&optional arg)
+This command assumes point is not in a string or comment.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "^p\nd")
+ (if interactive
+ (condition-case _
+ (forward-list arg nil)
+ (scan-error (user-error (if (> arg 0)
+ "No next group"
+ "No previous group"))))
+ (or arg (setq arg 1))
+ (goto-char (or (scan-lists (point) arg 0) (buffer-end arg)))))
+
+(defun backward-list (&optional arg interactive)
"Move backward across one balanced group of parentheses.
This command will also work on other parentheses-like expressions
defined by the current language mode.
With ARG, do it that many times.
Negative arg -N means move forward across N groups of parentheses.
-This command assumes point is not in a string or comment."
- (interactive "^p")
+This command assumes point is not in a string or comment.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "^p\nd")
(or arg (setq arg 1))
- (forward-list (- arg)))
+ (forward-list (- arg) interactive))
-(defun down-list (&optional arg)
+(defun down-list (&optional arg interactive)
"Move forward down one level of parentheses.
This command will also work on other parentheses-like expressions
defined by the current language mode.
With ARG, do this that many times.
A negative argument means move backward but still go down a level.
-This command assumes point is not in a string or comment."
- (interactive "^p")
- (or arg (setq arg 1))
- (let ((inc (if (> arg 0) 1 -1)))
- (while (/= arg 0)
- (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
- (setq arg (- arg inc)))))
+This command assumes point is not in a string or comment.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "^p\nd")
+ (if interactive
+ (condition-case _
+ (down-list arg nil)
+ (scan-error (user-error "At bottom level")))
+ (or arg (setq arg 1))
+ (let ((inc (if (> arg 0) 1 -1)))
+ (while (/= arg 0)
+ (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
+ (setq arg (- arg inc))))))
(defun backward-up-list (&optional arg escape-strings no-syntax-crossing)
"Move backward out of one level of parentheses.
@@ -229,26 +266,39 @@ point is unspecified."
(or (< inc 0)
(forward-comment 1))
(setf arg (+ arg inc)))
- (signal (car err) (cdr err))))))
+ (if no-syntax-crossing
+ ;; Assume called interactively; don't signal an error.
+ (user-error "At top level")
+ (signal (car err) (cdr err)))))))
(setq arg (- arg inc)))))
-(defun kill-sexp (&optional arg)
+(defun kill-sexp (&optional arg interactive)
"Kill the sexp (balanced expression) following point.
With ARG, kill that many sexps after point.
Negative arg -N means kill N sexps before point.
-This command assumes point is not in a string or comment."
- (interactive "p")
- (let ((opoint (point)))
- (forward-sexp (or arg 1))
- (kill-region opoint (point))))
-
-(defun backward-kill-sexp (&optional arg)
+This command assumes point is not in a string or comment.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "p\nd")
+ (if interactive
+ (condition-case _
+ (kill-sexp arg nil)
+ (scan-error (user-error (if (> arg 0)
+ "No next sexp"
+ "No previous sexp"))))
+ (let ((opoint (point)))
+ (forward-sexp (or arg 1))
+ (kill-region opoint (point)))))
+
+(defun backward-kill-sexp (&optional arg interactive)
"Kill the sexp (balanced expression) preceding point.
With ARG, kill that many sexps before point.
Negative arg -N means kill N sexps after point.
-This command assumes point is not in a string or comment."
- (interactive "p")
- (kill-sexp (- (or arg 1))))
+This command assumes point is not in a string or comment.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "p\nd")
+ (kill-sexp (- (or arg 1)) interactive))
;; After Zmacs:
(defun kill-backward-up-list (&optional arg)
@@ -735,12 +785,37 @@ This command assumes point is not in a string or comment."
(insert-pair arg ?\( ?\)))
(defun delete-pair (&optional arg)
- "Delete a pair of characters enclosing ARG sexps following point.
-A negative ARG deletes a pair of characters around preceding ARG sexps."
- (interactive "p")
- (unless arg (setq arg 1))
- (save-excursion (forward-sexp arg) (delete-char (if (> arg 0) -1 1)))
- (delete-char (if (> arg 0) 1 -1)))
+ "Delete a pair of characters enclosing ARG sexps that follow point.
+A negative ARG deletes a pair around the preceding ARG sexps instead."
+ (interactive "P")
+ (if arg
+ (setq arg (prefix-numeric-value arg))
+ (setq arg 1))
+ (if (< arg 0)
+ (save-excursion
+ (skip-chars-backward " \t")
+ (save-excursion
+ (let ((close-char (char-before)))
+ (forward-sexp arg)
+ (unless (member (list (char-after) close-char)
+ (mapcar (lambda (p)
+ (if (= (length p) 3) (cdr p) p))
+ insert-pair-alist))
+ (error "Not after matching pair"))
+ (delete-char 1)))
+ (delete-char -1))
+ (save-excursion
+ (skip-chars-forward " \t")
+ (save-excursion
+ (let ((open-char (char-after)))
+ (forward-sexp arg)
+ (unless (member (list open-char (char-before))
+ (mapcar (lambda (p)
+ (if (= (length p) 3) (cdr p) p))
+ insert-pair-alist))
+ (error "Not before matching pair"))
+ (delete-char -1)))
+ (delete-char 1))))
(defun raise-sexp (&optional arg)
"Raise ARG sexps higher up the tree."
diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el
index ab98836..08dc8d6 100644
--- a/lisp/erc/erc-status-sidebar.el
+++ b/lisp/erc/erc-status-sidebar.el
@@ -68,7 +68,8 @@
(defcustom erc-status-sidebar-header-line-format nil
"Header line format for the status sidebar."
- :type 'string
+ :type '(choice (const :tag "No header line" nil)
+ string)
:group 'erc-status-sidebar)
(defcustom erc-status-sidebar-width 15
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 4484b95..b114792 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -274,6 +274,7 @@ This can also be a list of the above values."
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command."
:type '(choice string
+ (const :tag "None" nil)
(function-item gnus-display-x-face-in-from)
function)
:version "27.1"
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index ffd26bb..c913002 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -897,9 +897,7 @@ articles in the topic and its subtopics."
(let ((inhibit-read-only t))
(unless gnus-topic-inhibit-change-level
(gnus-group-goto-group (or (car (nth 1 previous)) group))
- (when (and gnus-topic-mode
- gnus-topic-alist
- (not gnus-topic-inhibit-change-level))
+ (when (and gnus-topic-mode gnus-topic-alist (gnus-current-topic))
;; Remove the group from the topics.
(if (and (< oldlevel gnus-level-zombie)
(>= level gnus-level-zombie))
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 4876715..aa9f137 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1177,7 +1177,7 @@ ARG is passed to the first function."
(maphash
(lambda (group active)
(when active
- (insert (format "%s %d %d y\n"
+ (insert (format "%S %d %d y\n"
(if full-names
group
(gnus-group-real-name group))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 16f47c8..2ad479b 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -307,7 +307,7 @@ any confusion."
"Command to take a screenshot.
The command should insert a PNG in the current buffer."
:group 'message-various
- :type '(list string)
+ :type '(repeat string)
:version "28.1")
;;; Start of variables adopted from `message-utils.el'.
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 94dd93b..21206b6 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -203,11 +203,22 @@ as `(keyfunc member)' and the corresponding element is
just
(nnselect-categorize ,articles 'nnselect-article-group
'nnselect-article-id)))
-(define-inline numbers-by-group (articles)
+(define-inline numbers-by-group (articles &optional type)
(inline-quote
- (nnselect-categorize
- ,articles 'nnselect-article-group 'nnselect-article-number)))
-
+ (cond
+ ((eq ,type 'range)
+ (nnselect-categorize (gnus-uncompress-range ,articles)
+ 'nnselect-article-group 'nnselect-article-number))
+ ((eq ,type 'tuple)
+ (nnselect-categorize ,articles
+ #'(lambda (elem)
+ (nnselect-article-group (car elem)))
+ #'(lambda (elem)
+ (cons (nnselect-article-number
+ (car elem)) (cdr elem)))))
+ (t
+ (nnselect-categorize ,articles
+ 'nnselect-article-group 'nnselect-article-number)))))
(defmacro nnselect-add-prefix (group)
"Ensures that the GROUP has an nnselect prefix."
@@ -246,7 +257,8 @@ Returns either the retrieved header format 'nov or 'headers.
If this variable is nil, or if the provided function returns nil,
`gnus-retrieve-headers' will be called instead."
- :version "28.1" :type '(function) :group 'nnselect)
+ :version "28.1"
+ :type '(repeat function))
;; Gnus backend interface functions.
@@ -328,11 +340,13 @@ If this variable is nil, or if the provided function
returns nil,
(nnheader-parse-nov))
(forward-line 1)))
('headers
- (goto-char (point-min))
- (while (not (eobp))
- (nnselect-add-novitem
- (nnheader-parse-head))
- (forward-line 1)))
+ (gnus-run-hooks 'gnus-parse-headers-hook)
+ (let ((nnmail-extra-headers gnus-extra-headers))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (nnselect-add-novitem
+ (nnheader-parse-head))
+ (forward-line 1))))
((pred listp)
(dolist (novitem gnus-headers-retrieved-by)
(nnselect-add-novitem novitem)))
@@ -502,15 +516,15 @@ If this variable is nil, or if the provided function
returns nil,
(list (car artgroup)
(gnus-compress-sequence (sort (cdr artgroup) '<))
action marks))
- (numbers-by-group
- (gnus-uncompress-range range)))))
+ (numbers-by-group range 'range))))
actions)
'car 'cdr)))
(deffoo nnselect-request-update-info (group info &optional _server)
- (let* ((group (nnselect-add-prefix group))
- (gnus-newsgroup-selection (or gnus-newsgroup-selection
- (nnselect-get-artlist group))))
+ (let* ((group (nnselect-add-prefix group))
+ (gnus-newsgroup-selection
+ (or gnus-newsgroup-selection (nnselect-get-artlist group)))
+ newmarks)
(gnus-info-set-marks info nil)
(setf (gnus-info-read info) nil)
(pcase-dolist (`(,artgroup . ,nartids)
@@ -518,30 +532,56 @@ If this variable is nil, or if the provided function
returns nil,
(number-sequence 1 (nnselect-artlist-length
gnus-newsgroup-selection))))
(let* ((gnus-newsgroup-active nil)
- (artids (cl-sort nartids '< :key 'car))
+ (artids (cl-sort nartids #'< :key 'car))
(group-info (gnus-get-info artgroup))
(marks (gnus-info-marks group-info))
(unread (gnus-uncompress-sequence
(gnus-range-difference (gnus-active artgroup)
(gnus-info-read group-info)))))
- (gnus-atomic-progn
- (setf (gnus-info-read info)
- (gnus-add-to-range
- (gnus-info-read info)
- (delq nil
- (mapcar
- #'(lambda (art)
- (unless (memq (cdr art) unread) (car art)))
- artids))))
- (pcase-dolist (`(,type . ,range) marks)
- (setq range (gnus-uncompress-sequence range))
- (gnus-add-marked-articles
- group type
- (delq nil
- (mapcar
- #'(lambda (art)
- (when (memq (cdr art) range)
- (car art))) artids)))))))
+ (setf (gnus-info-read info)
+ (gnus-add-to-range
+ (gnus-info-read info)
+ (delq nil (mapcar
+ #'(lambda (art)
+ (unless (memq (cdr art) unread) (car art)))
+ artids))))
+ (pcase-dolist (`(,type . ,mark-list) marks)
+ (let ((mark-type (gnus-article-mark-to-type type)) new)
+ (when
+ (setq new
+ (delq nil
+ (cond
+ ((eq mark-type 'tuple)
+ (mapcar
+ #'(lambda (id)
+ (let (mark)
+ (when
+ (setq mark (assq (cdr id) mark-list))
+ (cons (car id) (cdr mark)))))
+ artids))
+ (t
+ (setq mark-list
+ (gnus-uncompress-range mark-list))
+ (mapcar
+ #'(lambda (id)
+ (when (memq (cdr id) mark-list)
+ (car id))) artids)))))
+ (let ((previous (alist-get type newmarks)))
+ (if previous
+ (nconc previous new)
+ (push (cons type new) newmarks))))))))
+
+ ;; Clean up the marks: compress lists;
+ (pcase-dolist (`(,type . ,mark-list) newmarks)
+ (let ((mark-type (gnus-article-mark-to-type type)))
+ (unless (eq mark-type 'tuple)
+ (setf (alist-get type newmarks)
+ (gnus-compress-sequence mark-list)))))
+ ;; and ensure an unexist key.
+ (unless (assq 'unexist newmarks)
+ (push (cons 'unexist nil) newmarks))
+
+ (gnus-info-set-marks info newmarks)
(gnus-set-active group (cons 1 (nnselect-artlist-length
gnus-newsgroup-selection)))))
@@ -767,42 +807,61 @@ article came from is also searched."
"Copy mark-lists from GROUP to the originating groups."
(let ((select-unreads (numbers-by-group gnus-newsgroup-unreads))
(select-reads (numbers-by-group
- (gnus-uncompress-range
- (gnus-info-read (gnus-get-info group)))))
+ (gnus-info-read (gnus-get-info group)) 'range))
(select-unseen (numbers-by-group gnus-newsgroup-unseen))
- (gnus-newsgroup-active nil)
- mark-list type-list)
+ (gnus-newsgroup-active nil) mark-list)
+ ;; collect the set of marked article lists categorized by
+ ;; originating groups
(pcase-dolist (`(,mark . ,type) gnus-article-mark-lists)
- (when (setq type-list
- (symbol-value (intern (format "gnus-newsgroup-%s" mark))))
- (push (cons type
- (numbers-by-group
- (gnus-uncompress-range type-list))) mark-list)))
+ (let (type-list)
+ (when (setq type-list
+ (symbol-value (intern (format "gnus-newsgroup-%s" mark))))
+ (push (cons
+ type
+ (numbers-by-group type-list (gnus-article-mark-to-type type)))
+ mark-list))))
+ ;; now work on each originating group one at a time
(pcase-dolist (`(,artgroup . ,artlist)
(numbers-by-group gnus-newsgroup-articles))
(let* ((group-info (gnus-get-info artgroup))
(old-unread (gnus-list-of-unread-articles artgroup))
- newmarked)
+ newmarked delta-marks)
(when group-info
+ ;; iterate over mark lists for this group
(pcase-dolist (`(,_mark . ,type) gnus-article-mark-lists)
- (let ((select-type
- (sort
- (cdr (assoc artgroup (alist-get type mark-list)))
- '<)) list)
- (setq list
- (gnus-uncompress-range
- (gnus-add-to-range
- (gnus-remove-from-range
- (alist-get type (gnus-info-marks group-info))
- artlist)
- select-type)))
-
- (when list
- ;; Get rid of the entries of the articles that have the
- ;; default score.
- (when (and (eq type 'score)
- gnus-save-score
- list)
+ (let ((list (cdr (assoc artgroup (alist-get type mark-list))))
+ (mark-type (gnus-article-mark-to-type type)))
+
+ ;; When the backend can store marks we collect any
+ ;; changes. Unlike a normal group the mark lists only
+ ;; include marks for articles we retrieved.
+ (when (and (gnus-check-backend-function
+ 'request-set-mark artgroup)
+ (not (gnus-article-unpropagatable-p type)))
+ (let* ((old (gnus-list-range-intersection
+ artlist
+ (alist-get type (gnus-info-marks group-info))))
+ (del (gnus-remove-from-range (copy-tree old) list))
+ (add (gnus-remove-from-range (copy-tree list) old)))
+ (when add (push (list add 'add (list type)) delta-marks))
+ (when del
+ ;; Don't delete marks from outside the active range.
+ ;; This shouldn't happen, but is a sanity check.
+ (setq del (gnus-sorted-range-intersection
+ (gnus-active artgroup) del))
+ (push (list del 'del (list type)) delta-marks))))
+
+ ;; Marked sets are of mark-type 'tuple, 'list, or
+ ;; 'range. We merge the lists with what is already in
+ ;; the original info to get full list of new marks. We
+ ;; do this by removing all the articles we retrieved
+ ;; from the full list, and then add back in the newly
+ ;; marked ones.
+ (cond
+ ((eq mark-type 'tuple)
+ ;; Get rid of the entries that have the default
+ ;; score.
+ (when (and list (eq type 'score) gnus-save-score)
(let* ((arts list)
(prev (cons nil list))
(all prev))
@@ -812,30 +871,41 @@ article came from is also searched."
(setcdr prev (cdr arts))
(setq prev arts))
(setq arts (cdr arts)))
- (setq list (cdr all)))))
-
- (when (or (eq (gnus-article-mark-to-type type) 'list)
- (eq (gnus-article-mark-to-type type) 'range))
+ (setq list (cdr all))))
+ ;; now merge with the original list and sort just to
+ ;; make sure
(setq list
- (gnus-compress-sequence (sort list '<) t)))
-
- ;; When exiting the group, everything that's previously been
- ;; unseen is now seen.
- (when (eq type 'seen)
- (setq list (gnus-range-add
- list (cdr (assoc artgroup select-unseen)))))
+ (sort (map-merge
+ 'list list
+ (alist-get type (gnus-info-marks group-info)))
+ (lambda (elt1 elt2)
+ (< (car elt1) (car elt2))))))
+ (t
+ (setq list
+ (gnus-compress-sequence
+ (gnus-sorted-union
+ (gnus-sorted-difference
+ (gnus-uncompress-sequence
+ (alist-get type (gnus-info-marks group-info)))
+ artlist)
+ (sort list #'<)) t)))
+
+ ;; When exiting the group, everything that's previously been
+ ;; unseen is now seen.
+ (when (eq type 'seen)
+ (setq list (gnus-range-add
+ list (cdr (assoc artgroup select-unseen))))))
(when (or list (eq type 'unexist))
- (push (cons type list) newmarked))))
+ (push (cons type list) newmarked)))) ;; end of mark-type loop
- (gnus-atomic-progn
- ;; Enter these new marks into the info of the group.
- (if (nthcdr 3 group-info)
- (setcar (nthcdr 3 group-info) newmarked)
- ;; Add the marks lists to the end of the info.
- (when newmarked
- (setcdr (nthcdr 2 group-info) (list newmarked))))
+ (when delta-marks
+ (unless (gnus-check-group artgroup)
+ (error "Can't open server for %s" artgroup))
+ (gnus-request-set-mark artgroup delta-marks))
+ (gnus-atomic-progn
+ (gnus-info-set-marks group-info newmarked)
;; Cut off the end of the info if there's nothing else there.
(let ((i 5))
(while (and (> i 2)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 5cb1c5e..88984ec 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -627,7 +627,7 @@ FILE is the file where FUNCTION was probably defined."
;; of the *packages* in which the function is defined.
(let* ((name (symbol-name symbol))
(re (concat "\\_<" (regexp-quote name) "\\_>"))
- (news (directory-files data-directory t "\\`NEWS\\.[1-9]"))
+ (news (directory-files data-directory t "\\`NEWS\\($\\|\\.\\)"))
(place nil)
(first nil))
(with-temp-buffer
diff --git a/lisp/info.el b/lisp/info.el
index e4f75b4..20633fd 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -4053,6 +4053,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map "^" 'Info-up)
(define-key map "," 'Info-index-next)
(define-key map "\177" 'Info-scroll-down)
+ (define-key map [remap goto-line] 'goto-line-relative)
(define-key map [mouse-2] 'Info-mouse-follow-nearest-node)
(define-key map [follow-link] 'mouse-face)
(define-key map [XF86Back] 'Info-history-back)
diff --git a/lisp/man.el b/lisp/man.el
index 5ee60ca..bd55d7e 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -927,15 +927,18 @@ foo(sec)[, bar(sec) [, ...]] [other stuff] - description"
;; run differently in Man-getpage-in-background, an error
;; here may not necessarily mean that we'll also get an
;; error later.
- (ignore-errors
- (call-process manual-program nil '(t nil) nil
- "-k" (concat (when (or Man-man-k-use-anchor
- (string-equal prefix ""))
- "^")
- prefix))))
- (setq table (Man-parse-man-k)))
+ (when (eq 0
+ (ignore-errors
+ (call-process
+ manual-program nil '(t nil) nil
+ "-k" (concat (when (or Man-man-k-use-anchor
+ (string-equal prefix ""))
+ "^")
+ prefix))))
+ (setq table (Man-parse-man-k)))))
;; Cache the table for later reuse.
- (setq Man-completion-cache (cons prefix table)))
+ (when table
+ (setq Man-completion-cache (cons prefix table))))
;; The table may contain false positives since the match is made
;; by "man -k" not just on the manpage's name.
(if section
diff --git a/lisp/misc.el b/lisp/misc.el
index 8c39492..be191c5 100644
--- a/lisp/misc.el
+++ b/lisp/misc.el
@@ -69,7 +69,9 @@ The characters copied are inserted in the buffer before
point."
Case is ignored if `case-fold-search' is non-nil in the current buffer.
Goes backward if ARG is negative; error if CHAR not found.
Ignores CHAR at point."
- (interactive "p\ncZap up to char: ")
+ (interactive (list (prefix-numeric-value current-prefix-arg)
+ (read-char-from-minibuffer "Zap up to char: "
+ nil 'read-char-history)))
(let ((direction (if (>= arg 0) 1 -1)))
(kill-region (point)
(progn
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 32fde0d..c6a7391 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -85,7 +85,7 @@ set to the event sent when clicking on the mouse wheel
button."
:type 'number)
(defcustom mouse-wheel-scroll-amount
- '(5 ((shift) . 1) ((meta) . nil) ((control) . text-scale))
+ '(1 ((shift) . hscroll) ((meta) . nil) ((control) . text-scale))
"Amount to scroll windows by when spinning the mouse wheel.
This is an alist mapping the modifier key to the amount to scroll when
the wheel is moved with the modifier key depressed.
@@ -97,6 +97,9 @@ screen. It can also be a floating point number, specifying
the fraction of
a full screen to scroll. A near full screen is `next-screen-context-lines'
less than a full screen.
+If AMOUNT is the symbol 'hscroll', this means that with MODIFIER,
+the mouse wheel will scroll horizontally instead of vertically.
+
If AMOUNT is the symbol text-scale, this means that with
MODIFIER, the mouse wheel will change the face height instead of
scrolling."
@@ -123,9 +126,10 @@ scrolling."
(const :tag "Scroll full screen" :value nil)
(integer :tag "Scroll specific # of lines")
(float :tag "Scroll fraction of window")
+ (const :tag "Scroll horizontally" :value hscroll)
(const :tag "Change face size" :value text-scale)))))
:set 'mouse-wheel-change-button
- :version "27.1")
+ :version "28.1")
(defcustom mouse-wheel-progressive-speed t
"If non-nil, the faster the user moves the wheel, the faster the scrolling.
@@ -270,7 +274,11 @@ non-Windows systems."
(condition-case nil
(unwind-protect
(let ((button (mwheel-event-button event)))
- (cond ((eq button mouse-wheel-down-event)
+ (cond ((and (eq amt 'hscroll) (eq button mouse-wheel-down-event))
+ (funcall (if mouse-wheel-flip-direction
+ mwheel-scroll-left-function
+ mwheel-scroll-right-function) 1))
+ ((eq button mouse-wheel-down-event)
(condition-case nil (funcall mwheel-scroll-down-function
amt)
;; Make sure we do indeed scroll to the beginning of
;; the buffer.
@@ -285,7 +293,11 @@ non-Windows systems."
;; for a reason that escapes me. This problem seems
;; to only affect scroll-down. --Stef
(set-window-start (selected-window) (point-min))))))
- ((eq button mouse-wheel-up-event)
+ ((and (eq amt 'hscroll) (eq button mouse-wheel-up-event))
+ (funcall (if mouse-wheel-flip-direction
+ mwheel-scroll-right-function
+ mwheel-scroll-left-function) 1))
+ ((eq button mouse-wheel-up-event)
(condition-case nil (funcall mwheel-scroll-up-function
amt)
;; Make sure we do indeed scroll to the end of the
buffer.
(end-of-buffer (while t (funcall
mwheel-scroll-up-function)))))
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 86db7cb..da47e5b 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -144,6 +144,17 @@ See URL
`https://dbus.freedesktop.org/doc/dbus-specification.html#standard-inter
;; </signal>
;; </interface>
+(defconst dbus-interface-monitoring (concat dbus-interface-dbus ".Monitoring")
+ "The monitoring interface.
+See URL
`https://dbus.freedesktop.org/doc/dbus-specification.html#bus-messages-become-monitor'.")
+
+;; <interface name="org.freedesktop.DBus.Monitoring">
+;; <method name="BecomeMonitor">
+;; <arg name="rule" type="as" direction="in"/>
+;; <arg name="flags" type="u" direction="in"/> ;; Not used, must be 0.
+;; </method>
+;; </interface>
+
(defconst dbus-interface-local (concat dbus-interface-dbus ".Local")
"An interface whose methods can only be invoked by the local
implementation.")
@@ -336,7 +347,8 @@ object is returned instead of a list containing this single
Lisp object.
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
@@ -440,7 +452,8 @@ Example:
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
@@ -490,7 +503,8 @@ Example:
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (null service) (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
@@ -510,7 +524,8 @@ This is an internal function, it shall not be used outside
dbus.el."
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
@@ -527,7 +542,8 @@ This is an internal function, it shall not be used outside
dbus.el."
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
@@ -545,7 +561,8 @@ This is an internal function, it shall not be used outside
dbus.el."
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
@@ -1018,19 +1035,29 @@ STRING must have been encoded with
`dbus-escape-as-identifier'."
"Check whether EVENT is a well formed D-Bus event.
EVENT is a list which starts with symbol `dbus-event':
- (dbus-event BUS TYPE SERIAL SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS)
+ (dbus-event BUS TYPE SERIAL SERVICE DESTINATION PATH
+ INTERFACE MEMBER HANDLER &rest ARGS)
BUS identifies the D-Bus the message is coming from. It is
-either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. TYPE is the D-Bus message type which
-has caused the event, SERIAL is the serial number of the received
-D-Bus message. SERVICE and PATH are the unique name and the
-object path of the D-Bus object emitting the message. INTERFACE
-and MEMBER denote the message which has been sent. HANDLER is
-the function which has been registered for this message. ARGS
-are the typed arguments as returned from the message. They are
-passed to HANDLER without type information, when it is called
-during event handling in `dbus-handle-event'.
+either a Lisp symbol, `:system', `:session', `:systemp-private'
+or `:session-private', or a string denoting the bus address.
+
+TYPE is the D-Bus message type which has caused the event, SERIAL
+is the serial number of the received D-Bus message when TYPE is
+equal `dbus-message-type-method-return' or `dbus-message-type-error'.
+
+SERVICE and PATH are the unique name and the object path of the
+D-Bus object emitting the message. DESTINATION is the D-Bus name
+the message is dedicated to, or nil in case thje message is a
+broadcast signal.
+
+INTERFACE and MEMBER denote the message which has been sent.
+When TYPE is `dbus-message-type-error', MEMBER is the error name.
+
+HANDLER is the function which has been registered for this
+message. ARGS are the typed arguments as returned from the
+message. They are passed to HANDLER without type information,
+when it is called during event handling in `dbus-handle-event'.
This function signals a `dbus-error' if the event is not well
formed."
@@ -1038,7 +1065,7 @@ formed."
(unless (and (listp event)
(eq (car event) 'dbus-event)
;; Bus symbol.
- (or (symbolp (nth 1 event))
+ (or (keywordp (nth 1 event))
(stringp (nth 1 event)))
;; Type.
(and (natnump (nth 2 event))
@@ -1050,20 +1077,26 @@ formed."
(= dbus-message-type-error (nth 2 event))
(or (stringp (nth 4 event))
(null (nth 4 event))))
- ;; Object path.
+ ;; Destination.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
- (stringp (nth 5 event)))
- ;; Interface.
+ (or (stringp (nth 5 event))
+ (null (nth 5 event))))
+ ;; Object path.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
(stringp (nth 6 event)))
- ;; Member.
+ ;; Interface.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
(stringp (nth 7 event)))
+ ;; Member.
+ (or (= dbus-message-type-method-return (nth 2 event))
+ (stringp (nth 8 event)))
;; Handler.
- (functionp (nth 8 event)))
+ (functionp (nth 9 event))
+ ;; Arguments.
+ (listp (nthcdr 10 event)))
(signal 'dbus-error (list "Not a valid D-Bus event" event))))
(defun dbus-delete-types (&rest args)
@@ -1103,28 +1136,36 @@ part of the event, is called with arguments ARGS
(without type information).
If the HANDLER returns a `dbus-error', it is propagated as return message."
(interactive "e")
(condition-case err
- (let (args result)
+ (let (monitor args result)
;; We ignore not well-formed events.
(dbus-check-event event)
;; Remove type information.
- (setq args (mapcar #'dbus-delete-types (nthcdr 9 event)))
- ;; Error messages must be propagated.
- (when (= dbus-message-type-error (nth 2 event))
- (signal 'dbus-error args))
- ;; Apply the handler.
- (setq result (apply (nth 8 event) args))
- ;; Return an (error) message when it is a message call.
- (when (= dbus-message-type-method-call (nth 2 event))
- (dbus-ignore-errors
- (if (eq (car-safe result) :error)
- (apply #'dbus-method-error-internal
- (nth 1 event) (nth 4 event) (nth 3 event) (cdr result))
- (if (eq result :ignore)
- (dbus-method-return-internal
- (nth 1 event) (nth 4 event) (nth 3 event))
- (apply #'dbus-method-return-internal
- (nth 1 event) (nth 4 event) (nth 3 event)
- (if (consp result) result (list result))))))))
+ (setq args (mapcar #'dbus-delete-types (nthcdr 10 event)))
+ (setq monitor
+ (gethash
+ (list :monitor (nth 1 event)) dbus-registered-objects-table))
+ (if monitor
+ ;; A monitor event shall not trigger other operations, and
+ ;; it shall not trigger D-Bus errors.
+ (setq result (dbus-ignore-errors (apply (nth 9 event) args)))
+ ;; Error messages must be propagated. The error name is in
+ ;; the member slot.
+ (when (= dbus-message-type-error (nth 2 event))
+ (signal 'dbus-error (cons (nth 8 event) args)))
+ ;; Apply the handler.
+ (setq result (apply (nth 9 event) args))
+ ;; Return an (error) message when it is a message call.
+ (when (= dbus-message-type-method-call (nth 2 event))
+ (dbus-ignore-errors
+ (if (eq (car-safe result) :error)
+ (apply #'dbus-method-error-internal
+ (nth 1 event) (nth 4 event) (nth 3 event) (cdr result))
+ (if (eq result :ignore)
+ (dbus-method-return-internal
+ (nth 1 event) (nth 4 event) (nth 3 event))
+ (apply #'dbus-method-return-internal
+ (nth 1 event) (nth 4 event) (nth 3 event)
+ (if (consp result) result (list result)))))))))
;; Error handling.
(dbus-error
;; Return an error message when it is a message call.
@@ -1172,13 +1213,21 @@ formed."
(dbus-check-event event)
(nth 4 event))
+(defun dbus-event-destination-name (event)
+ "Return the name of the D-Bus object the event is dedicated to.
+The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
+This function signals a `dbus-error' if the event is not well
+formed."
+ (dbus-check-event event)
+ (nth 5 event))
+
(defun dbus-event-path-name (event)
"Return the object path of the D-Bus object the event is coming from.
The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
This function signals a `dbus-error' if the event is not well
formed."
(dbus-check-event event)
- (nth 5 event))
+ (nth 6 event))
(defun dbus-event-interface-name (event)
"Return the interface name of the D-Bus object the event is coming from.
@@ -1186,15 +1235,32 @@ The result is a string. EVENT is a D-Bus event, see
`dbus-check-event'.
This function signals a `dbus-error' if the event is not well
formed."
(dbus-check-event event)
- (nth 6 event))
+ (nth 7 event))
(defun dbus-event-member-name (event)
"Return the member name the event is coming from.
-It is either a signal name or a method name. The result is a
-string. EVENT is a D-Bus event, see `dbus-check-event'. This
-function signals a `dbus-error' if the event is not well formed."
+It is either a signal name, a method name or an error name. The
+result is a string. EVENT is a D-Bus event, see
+`dbus-check-event'. This function signals a `dbus-error' if the
+event is not well formed."
(dbus-check-event event)
- (nth 7 event))
+ (nth 8 event))
+
+(defun dbus-event-handler (event)
+ "Return the handler the event is applied with.
+The result is a function. EVENT is a D-Bus event, see
+`dbus-check-event'. This function signals a `dbus-error' if the
+event is not well formed."
+ (dbus-check-event event)
+ (nth 9 event))
+
+(defun dbus-event-arguments (event)
+ "Return the arguments the event is carrying on.
+The result is a list of arguments. EVENT is a D-Bus event, see
+`dbus-check-event'. This function signals a `dbus-error' if the
+event is not well formed."
+ (dbus-check-event event)
+ (nthcdr 10 event))
;;; D-Bus registered names.
@@ -1717,7 +1783,7 @@ It will be registered for all objects created by
`dbus-register-property'."
;; "Set" needs the third typed argument from `last-input-event'.
((string-equal method "Set")
- (let* ((value (dbus-flatten-types (nth 11 last-input-event)))
+ (let* ((value (dbus-flatten-types (nth 12 last-input-event)))
(entry (dbus-get-this-registered-property
bus service path interface property))
(object (car (last (car entry)))))
@@ -1907,13 +1973,123 @@ It will be registered for all objects created by
`dbus-register-service'."
result)
'(:signature "{oa{sa{sv}}}"))))))
+(defun dbus-register-monitor
+ (bus &optional service path interface member handler &rest args)
+ "Register HANDLER for monitor events on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name of the D-Bus. It must be a
+known name (see discussion of DONT-REGISTER-SERVICE below).
+
+PATH is the D-Bus object path SERVICE is registered at (see
+discussion of DONT-REGISTER-SERVICE below). INTERFACE is the
+name of the interface used at PATH. MEMBER is either a method
+name, a signal name, or an error name.
+
+HANDLER is the function to be called when a monitor event
+arrives. If nil, the default handler `dbus-monitor-handler' is
+applied. It is called with ARGS as arguments."
+
+ (let ((bus-private (if (eq bus :system) :system-private
+ (if (eq bus :session) :session-private bus)))
+ keyword type rule1 rule2 key key1 value)
+ (unless handler (setq handler #'dbus-monitor-handler))
+ ;; Read arguments.
+ (while args
+ (when (keywordp (setq keyword (pop args)))
+ (cond
+ ((eq :type keyword)
+ ;; Must be "signal", "method_call", "method_return", or "error".
+ (setq type (pop args))))))
+ ;; Compose rules.
+ (setq rule1
+ (or
+ (string-join
+ (delq nil
+ (list (when service (format "sender='%s'" service))
+ (when path (format "path='%s'" path))
+ (when interface (format "interface='%s'" interface))
+ (when member (format "member='%s'" member))
+ (when type (format "type='%s'" type))))
+ ",")
+ "")
+ rule2
+ (when service
+ (string-join
+ (delq nil
+ (list (format "destination='%s'" service)
+ (when path (format "path='%s'" path))
+ (when interface (format "interface='%s'" interface))
+ (when member (format "member='%s'" member))
+ (when type (format "type='%s'" type))))
+ ",")))
+
+ (unless (ignore-errors (dbus-get-unique-name bus-private))
+ (dbus-init-bus bus 'private))
+ (dbus-call-method
+ bus-private dbus-service-dbus dbus-path-dbus dbus-interface-monitoring
+ "BecomeMonitor"
+ (append `(:array :string ,rule1) (when rule2 `(:string ,rule2)))
+ :uint32 0)
+
+ (when dbus-debug (message "Matching rule \"%s\" created" rule1))
+
+ ;; Create a hash table entry.
+ (setq key (list :monitor bus-private)
+ key1 (list nil nil nil handler)
+ value (gethash key dbus-registered-objects-table))
+ (unless (member key1 value)
+ (puthash key (cons key1 value) dbus-registered-objects-table))
+
+ (when dbus-debug (message "%s" dbus-registered-objects-table))
+
+ ;; Return the object.
+ (list key (list service path handler))))
+
+(defun dbus-monitor-handler (&rest _args)
+ "Default handler for the \"org.freedesktop.DBus.Monitoring.BecomeMonitor\"
interface.
+It will be applied all objects created by `dbus-register-monitor'."
+ (with-current-buffer (get-buffer-create "*D-Bus Monitor*")
+ (special-mode)
+ (let* ((inhibit-read-only t)
+ (eobp (eobp))
+ (event last-input-event)
+ (type (dbus-event-message-type event))
+ (sender (dbus-event-service-name event))
+ (destination (dbus-event-destination-name event))
+ (serial (dbus-event-serial-number event))
+ (path (dbus-event-path-name event))
+ (interface (dbus-event-interface-name event))
+ (member (dbus-event-member-name event))
+ (arguments (dbus-event-arguments event)))
+ (save-excursion
+ (goto-char (point-max))
+ (insert
+ (format
+ (concat
+ "%s sender=%s -> destination=%s serial=%s "
+ "path=%s interface=%s member=%s\n")
+ (cond
+ ((= type dbus-message-type-method-call) "method-call")
+ ((= type dbus-message-type-method-return) "method-return")
+ ((= type dbus-message-type-error) "error")
+ ((= type dbus-message-type-signal) "signal"))
+ sender destination serial path interface member))
+ (dolist (arg arguments)
+ (pp (dbus-flatten-types arg) (current-buffer)))
+ (insert "\n"))
+ (when eobp
+ (goto-char (point-max))))))
+
(defun dbus-handle-bus-disconnect ()
"React to a bus disconnection.
BUS is the bus that disconnected. This routine unregisters all
handlers on the given bus and causes all synchronous calls
pending at the time of disconnect to fail."
(let ((bus (dbus-event-bus-name last-input-event))
- (keys-to-remove))
+ keys-to-remove)
(maphash
(lambda (key value)
(when (and (eq (nth 0 key) :serial)
@@ -1923,13 +2099,14 @@ pending at the time of disconnect to fail."
(list 'dbus-event
bus
dbus-message-type-error
- (nth 2 key)
- nil
- nil
- nil
- nil
- value)
- (list 'dbus-error "Bus disconnected" bus))
+ (nth 2 key) ; serial
+ nil ; service
+ nil ; destination
+ nil ; path
+ nil ; interface
+ nil ; member
+ value) ; handler
+ (list 'dbus-error dbus-error-disconnected "Bus disconnected" bus))
(push key keys-to-remove)))
dbus-registered-objects-table)
(dolist (key keys-to-remove)
@@ -1980,13 +2157,9 @@ this connection to those buses."
;;; TODO:
-;; * Check property type in org.freedesktop.DBus.Properties.Set.
-;;
;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and
;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved.
;;
-;; * Implement org.freedesktop.DBus.Monitoring.BecomeMonitor.
-;;
;; * Cache introspection data.
;;
;; * Run handlers in own threads.
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index dcb6415..88e6917 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -555,7 +555,10 @@ size, and full-buffer size."
;; If the element was empty, we don't have anything to put the
;; anchor on. So just insert a dummy character.
(when (= start (point))
- (insert ? )
+ (if (not (bolp))
+ (insert ? )
+ (insert ? )
+ (shr-mark-fill start))
(put-text-property (1- (point)) (point) 'display ""))
(put-text-property start (1+ start) 'shr-target-id id))
;; If style is set, then this node has set the color.
@@ -675,8 +678,11 @@ size, and full-buffer size."
(goto-char start)
(when (looking-at "[ \t\n\r]+")
(replace-match "" t t))
- (while (re-search-forward "[ \t\n\r]+" nil t)
+ (while (re-search-forward "[\t\n\r]+" nil t)
(replace-match " " t t))
+ (goto-char start)
+ (while (re-search-forward " +" nil t)
+ (replace-match " " t t))
(shr--translate-insertion-chars)
(goto-char (point-max)))
;; We may have removed everything we inserted if it was just
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index 7425e87..bb74f47 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -1716,6 +1716,7 @@ This is a specialization of `soap-encode-value' for
((and (not (eq indicator 'choice))
(= instance-count 0)
(not (soap-xs-element-optional? element))
+ (not (soap-xs-complex-type-optional? type))
(and (soap-xs-complex-type-p element-type)
(not (soap-xs-complex-type-optional-p
element-type))))
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index c9788fc..3e96daa 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -120,7 +120,7 @@ initializing a new crypted remote directory."
"Whether to keep the encfs configuration file in the crypted remote
directory."
:group 'tramp
:version "28.1"
- :type 'booleanp)
+ :type 'boolean)
;;;###tramp-autoload
(defvar tramp-crypt-directories nil
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 7a3f3fe..a51edae 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -118,7 +118,9 @@ detected as prompt when being sent on echoing hosts,
therefore.")
;;;###tramp-autoload
(defcustom tramp-use-ssh-controlmaster-options t
- "Whether to use `tramp-ssh-controlmaster-options'."
+ "Whether to use `tramp-ssh-controlmaster-options'.
+Set it to nil, if you use Control* or Proxy* options in your ssh
+configuration."
:group 'tramp
:version "24.4"
:type 'boolean)
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index 9b74eb9..74e6c2d 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -635,6 +635,8 @@ FILE is created there."
(save-excursion
(setq file (expand-file-name file (or directory
temporary-file-directory)))
+ (unless (file-exists-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
(find-file-other-window file)
(setq buffer-read-only nil)
(goto-char (point-max))
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 24e1f88..29adf3b 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -720,9 +720,8 @@ imenu."
"Major mode menu."
`("Antlr"
,@(if (cond-emacs-xemacs
- :EMACS (and antlr-options-use-submenus
- (>= emacs-major-version 21))
- :XEMACS antlr-options-use-submenus)
+ :EMACS antlr-options-use-submenus
+ :XEMACS antlr-options-use-submenus)
`(("Insert File Option"
:filter ,(lambda (x) (antlr-options-menu-filter 1 x)))
("Insert Grammar Option"
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 7ac5405..a408d16 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -64,7 +64,8 @@ If nil, use Emacs default."
If the replacement is nil, the file will not be considered an
error after all. If not nil, it should be a regexp replacement
string."
- :type '(repeat (list regexp string))
+ :type '(repeat (list regexp (choice (const :tag "No replacement" nil)
+ string)))
:version "27.1")
(defvar compilation-filter-hook nil
@@ -449,6 +450,9 @@ during global destruction\\.$\\)" 1 2)
\\([0-9]+\\) of file://\\(.+\\)"
4 2 3 (1))
+ (shellcheck
+ "^In \\(.+\\) line \\([0-9]+\\):" 1 2)
+
(sparc-pascal-file
"^\\w\\w\\w \\w\\w\\w +[0-3]?[0-9] +[0-2][0-9]:[0-5][0-9]:[0-5][0-9]\
[12][09][0-9][0-9] +\\(.*\\):$"
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 8d6f8af..086f0b6 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -643,13 +643,14 @@ and looks under `gdb-window-configuration-directory'.
Note that this variable only takes effect when variable
`gdb-many-windows' is t."
- :type 'string
+ :type '(choice (const :tag "None" nil)
+ string)
:group 'gdb
:version "28.1")
(defcustom gdb-display-source-buffer-action '(nil . ((inhibit-same-window .
t)))
"`display-buffer' action used when GDB displays a source buffer."
- :type 'list
+ :type 'sexp
:group 'gdb
:version "28.1")
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 90e5694..121f5d6 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -6727,8 +6727,7 @@ accumulate information on matching completions."
(not super-classes))) ; no possibilities for inheritance
;; In these cases, we do not have to do anything
list
- (let* ((do-prop (and (>= show-classes 0)
- (>= emacs-major-version 21)))
+ (let* ((do-prop (>= show-classes 0))
(do-buf (not (= show-classes 0)))
(do-dots t)
(inherit (if (and (not (eq type 'class-tag)) super-classes)
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index fa281dd..124f652 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -776,12 +776,6 @@ This is really kludgy, and unneeded (i.e. obsolete) in
Emacs>=24."
(modify-syntax-entry ?> "." table)
(modify-syntax-entry ?| "." table)
(modify-syntax-entry ?\' "\"" table)
-
- ;; Any better way to handle the 0'<char> construct?!?
- (when (and prolog-char-quote-workaround
- (not (fboundp 'syntax-propertize-rules)))
- (modify-syntax-entry ?0 "\\" table))
-
(modify-syntax-entry ?% "<" table)
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?* ". 23b" table)
@@ -1047,21 +1041,19 @@ VERSION is of the format (Major . Minor)"
alist)))
(defconst prolog-syntax-propertize-function
- (when (fboundp 'syntax-propertize-rules)
- (syntax-propertize-rules
- ;; GNU Prolog only accepts 0'\' rather than 0'', but the only
- ;; possible meaning of 0'' is rather clear.
- ("\\<0\\(''?\\)"
- (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
- (string-to-syntax "_"))))
- ;; We could check that we're not inside an atom, but I don't think
- ;; that 'foo 8'z could be a valid syntax anyway, so why bother?
- ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_"))
- ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal
- ;; escape sequences in atoms, so be careful not to let the terminating \
- ;; escape a subsequent quote.
- ("\\\\[x0-7][[:xdigit:]]*\\(\\\\\\)" (1 "_"))
- )))
+ (syntax-propertize-rules
+ ;; GNU Prolog only accepts 0'\' rather than 0'', but the only
+ ;; possible meaning of 0'' is rather clear.
+ ("\\<0\\(''?\\)"
+ (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
+ (string-to-syntax "_"))))
+ ;; We could check that we're not inside an atom, but I don't think
+ ;; that 'foo 8'z could be a valid syntax anyway, so why bother?
+ ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_"))
+ ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal
+ ;; escape sequences in atoms, so be careful not to let the terminating \
+ ;; escape a subsequent quote.
+ ("\\\\[x0-7][[:xdigit:]]*\\(\\\\\\)" (1 "_"))))
(defun prolog-mode-variables ()
"Set some common variables to Prolog code specific values."
@@ -1886,14 +1878,7 @@ Argument BOUND is a buffer position limiting searching."
bound t)))
point))
-(defsubst prolog-face-name-p (facename)
- ;; Return t if FACENAME is the name of a face. This method is
- ;; necessary since facep in XEmacs only returns t for the actual
- ;; face objects (while it's only their names that are used just
- ;; about anywhere else) without providing a predicate that tests
- ;; face names. This function (including the above commentary) is
- ;; borrowed from cc-mode.
- (memq facename (face-list)))
+(define-obsolete-function-alias 'prolog-face-name-p 'facep "28.1")
;; Set everything up
(defun prolog-font-lock-keywords ()
@@ -1928,6 +1913,8 @@ Argument BOUND is a buffer position limiting searching."
(t (:underline t)))
"Face name to use for compiler warnings."
:group 'prolog-faces)
+ (define-obsolete-face-alias 'prolog-warning-face
+ 'font-lock-warning-face "28.1")
(defface prolog-builtin-face
'((((class color) (background light)) (:foreground "Purple"))
(((class color) (background dark)) (:foreground "Cyan"))
@@ -1937,15 +1924,11 @@ Argument BOUND is a buffer position limiting searching."
(t (:bold t)))
"Face name to use for compiler warnings."
:group 'prolog-faces)
- (defvar prolog-warning-face
- (if (prolog-face-name-p 'font-lock-warning-face)
- 'font-lock-warning-face
- 'prolog-warning-face)
+ (define-obsolete-face-alias 'prolog-builtin-face
+ 'font-lock-builtin-face "28.1")
+ (defvar prolog-warning-face 'font-lock-warning-face
"Face name to use for built in predicates.")
- (defvar prolog-builtin-face
- (if (prolog-face-name-p 'font-lock-builtin-face)
- 'font-lock-builtin-face
- 'prolog-builtin-face)
+ (defvar prolog-builtin-face 'font-lock-builtin-face
"Face name to use for built in predicates.")
(defvar prolog-redo-face 'prolog-redo-face
"Face name to use for redo trace lines.")
@@ -2291,12 +2274,12 @@ between them)."
(progn
(goto-char cbeg)
(search-forward-regexp "%+[ \t]*" end t)
- (prolog-replace-in-string (buffer-substring beg (point))
- "[^ \t%]" " "))
+ (replace-regexp-in-string "[^ \t%]" " "
+ (buffer-substring beg (point))))
;(goto-char beg)
(if (search-forward-regexp "^[ \t]*\\(%+\\|\\*+\\|/\\*+\\)[ \t]*"
end t)
- (prolog-replace-in-string (buffer-substring beg (point)) "/" " ")
+ (replace-regexp-in-string "/" " " (buffer-substring beg (point)))
(beginning-of-line)
(when (search-forward-regexp "^[ \t]+" end t)
(buffer-substring beg (point)))))))))
@@ -2336,11 +2319,10 @@ In effect it sets the `fill-prefix' when inside
comments and then calls
(do-auto-fill)
))
-(defalias 'prolog-replace-in-string
- (if (fboundp 'replace-in-string)
- #'replace-in-string
- (lambda (str regexp newtext &optional literal)
- (replace-regexp-in-string regexp newtext str nil literal))))
+(defun prolog-replace-in-string (str regexp newtext &optional literal)
+ (declare (obsolete replace-regexp-in-string "28.1"))
+ (replace-regexp-in-string regexp newtext str nil literal))
+
;;-------------------------------------------------------------------
;; Online help
@@ -3083,12 +3065,8 @@ The module name should be written manually just before
the semi-colon."
(insert "%%% -*- Module: ; -*-\n")
(backward-char 6))
-(defalias 'prolog-uncomment-region
- (if (fboundp 'uncomment-region) #'uncomment-region
- (lambda (beg end)
- "Uncomment the region between BEG and END."
- (interactive "r")
- (comment-region beg end -1))))
+(define-obsolete-function-alias 'prolog-uncomment-region
+ 'uncomment-region "28.1")
(defun prolog-indent-predicate ()
"Indent the current predicate."
@@ -3374,7 +3352,7 @@ PREFIX is the prefix of the search regexp."
"Commands for Prolog code manipulation."
'("Prolog"
["Comment region" comment-region (use-region-p)]
- ["Uncomment region" prolog-uncomment-region (use-region-p)]
+ ["Uncomment region" uncomment-region (use-region-p)]
["Add comment/move to comment" indent-for-comment t]
["Convert variables in region to '_'" prolog-variables-to-anonymous
:active (use-region-p) :included (not (eq prolog-system 'mercury))]
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 7c3b611..95b6a03 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -3796,7 +3796,7 @@ was `continue'. This behavior slightly differentiates
the `continue' command
from the `exit' command listed in `python-pdbtrack-exit-command'.
See `python-pdbtrack-activate' for pdbtracking session overview."
- :type 'list
+ :type '(repeat string)
:version "27.1")
(defcustom python-pdbtrack-exit-command '("q" "quit" "exit")
@@ -3805,7 +3805,7 @@ After one of this commands is sent to pdb, pdbtracking
session is
considered over.
See `python-pdbtrack-activate' for pdbtracking session overview."
- :type 'list
+ :type '(repeat string)
:version "27.1")
(defcustom python-pdbtrack-kill-buffers t
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 831acf8..a11634b 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -142,12 +142,11 @@ This should only be called after matching against
`ruby-here-doc-beg-re'."
"Regexp to match symbols.")
(defvar ruby-use-smie t)
+(make-obsolete-variable 'ruby-use-smie nil "28.1")
(defvar ruby-mode-map
(let ((map (make-sparse-keymap)))
(unless ruby-use-smie
- (define-key map (kbd "M-C-b") 'ruby-backward-sexp)
- (define-key map (kbd "M-C-f") 'ruby-forward-sexp)
(define-key map (kbd "M-C-q") 'ruby-indent-exp))
(when ruby-use-smie
(define-key map (kbd "M-C-d") 'smie-down-list))
@@ -170,14 +169,8 @@ This should only be called after matching against
`ruby-here-doc-beg-re'."
"--"
["Toggle String Quotes" ruby-toggle-string-quotes t]
"--"
- ["Backward Sexp" ruby-backward-sexp
- :visible (not ruby-use-smie)]
- ["Backward Sexp" backward-sexp
- :visible ruby-use-smie]
- ["Forward Sexp" ruby-forward-sexp
- :visible (not ruby-use-smie)]
- ["Forward Sexp" forward-sexp
- :visible ruby-use-smie]
+ ["Backward Sexp" backward-sexp t]
+ ["Forward Sexp" forward-sexp t]
["Indent Sexp" ruby-indent-exp
:visible (not ruby-use-smie)]
["Indent Sexp" prog-indent-sexp
@@ -741,10 +734,10 @@ It is used when `ruby-encoding-magic-comment-style' is
set to `custom'."
(defun ruby-mode-variables ()
"Set up initial buffer-local variables for Ruby mode."
(setq indent-tabs-mode ruby-indent-tabs-mode)
- (if ruby-use-smie
- (smie-setup ruby-smie-grammar #'ruby-smie-rules
- :forward-token #'ruby-smie--forward-token
- :backward-token #'ruby-smie--backward-token)
+ (smie-setup ruby-smie-grammar #'ruby-smie-rules
+ :forward-token #'ruby-smie--forward-token
+ :backward-token #'ruby-smie--backward-token)
+ (unless ruby-use-smie
(setq-local indent-line-function #'ruby-indent-line))
(setq-local comment-start "# ")
(setq-local comment-end "")
@@ -1378,7 +1371,8 @@ move forward."
The defun begins at or after the point. This function is called
by `end-of-defun'."
(interactive "p")
- (ruby-forward-sexp)
+ (with-suppressed-warnings ((obsolete ruby-forward-sexp))
+ (ruby-forward-sexp))
(let (case-fold-search)
(when (looking-back (concat "^\\s *" ruby-block-end-re)
(line-beginning-position))
@@ -1467,11 +1461,14 @@ With ARG, move out of multiple blocks."
(defun ruby-forward-sexp (&optional arg)
"Move forward across one balanced expression (sexp).
With ARG, do it many times. Negative ARG means move backward."
+ (declare (obsolete forward-sexp "28.1"))
;; TODO: Document body
(interactive "p")
(cond
(ruby-use-smie (forward-sexp arg))
- ((and (numberp arg) (< arg 0)) (ruby-backward-sexp (- arg)))
+ ((and (numberp arg) (< arg 0))
+ (with-suppressed-warnings ((obsolete ruby-backward-sexp))
+ (ruby-backward-sexp (- arg))))
(t
(let ((i (or arg 1)))
(condition-case nil
@@ -1515,11 +1512,14 @@ With ARG, do it many times. Negative ARG means move
backward."
(defun ruby-backward-sexp (&optional arg)
"Move backward across one balanced expression (sexp).
With ARG, do it many times. Negative ARG means move forward."
+ (declare (obsolete backward-sexp "28.1"))
;; TODO: Document body
(interactive "p")
(cond
(ruby-use-smie (backward-sexp arg))
- ((and (numberp arg) (< arg 0)) (ruby-forward-sexp (- arg)))
+ ((and (numberp arg) (< arg 0))
+ (with-suppressed-warnings ((obsolete ruby-forward-sexp))
+ (ruby-forward-sexp (- arg))))
(t
(let ((i (or arg 1)))
(condition-case nil
@@ -1671,7 +1671,8 @@ See `add-log-current-defun-function'."
(defun ruby-block-contains-point (pt)
(save-excursion
(save-match-data
- (ruby-forward-sexp)
+ (with-suppressed-warnings ((obsolete ruby-forward-sexp))
+ (ruby-forward-sexp))
(> (point) pt))))
(defun ruby-brace-to-do-end (orig end)
@@ -1749,7 +1750,8 @@ If the result is do-end block, it will always be
multiline."
(progn
(goto-char (or (match-beginning 1) (match-beginning 2)))
(setq beg (point))
- (save-match-data (ruby-forward-sexp))
+ (with-suppressed-warnings ((obsolete ruby-forward-sexp))
+ (save-match-data (ruby-forward-sexp)))
(setq end (point))
(> end start)))
(if (match-beginning 1)
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index e554b2b..c31c5dd 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -342,8 +342,7 @@ file. Since that is a plaintext file, this could be
dangerous."
(const :format "" :completion)
(sexp :tag ":completion")
(const :format "" :must-match)
- (restricted-sexp
- :match-alternatives (listp stringp))))
+ (symbol :tag ":must-match")))
(const port)))
;; SQL Product support
@@ -838,11 +837,11 @@ host key."
(setq w (locate-user-emacs-file (concat "sql-wallet" ext)
(concat ".sql-wallet" ext)))
(when (file-exists-p w)
- (setq wallet w)))))
+ (setq wallet (list w))))))
"Identification of the password wallet.
See `sql-password-search-wallet-function' to understand how this value
is used to locate the password wallet."
- :type `(plist-get (symbol-plist 'auth-sources) 'custom-type)
+ :type (plist-get (symbol-plist 'auth-sources) 'custom-type)
:version "27.1")
(defvar sql-password-search-wallet-function #'sql-auth-source-search-wallet
diff --git a/lisp/repeat.el b/lisp/repeat.el
index f275db6..1dabd76 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -85,10 +85,6 @@
;; C-x { shrink-window-horizontally
;; C-x } enlarge-window-horizontally
-;; This command was first called `vi-dot', because
-;; it was inspired by the `.' command in the vi editor,
-;; but it was renamed to make its name more meaningful.
-
;;; Code:
;;;;; ************************* USER OPTIONS ************************** ;;;;;
diff --git a/lisp/simple.el b/lisp/simple.el
index d7486e5..6bc4196 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1231,7 +1231,43 @@ that uses or sets the mark."
"History of values entered with `goto-line'.")
(make-variable-buffer-local 'goto-line-history)
-(defun goto-line (line &optional buffer)
+(defun goto-line-read-args (&optional relative)
+ "Read arguments for `goto-line' related commands."
+ (if (and current-prefix-arg (not (consp current-prefix-arg)))
+ (list (prefix-numeric-value current-prefix-arg))
+ ;; Look for a default, a number in the buffer at point.
+ (let* ((default
+ (save-excursion
+ (skip-chars-backward "0-9")
+ (if (looking-at "[0-9]")
+ (string-to-number
+ (buffer-substring-no-properties
+ (point)
+ (progn (skip-chars-forward "0-9")
+ (point)))))))
+ ;; Decide if we're switching buffers.
+ (buffer
+ (if (consp current-prefix-arg)
+ (other-buffer (current-buffer) t)))
+ (buffer-prompt
+ (if buffer
+ (concat " in " (buffer-name buffer))
+ "")))
+ ;; Read the argument, offering that number (if any) as default.
+ (list (read-number (format "Goto%s line%s: "
+ (if (= (point-min) 1) ""
+ ;; In a narrowed buffer.
+ (if relative " relative" " absolute"))
+ buffer-prompt)
+ (list default (if (or relative (= (point-min) 1))
+ (line-number-at-pos)
+ (save-restriction
+ (widen)
+ (line-number-at-pos))))
+ 'goto-line-history)
+ buffer))))
+
+(defun goto-line (line &optional buffer relative)
"Go to LINE, counting from line 1 at beginning of buffer.
If called interactively, a numeric prefix argument specifies
LINE; without a numeric prefix argument, read LINE from the
@@ -1241,6 +1277,13 @@ If optional argument BUFFER is non-nil, switch to that
buffer and
move to line LINE there. If called interactively with \\[universal-argument]
as argument, BUFFER is the most recently selected other buffer.
+If optional argument RELATIVE is non-nil, counting starts at the beginning
+of the accessible portion of the (potentially narrowed) buffer.
+
+If the variable `widen-automatically' is non-nil, cancel narrowing and
+leave all lines accessible. If `widen-automatically' is nil, just move
+point to the edge of visible portion and don't change the buffer bounds.
+
Prior to moving point, this function sets the mark (without
activating it), unless Transient Mark mode is enabled and the
mark is already active.
@@ -1252,32 +1295,7 @@ What you probably want instead is something like:
If at all possible, an even better solution is to use char counts
rather than line counts."
(declare (interactive-only forward-line))
- (interactive
- (if (and current-prefix-arg (not (consp current-prefix-arg)))
- (list (prefix-numeric-value current-prefix-arg))
- ;; Look for a default, a number in the buffer at point.
- (let* ((default
- (save-excursion
- (skip-chars-backward "0-9")
- (if (looking-at "[0-9]")
- (string-to-number
- (buffer-substring-no-properties
- (point)
- (progn (skip-chars-forward "0-9")
- (point)))))))
- ;; Decide if we're switching buffers.
- (buffer
- (if (consp current-prefix-arg)
- (other-buffer (current-buffer) t)))
- (buffer-prompt
- (if buffer
- (concat " in " (buffer-name buffer))
- "")))
- ;; Read the argument, offering that number (if any) as default.
- (list (read-number (format "Goto line%s: " buffer-prompt)
- (list default (line-number-at-pos))
- 'goto-line-history)
- buffer))))
+ (interactive (goto-line-read-args))
;; Switch to the desired buffer, one way or another.
(if buffer
(let ((window (get-buffer-window buffer)))
@@ -1286,13 +1304,28 @@ rather than line counts."
;; Leave mark at previous position
(or (region-active-p) (push-mark))
;; Move to the specified line number in that buffer.
- (save-restriction
- (widen)
+ (if (and (not relative) (not widen-automatically))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (if (eq selective-display t)
+ (re-search-forward "[\n\C-m]" nil 'end (1- line))
+ (forward-line (1- line))))
+ (unless relative (widen))
(goto-char (point-min))
(if (eq selective-display t)
(re-search-forward "[\n\C-m]" nil 'end (1- line))
(forward-line (1- line)))))
+(defun goto-line-relative (line &optional buffer)
+ "Go to LINE, counting from line at (point-min).
+The line number is relative to the accessible portion of the narrowed
+buffer. The argument BUFFER is the same as in the function `goto-line'."
+ (declare (interactive-only forward-line))
+ (interactive (goto-line-read-args t))
+ (with-suppressed-warnings ((interactive-only goto-line))
+ (goto-line line buffer t)))
+
(defun count-words-region (start end &optional arg)
"Count the number of words in the region.
If called interactively, print a message reporting the number of
diff --git a/lisp/subr.el b/lisp/subr.el
index 795cf3e..1035ebd 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4435,37 +4435,21 @@ Unless optional argument INPLACE is non-nil, return a
new string."
newstr))
(defun replace-in-string (fromstring tostring instring)
- "Replace FROMSTRING with TOSTRING in INSTRING each time it occurs.
-This function returns a freshly created string."
- (declare (side-effect-free t))
- (let ((i 0)
- (start 0)
- (result nil))
- (while (< i (length instring))
- (if (eq (aref instring i)
- (aref fromstring 0))
- ;; See if we're in a match.
- (let ((ii i)
- (if 0))
- (while (and (< ii (length instring))
- (< if (length fromstring))
- (eq (aref instring ii)
- (aref fromstring if)))
- (setq ii (1+ ii)
- if (1+ if)))
- (if (not (= if (length fromstring)))
- ;; We didn't have a match after all.
- (setq i (1+ i))
- ;; We had one, so gather the previous part and the
- ;; substitution.
- (when (not (= start i))
- (push (substring instring start i) result))
- (push tostring result)
- (setq i ii
- start ii)))
- (setq i (1+ i))))
- (when (not (= start i))
- (push (substring instring start i) result))
+ "Replace FROMSTRING with TOSTRING in INSTRING each time it occurs."
+ (declare (pure t))
+ (when (equal fromstring "")
+ (signal 'wrong-length-argument fromstring))
+ (let ((start 0)
+ (result nil)
+ pos)
+ (while (setq pos (string-search fromstring instring start))
+ (unless (= start pos)
+ (push (substring instring start pos) result))
+ (push tostring result)
+ (setq start (+ pos (length fromstring))))
+ ;; Get any remaining bit.
+ (unless (= start (length instring))
+ (push (substring instring start) result))
(apply #'concat (nreverse result))))
(defun replace-regexp-in-string (regexp rep string &optional
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 6acf6cd..dd0a986 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -632,15 +632,21 @@ This function has been overloaded in Nextstep.")
(defvar ns-input-fontsize)
(defun ns-respond-to-change-font ()
- "Respond to changeFont: event, expecting `ns-input-font' and\n\
-`ns-input-fontsize' of new font."
+ "Set the font chosen in the font-picker panel.
+Respond to changeFont: event, expecting ns-input-font and
+ns-input-fontsize of new font."
(interactive)
- (modify-frame-parameters (selected-frame)
- (list (cons 'fontsize ns-input-fontsize)))
- (modify-frame-parameters (selected-frame)
- (list (cons 'font ns-input-font)))
- (set-frame-font ns-input-font))
-
+ (let ((face 'default))
+ (set-face-attribute face t
+ :family ns-input-font
+ :height (* 10 ns-input-fontsize))
+ (set-face-attribute face (selected-frame)
+ :family ns-input-font
+ :height (* 10 ns-input-fontsize))
+ (let ((spec (list (list t (face-attr-construct 'default)))))
+ (put face 'customized-face spec)
+ (custom-push-theme 'theme-face face 'user 'set spec)
+ (put face 'face-modified nil))))
;; Default fontset for macOS. This is mainly here to show how a fontset
;; can be set up manually. Ordinarily, fontsets are auto-created whenever
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 9c94fff..75b13bd 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -1993,25 +1993,11 @@ The replacement is used to convert tabs and new-lines
to spaces."
(defun artist-replace-chars (new-char count)
"Replace characters at point with NEW-CHAR. COUNT chars are replaced."
- ;; Check that the variable exists first. The doc says it was added in 19.23.
- (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20))
- (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3)))
- ;; This is a bug workaround for Emacs 20, versions up to 20.3:
- ;; The self-insert-command doesn't care about the overwrite-mode,
- ;; so the insertion is done in the same way as in picture mode.
- ;; This seems to be a little bit slower.
- (let* ((replaced-c (artist-get-replacement-char new-char))
- (replaced-s (make-string count replaced-c)))
- (artist-move-to-xy (+ (artist-current-column) count)
- (artist-current-line))
- (delete-char (- count))
- (insert replaced-s))
- ;; In emacs-19, the self-insert-command works better
- (let ((overwrite-mode 'overwrite-mode-textual)
- (fill-column 32765) ; Large :-)
- (blink-matching-paren nil))
- (setq last-command-event (artist-get-replacement-char new-char))
- (self-insert-command count))))
+ (let ((overwrite-mode 'overwrite-mode-textual)
+ (fill-column 32765) ; Large :-)
+ (blink-matching-paren nil))
+ (setq last-command-event (artist-get-replacement-char new-char))
+ (self-insert-command count)))
(defsubst artist-replace-string (string &optional see-thru)
"Replace contents at point with STRING.
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 8a1bb8a..2e05d93 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -445,6 +445,8 @@ See also `whitespace-display-mappings' for documentation."
(const :tag "(Face) Lines" lines)
(const :tag "(Face) Lines, only overlong part" lines-tail)
(const :tag "(Face) NEWLINEs" newline)
+ (const :tag "(Face) Missing newlines at EOB"
+ missing-newline-at-eof)
(const :tag "(Face) Empty Lines At BOB And/Or EOB" empty)
(const :tag "(Face) Indentation SPACEs" indentation::tab)
(const :tag "(Face) Indentation TABs"
@@ -726,7 +728,7 @@ and the cons cdr is used for TABs visualization.
Used when `whitespace-style' includes `indentation',
`indentation::tab' or `indentation::space'."
- :type '(cons (regexp :tag "Indentation SPACEs")
+ :type '(cons (string :tag "Indentation SPACEs")
(regexp :tag "Indentation TABs"))
:group 'whitespace)
@@ -757,8 +759,8 @@ and the cons cdr is used for TABs visualization.
Used when `whitespace-style' includes `space-after-tab',
`space-after-tab::tab' or `space-after-tab::space'."
- :type '(cons (regexp :tag "SPACEs After TAB")
- regexp)
+ :type '(cons (string :tag "SPACEs After TAB")
+ string)
:group 'whitespace)
(defcustom whitespace-big-indent-regexp
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 13d850a..8ad99f4 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -303,12 +303,15 @@ the :notify function can't know the new value.")
(or (not widget-field-add-space) (widget-get widget :size))))
(if (functionp help-echo)
(setq help-echo 'widget-mouse-help))
- (when (= (char-before to) ?\n)
+ (when (and (or (> to (1+ from)) (null (widget-get widget :size)))
+ (= (char-before to) ?\n))
;; When the last character in the field is a newline, we want to
;; give it a `field' char-property of `boundary', which helps the
;; C-n/C-p act more naturally when entering/leaving the field. We
- ;; do this by making a small secondary overlay to contain just that
- ;; one character.
+ ;; do this by making a small secondary overlay to contain just that
+ ;; one character. BUT we only do this if there is more than one
+ ;; character (so we don't do this for the character widget),
+ ;; or if the size of the editable field isn't specified.
(let ((overlay (make-overlay (1- to) to nil t nil)))
(overlay-put overlay 'field 'boundary)
;; We need the real field for tabbing.
@@ -3524,7 +3527,7 @@ To use this type, you must define :match or
:match-alternatives."
:value 0
:size 1
:format "%{%t%}: %v\n"
- :valid-regexp "\\`.\\'"
+ :valid-regexp "\\`\\(.\\|\n\\)\\'"
:error "This field should contain a single character"
:value-get (lambda (w) (widget-field-value-get w t))
:value-to-internal (lambda (_widget value)
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 4c5ab48..09f0317 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -44,7 +44,10 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
/* Alist of D-Bus buses we are polling for messages.
The key is the symbol or string of the bus, and the value is the
- connection address. */
+ connection address. For every bus, just one connection is counted.
+ If there shall be a second connection to the same bus, a different
+ symbol or string for the bus must be chosen. On Lisp level, a bus
+ stands for the associated connection. */
static Lisp_Object xd_registered_buses;
/* Whether we are reading a D-Bus event. */
@@ -279,10 +282,13 @@ XD_OBJECT_TO_STRING (Lisp_Object object)
else \
{
\
CHECK_SYMBOL (bus); \
- if (!(EQ (bus, QCsystem) || EQ (bus, QCsession))) \
+ if (!(EQ (bus, QCsystem) || EQ (bus, QCsession) \
+ || EQ (bus, QCsystem_private) \
+ || EQ (bus, QCsession_private))) \
XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
/* We do not want to have an autolaunch for the session bus. */ \
- if (EQ (bus, QCsession) && session_bus_address == NULL) \
+ if ((EQ (bus, QCsession) || EQ (bus, QCsession_private)) \
+ && session_bus_address == NULL) \
XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
}
\
} while (0)
@@ -968,8 +974,9 @@ xd_lisp_dbus_to_dbus (Lisp_Object bus)
return xmint_pointer (bus);
}
-/* Return D-Bus connection address. BUS is either a Lisp symbol,
- :system or :session, or a string denoting the bus address. */
+/* Return D-Bus connection address.
+ BUS is either a Lisp symbol, :system, :session, :system-private or
+ :session-private, or a string denoting the bus address. */
static DBusConnection *
xd_get_connection_address (Lisp_Object bus)
{
@@ -1031,7 +1038,8 @@ xd_add_watch (DBusWatch *watch, void *data)
}
/* Stop monitoring WATCH for possible I/O.
- DATA is the used bus, either a string or QCsystem or QCsession. */
+ DATA is the used bus, either a string or QCsystem, QCsession,
+ QCsystem_private or QCsession_private. */
static void
xd_remove_watch (DBusWatch *watch, void *data)
{
@@ -1046,7 +1054,7 @@ xd_remove_watch (DBusWatch *watch, void *data)
/* Unset session environment. */
#if 0
/* This is buggy, since unsetenv is not thread-safe. */
- if (XSYMBOL (QCsession) == data)
+ if (XSYMBOL (QCsession) == data) || (XSYMBOL (QCsession_private) == data)
{
XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
unsetenv ("DBUS_SESSION_BUS_ADDRESS");
@@ -1120,6 +1128,11 @@ can be a string denoting the address of the
corresponding bus. For
the system and session buses, this function is called when loading
`dbus.el', there is no need to call it again.
+A special case is BUS being the symbol `:system-private' or
+`:session-private'. These symbols still denote the system or session
+bus, but using a private connection. They should not be used outside
+dbus.el.
+
The function returns a number, which counts the connections this Emacs
session has established to the BUS under the same unique name (see
`dbus-get-unique-name'). It depends on the libraries Emacs is linked
@@ -1142,6 +1155,10 @@ this connection to those buses. */)
ptrdiff_t refcount;
/* Check parameter. */
+ if (!NILP (private))
+ bus = EQ (bus, QCsystem)
+ ? QCsystem_private
+ : EQ (bus, QCsession) ? QCsession_private : bus;
XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
/* Close bus if it is already open. */
@@ -1169,8 +1186,9 @@ this connection to those buses. */)
else
{
- DBusBusType bustype = (EQ (bus, QCsystem)
- ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION);
+ DBusBusType bustype
+ = EQ (bus, QCsystem) || EQ (bus, QCsystem_private)
+ ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION;
if (NILP (private))
connection = dbus_bus_get (bustype, &derror);
else
@@ -1184,9 +1202,9 @@ this connection to those buses. */)
XD_SIGNAL2 (build_string ("No connection to bus"), bus);
/* If it is not the system or session bus, we must register
- ourselves. Otherwise, we have called dbus_bus_get, which has
- configured us to exit if the connection closes - we undo this
- setting. */
+ ourselves. Otherwise, we have called dbus_bus_get{_private},
+ which has configured us to exit if the connection closes - we
+ undo this setting. */
if (STRINGP (bus))
dbus_bus_register (connection, &derror);
else
@@ -1215,6 +1233,9 @@ this connection to those buses. */)
dbus_error_free (&derror);
}
+ XD_DEBUG_MESSAGE ("Registered buses: %s",
+ XD_OBJECT_TO_STRING (xd_registered_buses));
+
/* Return reference counter. */
refcount = xd_get_connection_references (connection);
XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD"d",
@@ -1533,8 +1554,8 @@ usage: (dbus-message-internal &rest REST) */)
}
/* Read one queued incoming message of the D-Bus BUS.
- BUS is either a Lisp symbol, :system or :session, or a string denoting
- the bus address. */
+ BUS is either a Lisp symbol, :system, :session, :system-private or
+ :session-private, or a string denoting the bus address. */
static void
xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
{
@@ -1546,7 +1567,7 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
int mtype;
dbus_uint32_t serial;
unsigned int ui_serial;
- const char *uname, *path, *interface, *member, *error_name;
+ const char *uname, *destination, *path, *interface, *member, *error_name;
dmessage = dbus_connection_pop_message (connection);
@@ -1579,6 +1600,7 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
? dbus_message_get_reply_serial (dmessage)
: dbus_message_get_serial (dmessage);
uname = dbus_message_get_sender (dmessage);
+ destination = dbus_message_get_destination (dmessage);
path = dbus_message_get_path (dmessage);
interface = dbus_message_get_interface (dmessage);
member = dbus_message_get_member (dmessage);
@@ -1586,7 +1608,8 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s %s",
XD_MESSAGE_TYPE_TO_STRING (mtype),
- ui_serial, uname, path, interface, member, error_name,
+ ui_serial, uname, destination, path, interface,
+ mtype == DBUS_MESSAGE_TYPE_ERROR ? error_name : member,
XD_OBJECT_TO_STRING (args));
if (mtype == DBUS_MESSAGE_TYPE_INVALID)
@@ -1601,7 +1624,7 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
/* There shall be exactly one entry. Construct an event. */
if (NILP (value))
- goto cleanup;
+ goto monitor;
/* Remove the entry. */
Fremhash (key, Vdbus_registered_objects_table);
@@ -1610,11 +1633,8 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
EVENT_INIT (event);
event.kind = DBUS_EVENT;
event.frame_or_window = Qnil;
- event.arg =
- Fcons (value,
- (mtype == DBUS_MESSAGE_TYPE_ERROR)
- ? Fcons (list2 (QCstring, build_string (error_name)), args)
- : args);
+ /* Handler. */
+ event.arg = Fcons (value, args);
}
else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
@@ -1622,7 +1642,7 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
/* Vdbus_registered_objects_table requires non-nil interface and
member. */
if ((interface == NULL) || (member == NULL))
- goto cleanup;
+ goto monitor;
/* Search for a registered function of the message. */
key = list4 (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL ? QCmethod :
QCsignal,
@@ -1647,6 +1667,7 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
EVENT_INIT (event);
event.kind = DBUS_EVENT;
event.frame_or_window = Qnil;
+ /* Handler. */
event.arg
= Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))), args);
break;
@@ -1655,16 +1676,22 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
}
if (NILP (value))
- goto cleanup;
+ goto monitor;
}
- /* Add type, serial, uname, path, interface and member to the event. */
- event.arg = Fcons ((member == NULL ? Qnil : build_string (member)),
- event.arg);
+ /* Add type, serial, uname, destination, path, interface and member
+ or error_name to the event. */
+ event.arg
+ = Fcons (mtype == DBUS_MESSAGE_TYPE_ERROR
+ ? error_name == NULL ? Qnil : build_string (error_name)
+ : member == NULL ? Qnil : build_string (member),
+ event.arg);
event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
event.arg);
event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
event.arg);
+ event.arg = Fcons ((destination == NULL ? Qnil : build_string (destination)),
+ event.arg);
event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
event.arg);
event.arg = Fcons (INT_TO_INTEGER (serial), event.arg);
@@ -1678,14 +1705,58 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg));
+ /* Monitor. */
+ monitor:
+ /* Search for a registered function of the message. */
+ key = list2 (QCmonitor, bus);
+ value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
+
+ /* There shall be exactly one entry. Construct an event. */
+ if (NILP (value))
+ goto cleanup;
+
+ /* Construct an event. */
+ EVENT_INIT (event);
+ event.kind = DBUS_EVENT;
+ event.frame_or_window = Qnil;
+
+ /* Add type, serial, uname, destination, path, interface, member
+ or error_name and handler to the event. */
+ event.arg
+ = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (CAR_SAFE (value))))),
+ args);
+ event.arg
+ = Fcons (mtype == DBUS_MESSAGE_TYPE_ERROR
+ ? error_name == NULL ? Qnil : build_string (error_name)
+ : member == NULL ? Qnil : build_string (member),
+ event.arg);
+ event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
+ event.arg);
+ event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
+ event.arg);
+ event.arg = Fcons ((destination == NULL ? Qnil : build_string (destination)),
+ event.arg);
+ event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
+ event.arg);
+ event.arg = Fcons (INT_TO_INTEGER (serial), event.arg);
+ event.arg = Fcons (make_fixnum (mtype), event.arg);
+
+ /* Add the bus symbol to the event. */
+ event.arg = Fcons (bus, event.arg);
+
+ /* Store it into the input event queue. */
+ kbd_buffer_store_event (&event);
+
+ XD_DEBUG_MESSAGE ("Monitor event stored: %s", XD_OBJECT_TO_STRING
(event.arg));
+
/* Cleanup. */
cleanup:
dbus_message_unref (dmessage);
}
/* Read queued incoming messages of the D-Bus BUS.
- BUS is either a Lisp symbol, :system or :session, or a string denoting
- the bus address. */
+ BUS is either a Lisp symbol, :system, :session, :system-private or
+ :session-private, or a string denoting the bus address. */
static Lisp_Object
xd_read_message (Lisp_Object bus)
{
@@ -1762,6 +1833,8 @@ syms_of_dbusbind (void)
/* Lisp symbols of the system and session buses. */
DEFSYM (QCsystem, ":system");
DEFSYM (QCsession, ":session");
+ DEFSYM (QCsystem_private, ":system-private");
+ DEFSYM (QCsession_private, ":session-private");
/* Lisp symbol for method call timeout. */
DEFSYM (QCtimeout, ":timeout");
@@ -1788,10 +1861,11 @@ syms_of_dbusbind (void)
DEFSYM (QCdict_entry, ":dict-entry");
/* Lisp symbols of objects in `dbus-registered-objects-table'.
- `:property', which does exist there as well, is not used here. */
+ `:property', which does exist there as well, is not declared here. */
DEFSYM (QCserial, ":serial");
DEFSYM (QCmethod, ":method");
DEFSYM (QCsignal, ":signal");
+ DEFSYM (QCmonitor, ":monitor");
DEFVAR_LISP ("dbus-compiled-version",
Vdbus_compiled_version,
@@ -1867,8 +1941,9 @@ path of the sending object. All of them can be nil,
which means a
wildcard then.
OBJECT is either the handler to be called when a D-Bus message, which
-matches the key criteria, arrives (TYPE `:method' and `:signal'), or a
-list (ACCESS EMITS-SIGNAL VALUE) for TYPE `:property'.
+matches the key criteria, arrives (TYPE `:method', `:signal' and
+`:monitor'), or a list (ACCESS EMITS-SIGNAL VALUE) for TYPE
+`:property'.
For entries of type `:signal', there is also a fifth element RULE,
which keeps the match string the signal is registered with.
diff --git a/src/fns.c b/src/fns.c
index a3b8d6e..2f64d95 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5454,6 +5454,57 @@ It should not be used for anything security-related. See
return make_digest_string (digest, SHA1_DIGEST_SIZE);
}
+DEFUN ("string-search", Fstring_search, Sstring_search, 2, 3, 0,
+ doc: /* Search for the string NEEDLE in the string HAYSTACK.
+The return value is the position of the first occurrence of NEEDLE in
+HAYSTACK, or nil if no match was found.
+
+The optional START-POS argument says where to start searching in
+HAYSTACK and defaults to zero (start at the beginning).
+It must be between zero and the length of HAYSTACK, inclusive.
+
+Case is always significant and text properties are ignored. */)
+ (register Lisp_Object needle, Lisp_Object haystack, Lisp_Object start_pos)
+{
+ ptrdiff_t start_byte = 0, haybytes;
+ char *res, *haystart;
+
+ CHECK_STRING (needle);
+ CHECK_STRING (haystack);
+
+ if (!NILP (start_pos))
+ {
+ CHECK_FIXNUM (start_pos);
+ EMACS_INT start = XFIXNUM (start_pos);
+ if (start < 0 || start > SCHARS (haystack))
+ xsignal1 (Qargs_out_of_range, start_pos);
+ start_byte = string_char_to_byte (haystack, start);
+ }
+
+ haystart = SSDATA (haystack) + start_byte;
+ haybytes = SBYTES (haystack) - start_byte;
+
+ if (STRING_MULTIBYTE (haystack) == STRING_MULTIBYTE (needle))
+ res = memmem (haystart, haybytes,
+ SSDATA (needle), SBYTES (needle));
+ else if (STRING_MULTIBYTE (haystack)) /* unibyte needle */
+ {
+ Lisp_Object multi_needle = string_to_multibyte (needle);
+ res = memmem (haystart, haybytes,
+ SSDATA (multi_needle), SBYTES (multi_needle));
+ }
+ else /* unibyte haystack, multibyte needle */
+ {
+ Lisp_Object uni_needle = Fstring_as_unibyte (needle);
+ res = memmem (haystart, haybytes,
+ SSDATA (uni_needle), SBYTES (uni_needle));
+ }
+
+ if (! res)
+ return Qnil;
+
+ return make_int (string_byte_to_char (haystack, res - SSDATA (haystack)));
+}
void
@@ -5494,6 +5545,7 @@ syms_of_fns (void)
defsubr (&Sremhash);
defsubr (&Smaphash);
defsubr (&Sdefine_hash_table_test);
+ defsubr (&Sstring_search);
/* Crypto and hashing stuff. */
DEFSYM (Qiv_auto, "iv-auto");
diff --git a/src/nsfont.m b/src/nsfont.m
index 691becd..d1543ec 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -39,9 +39,7 @@ Author: Adrian Robert (arobert@cogsci.ucsd.edu)
#include "pdumper.h"
/* TODO: Drop once we can assume gnustep-gui 0.17.1. */
-#ifdef NS_IMPL_GNUSTEP
#import <AppKit/NSFontDescriptor.h>
-#endif
#define NSFONT_TRACE 0
#define LCD_SMOOTHING_MARGIN 2
@@ -237,12 +235,6 @@ ns_char_width (NSFont *sfont, int c)
CGFloat w = -1.0;
NSString *cstr = [NSString stringWithFormat: @"%c", c];
-#ifdef NS_IMPL_COCOA
- NSGlyph glyph = [sfont glyphWithName: cstr];
- if (glyph)
- w = [sfont advancementForGlyph: glyph].width;
-#endif
-
if (w < 0.0)
{
NSDictionary *attrsDictionary =
@@ -273,12 +265,6 @@ ns_ascii_average_width (NSFont *sfont)
ascii_printable = [[NSString alloc] initWithFormat: @"%s", chars];
}
-#ifdef NS_IMPL_COCOA
- NSGlyph glyph = [sfont glyphWithName: ascii_printable];
- if (glyph)
- w = [sfont advancementForGlyph: glyph].width;
-#endif
-
if (w < (CGFloat) 0.0)
{
NSDictionary *attrsDictionary =
@@ -511,10 +497,6 @@ static NSSet
}
[charset release];
}
-#ifdef NS_IMPL_COCOA
- if ([families count] == 0)
- [families addObject: @"LastResort"];
-#endif
[scriptToFamilies setObject: families forKey: script];
}
@@ -734,11 +716,6 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int
pixel_size)
traits: traits & ~NSItalicFontMask
weight: fixLeopardBug size: pixel_size];
}
-#ifdef NS_IMPL_COCOA
- /* LastResort not really a family */
- if (nsfont == nil && [@"LastResort" isEqualToString: family])
- nsfont = [NSFont fontWithName: @"LastResort" size: pixel_size];
-#endif
if (nsfont == nil)
{
@@ -765,12 +742,7 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int
pixel_size)
font_info->metrics = xzalloc (0x100 * sizeof *font_info->metrics);
/* for metrics */
-#ifdef NS_IMPL_COCOA
- sfont = [nsfont screenFontWithRenderingMode:
- NSFontAntialiasedIntegerAdvancementsRenderingMode];
-#else
sfont = [nsfont screenFont];
-#endif
if (sfont == nil)
sfont = nsfont;
@@ -797,11 +769,7 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int
pixel_size)
* intended. */
CGFloat adjusted_descender = [sfont descender] + 0.0001;
-#ifdef NS_IMPL_GNUSTEP
font_info->nsfont = sfont;
-#else
- font_info->nsfont = nsfont;
-#endif
[font_info->nsfont retain];
/* set up ns_font (defined in nsgui.h) */
@@ -834,32 +802,6 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int
pixel_size)
font_info->max_bounds.rbearing =
lrint (brect.size.width - (CGFloat) font_info->width);
-#ifdef NS_IMPL_COCOA
- /* set up synthItal and the CG font */
- font_info->synthItal = synthItal;
- {
- ATSFontRef atsFont = ATSFontFindFromPostScriptName
- ((CFStringRef)[nsfont fontName], kATSOptionFlagsDefault);
-
- if (atsFont == kATSFontRefUnspecified)
- {
- /* see if we can get it by dropping italic (then synthesizing) */
- atsFont = ATSFontFindFromPostScriptName ((CFStringRef)
- [[fontMgr convertFont: nsfont toNotHaveTrait: NSItalicFontMask]
- fontName], kATSOptionFlagsDefault);
- if (atsFont != kATSFontRefUnspecified)
- font_info->synthItal = YES;
- else
- {
- /* last resort fallback */
- atsFont = ATSFontFindFromPostScriptName
- ((CFStringRef)@"Monaco", kATSOptionFlagsDefault);
- }
- }
- font_info->cgfont = CGFontCreateWithPlatformFont ((void *) &atsFont);
- }
-#endif
-
/* set up metrics portion of font struct */
font->ascent = lrint([sfont ascender]);
font->descent = -lrint(floor(adjusted_descender));
@@ -901,9 +843,6 @@ nsfont_close (struct font *font)
xfree (font_info->glyphs);
xfree (font_info->metrics);
[font_info->nsfont release];
-#ifdef NS_IMPL_COCOA
- CGFontRelease (font_info->cgfont);
-#endif
xfree (font_info->name);
font_info->name = NULL;
}
@@ -994,7 +933,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int
x, int y,
{
static unsigned char cbuf[1024];
unsigned char *c = cbuf;
-#ifdef NS_IMPL_GNUSTEP
#if GNUSTEP_GUI_MAJOR_VERSION > 0 || GNUSTEP_GUI_MINOR_VERSION > 22
static CGFloat advances[1024];
CGFloat *adv = advances;
@@ -1002,10 +940,6 @@ nsfont_draw (struct glyph_string *s, int from, int to,
int x, int y,
static float advances[1024];
float *adv = advances;
#endif
-#else
- static CGSize advances[1024];
- CGSize *adv = advances;
-#endif
struct face *face;
NSRect r;
struct nsfont_info *font;
@@ -1073,11 +1007,7 @@ nsfont_draw (struct glyph_string *s, int from, int to,
int x, int y,
else
{
cwidth = LGLYPH_WADJUST (glyph);
-#ifdef NS_IMPL_GNUSTEP
*(adv-1) += LGLYPH_XOFF (glyph);
-#else
- (*(adv-1)).width += LGLYPH_XOFF (glyph);
-#endif
}
}
}
@@ -1088,12 +1018,8 @@ nsfont_draw (struct glyph_string *s, int from, int to,
int x, int y,
cwidth = font->metrics[hi][lo].width;
}
twidth += cwidth;
-#ifdef NS_IMPL_GNUSTEP
*adv++ = cwidth;
c += CHAR_STRING (*t, c); /* This converts the char to UTF-8. */
-#else
- (*adv++).width = cwidth;
-#endif
}
len = adv - advances;
r.size.width = twidth;
@@ -1192,61 +1118,6 @@ nsfont_draw (struct glyph_string *s, int from, int to,
int x, int y,
DPSgrestore (context);
}
-#else /* NS_IMPL_COCOA */
- {
- CGContextRef gcontext =
- [[NSGraphicsContext currentContext] graphicsPort];
- static CGAffineTransform fliptf;
- static BOOL firstTime = YES;
-
- if (firstTime)
- {
- firstTime = NO;
- fliptf = CGAffineTransformMakeScale (1.0, -1.0);
- }
-
- CGContextSaveGState (gcontext);
-
- // Used to be Fix2X (kATSItalicQDSkew), but Fix2X is deprecated
- // and kATSItalicQDSkew is 0.25.
- fliptf.c = font->synthItal ? 0.25 : 0.0;
-
- CGContextSetFont (gcontext, font->cgfont);
- CGContextSetFontSize (gcontext, font->size);
- if (NILP (ns_antialias_text) || font->size <= ns_antialias_threshold)
- CGContextSetShouldAntialias (gcontext, 0);
- else
- CGContextSetShouldAntialias (gcontext, 1);
-
- CGContextSetTextMatrix (gcontext, fliptf);
-
- if (bgCol != nil)
- {
- /* foreground drawing; erase first to avoid overstrike */
- [bgCol set];
- CGContextSetTextDrawingMode (gcontext, kCGTextFillStroke);
- CGContextSetTextPosition (gcontext, r.origin.x, r.origin.y);
- CGContextShowGlyphsWithAdvances (gcontext, s->char2b, advances, len);
- CGContextSetTextDrawingMode (gcontext, kCGTextFill);
- }
-
- [col set];
-
- CGContextSetTextPosition (gcontext, r.origin.x, r.origin.y);
- CGContextShowGlyphsWithAdvances (gcontext, s->char2b + from,
- advances, len);
-
- if (face->overstrike)
- {
- CGContextSetTextPosition (gcontext, r.origin.x+0.5, r.origin.y);
- CGContextShowGlyphsWithAdvances (gcontext, s->char2b + from,
- advances, len);
- }
-
- CGContextRestoreGState (gcontext);
- }
-#endif /* NS_IMPL_COCOA */
-
unblock_input ();
return to-from;
}
@@ -1264,10 +1135,6 @@ nsfont_draw (struct glyph_string *s, int from, int to,
int x, int y,
static void
ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block)
{
-#ifdef NS_IMPL_COCOA
- static EmacsGlyphStorage *glyphStorage;
- static char firstTime = 1;
-#endif
unichar *unichars = xmalloc (0x101 * sizeof (unichar));
unsigned int i, g, idx;
unsigned short *glyphs;
@@ -1278,14 +1145,6 @@ ns_uni_to_glyphs (struct nsfont_info *font_info,
unsigned char block)
block_input ();
-#ifdef NS_IMPL_COCOA
- if (firstTime)
- {
- firstTime = 0;
- glyphStorage = [[EmacsGlyphStorage alloc] initWithCapacity: 0x100];
- }
-#endif
-
font_info->glyphs[block] = xmalloc (0x100 * sizeof (unsigned short));
if (!unichars || !(font_info->glyphs[block]))
emacs_abort ();
@@ -1299,38 +1158,16 @@ ns_uni_to_glyphs (struct nsfont_info *font_info,
unsigned char block)
unichars[0x100] = 0;
{
-#ifdef NS_IMPL_COCOA
- NSString *allChars = [[NSString alloc]
- initWithCharactersNoCopy: unichars
- length: 0x100
- freeWhenDone: NO];
- NSGlyphGenerator *glyphGenerator = [NSGlyphGenerator sharedGlyphGenerator];
- /* NSCharacterSet *coveredChars = [nsfont coveredCharacterSet]; */
- unsigned int numGlyphs = [font_info->nsfont numberOfGlyphs];
- NSUInteger gInd = 0, cInd = 0;
-
- [glyphStorage setString: allChars font: font_info->nsfont];
- [glyphGenerator generateGlyphsForGlyphStorage: glyphStorage
- desiredNumberOfCharacters: glyphStorage->maxChar
- glyphIndex: &gInd characterIndex:
&cInd];
-#endif
glyphs = font_info->glyphs[block];
for (i = 0; i < 0x100; i++, glyphs++)
{
-#ifdef NS_IMPL_GNUSTEP
g = unichars[i];
-#else
g = glyphStorage->cglyphs[i];
/* TODO: is this a good check? Maybe need to use coveredChars. */
if (g > numGlyphs || g == NSNullGlyph)
g = INVALID_GLYPH; /* Hopefully unused... */
-#endif
*glyphs = g;
}
-
-#ifdef NS_IMPL_COCOA
- [allChars release];
-#endif
}
unblock_input ();
@@ -1352,19 +1189,12 @@ ns_glyph_metrics (struct nsfont_info *font_info,
unsigned char block)
fprintf (stderr, "%p\tComputing metrics for glyphs in block %d\n",
font_info, block);
-#ifdef NS_IMPL_GNUSTEP
/* not implemented yet (as of startup 0.18), so punt */
if (numGlyphs == 0)
numGlyphs = 0x10000;
-#endif
block_input ();
-#ifdef NS_IMPL_COCOA
- sfont = [font_info->nsfont screenFontWithRenderingMode:
- NSFontAntialiasedIntegerAdvancementsRenderingMode];
-#else
sfont = [font_info->nsfont screenFont];
-#endif
font_info->metrics[block] = xzalloc (0x100 * sizeof (struct font_metrics));
if (!(font_info->metrics[block]))
@@ -1397,76 +1227,6 @@ ns_glyph_metrics (struct nsfont_info *font_info,
unsigned char block)
}
-#ifdef NS_IMPL_COCOA
-/* Helper for font glyph setup. */
-@implementation EmacsGlyphStorage
-
-- init
-{
- return [self initWithCapacity: 1024];
-}
-
-- initWithCapacity: (unsigned long) c
-{
- self = [super init];
- maxChar = 0;
- maxGlyph = 0;
- dict = [NSMutableDictionary new];
- cglyphs = xmalloc (c * sizeof (CGGlyph));
- return self;
-}
-
-- (void) dealloc
-{
- if (attrStr != nil)
- [attrStr release];
- [dict release];
- xfree (cglyphs);
- [super dealloc];
-}
-
-- (void) setString: (NSString *)str font: (NSFont *)font
-{
- [dict setObject: font forKey: NSFontAttributeName];
- if (attrStr != nil)
- [attrStr release];
- attrStr = [[NSAttributedString alloc] initWithString: str attributes: dict];
- maxChar = [str length];
- maxGlyph = 0;
-}
-
-/* NSGlyphStorage protocol */
-- (NSUInteger)layoutOptions
-{
- return 0;
-}
-
-- (NSAttributedString *)attributedString
-{
- return attrStr;
-}
-
-- (void)insertGlyphs: (const NSGlyph *)glyphs length: (NSUInteger)length
- forStartingGlyphAtIndex: (NSUInteger)glyphIndex
- characterIndex: (NSUInteger)charIndex
-{
- len = glyphIndex+length;
- for (i =glyphIndex; i<len; i++)
- cglyphs[i] = glyphs[i-glyphIndex];
- if (len > maxGlyph)
- maxGlyph = len;
-}
-
-- (void)setIntAttribute: (NSInteger)attributeTag value: (NSInteger)val
- forGlyphAtIndex: (NSUInteger)glyphIndex
-{
- return;
-}
-
-@end
-#endif /* NS_IMPL_COCOA */
-
-
/* Debugging */
void
ns_dump_glyphstring (struct glyph_string *s)
diff --git a/src/nsimage.m b/src/nsimage.m
index 966e704..da6f01c 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -36,6 +36,14 @@ GNUstep port and post-20 update by Adrian Robert
(arobert@cogsci.ucsd.edu)
#include "coding.h"
+#if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MAX_ALLOWED < 1070
+# define COLORSPACE_NAME NSCalibratedRGBColorSpace
+#else
+# define COLORSPACE_NAME \
+ ((ns_use_srgb_colorspace && NSAppKitVersionNumber >=
NSAppKitVersionNumber10_7) \
+ ? NSDeviceRGBColorSpace : NSCalibratedRGBColorSpace)
+#endif
+
/* ==========================================================================
@@ -295,7 +303,7 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
pixelsWide: w pixelsHigh: h
bitsPerSample: 8 samplesPerPixel: 4
hasAlpha: YES isPlanar: YES
- colorSpaceName: NSCalibratedRGBColorSpace
+ colorSpaceName: COLORSPACE_NAME
bytesPerRow: w bitsPerPixel: 0];
[bmRep getBitmapDataPlanes: planes];
@@ -415,7 +423,7 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
/* keep things simple for now */
bitsPerSample: 8 samplesPerPixel: 4 /*RGB+A*/
hasAlpha: YES isPlanar: YES
- colorSpaceName: NSCalibratedRGBColorSpace
+ colorSpaceName: COLORSPACE_NAME
bytesPerRow: width bitsPerPixel: 0];
[bmRep getBitmapDataPlanes: pixmapData];
diff --git a/src/nsterm.h b/src/nsterm.h
index b56bcad..f292993 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -718,22 +718,6 @@ typedef id instancetype;
==========================================================================
*/
-#ifdef NS_IMPL_COCOA
-/* rendering util */
-@interface EmacsGlyphStorage : NSObject <NSGlyphStorage>
-{
-@public
- NSAttributedString *attrStr;
- NSMutableDictionary *dict;
- CGGlyph *cglyphs;
- unsigned long maxChar, maxGlyph;
- long i, len;
-}
-- (instancetype)initWithCapacity: (unsigned long) c;
-- (void) setString: (NSString *)str font: (NSFont *)font;
-@end
-#endif /* NS_IMPL_COCOA */
-
extern NSArray *ns_send_types, *ns_return_types;
extern NSString *ns_app_name;
extern EmacsMenu *svcsMenu;
@@ -811,6 +795,7 @@ struct ns_color_table
#define GREEN16_FROM_ULONG(color) (GREEN_FROM_ULONG(color) * 0x101)
#define BLUE16_FROM_ULONG(color) (BLUE_FROM_ULONG(color) * 0x101)
+#ifdef NS_IMPL_GNUSTEP
/* this extends font backend font */
struct nsfont_info
{
@@ -827,14 +812,8 @@ struct nsfont_info
float size;
#ifdef __OBJC__
NSFont *nsfont;
-#if defined (NS_IMPL_COCOA)
- CGFontRef cgfont;
-#else /* GNUstep */
- void *cgfont;
-#endif
#else /* ! OBJC */
void *nsfont;
- void *cgfont;
#endif
char bold, ital; /* convenience flags */
char synthItal;
@@ -844,7 +823,7 @@ struct nsfont_info
unsigned short **glyphs; /* map Unicode index to glyph */
struct font_metrics **metrics;
};
-
+#endif
/* Initialized in ns_initialize_display_info (). */
struct ns_display_info
@@ -1107,7 +1086,7 @@ extern void ns_term_shutdown (int sig);
#define NS_DUMPGLYPH_MOUSEFACE 3
-
+#ifdef NS_IMPL_GNUSTEP
/* In nsfont, called from fontset.c */
extern void nsfont_make_fontset_for_font (Lisp_Object name,
Lisp_Object font_object);
@@ -1115,6 +1094,7 @@ extern void nsfont_make_fontset_for_font (Lisp_Object
name,
/* In nsfont, for debugging */
struct glyph_string;
void ns_dump_glyphstring (struct glyph_string *s) EXTERNALLY_VISIBLE;
+#endif
/* Implemented in nsterm, published in or needed from nsfns. */
extern Lisp_Object ns_list_fonts (struct frame *f, Lisp_Object pattern,
@@ -1274,6 +1254,19 @@ extern char gnustep_base_version[]; /* version tracking
*/
? (min) : (((x)>(max)) ? (max) : (x)))
#define SCREENMAXBOUND(x) (IN_BOUND (-SCREENMAX, x, SCREENMAX))
+
+#ifdef NS_IMPL_COCOA
+/* Add some required AppKit version numbers if they're not defined. */
+#ifndef NSAppKitVersionNumber10_7
+#define NSAppKitVersionNumber10_7 1138
+#endif
+
+#ifndef NSAppKitVersionNumber10_10
+#define NSAppKitVersionNumber10_10 1343
+#endif
+#endif /* NS_IMPL_COCOA */
+
+
/* macOS 10.7 introduces some new constants. */
#if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_7)
#define NSFullScreenWindowMask (1 << 14)
diff --git a/src/nsterm.m b/src/nsterm.m
index 5e5d09f..fdcd677 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -140,14 +140,9 @@ char const * nstrace_fullscreen_type_name (int fs_type)
+ (NSColor *)colorForEmacsRed:(CGFloat)red green:(CGFloat)green
blue:(CGFloat)blue alpha:(CGFloat)alpha
{
-#if defined (NS_IMPL_COCOA) \
- && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
if (ns_use_srgb_colorspace
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
- && [NSColor respondsToSelector:
- @selector(colorWithSRGBRed:green:blue:alpha:)]
-#endif
- )
+ && NSAppKitVersionNumber >= NSAppKitVersionNumber10_7)
return [NSColor colorWithSRGBRed: red
green: green
blue: blue
@@ -161,28 +156,12 @@ char const * nstrace_fullscreen_type_name (int fs_type)
- (NSColor *)colorUsingDefaultColorSpace
{
- /* FIXME: We're checking for colorWithSRGBRed here so this will only
- work in the same place as in the method above. It should really
- be a check whether we're on macOS 10.7 or above. */
-#if defined (NS_IMPL_COCOA) \
- && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
- if ([NSColor respondsToSelector:
- @selector(colorWithSRGBRed:green:blue:alpha:)])
-#endif
- {
- if (ns_use_srgb_colorspace)
- return [self colorUsingColorSpace: [NSColorSpace sRGBColorSpace]];
- else
- return [self colorUsingColorSpace: [NSColorSpace deviceRGBColorSpace]];
- }
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
- else
-#endif
-#endif /* NS_IMPL_COCOA && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 */
-#if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MIN_REQUIRED < 1070
- return [self colorUsingColorSpaceName: NSCalibratedRGBColorSpace];
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+ if (ns_use_srgb_colorspace
+ && NSAppKitVersionNumber >= NSAppKitVersionNumber10_7)
+ return [self colorUsingColorSpace: [NSColorSpace sRGBColorSpace]];
#endif
+ return [self colorUsingColorSpace: [NSColorSpace deviceRGBColorSpace]];
}
@end
@@ -2209,10 +2188,6 @@ ns_set_appearance (struct frame *f, Lisp_Object
new_value, Lisp_Object old_value
NSTRACE ("ns_set_appearance");
-#ifndef NSAppKitVersionNumber10_10
-#define NSAppKitVersionNumber10_10 1343
-#endif
-
if (NSAppKitVersionNumber < NSAppKitVersionNumber10_10)
return;
@@ -3053,6 +3028,40 @@ ns_scroll_run (struct window *w, struct run *run)
static void
+ns_clear_under_internal_border (struct frame *f)
+{
+ NSTRACE ("ns_clear_under_internal_border");
+
+ if (FRAME_INTERNAL_BORDER_WIDTH (f) > 0)
+ {
+ int border_width = FRAME_INTERNAL_BORDER_WIDTH (f);
+ NSView *view = FRAME_NS_VIEW (f);
+ NSRect edge_rect, frame_rect = [view bounds];
+ NSRectEdge edge[] = {NSMinXEdge, NSMinYEdge, NSMaxXEdge, NSMaxYEdge};
+
+ int face_id =
+ !NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
+ : INTERNAL_BORDER_FACE_ID;
+ struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
+
+ if (!face)
+ face = FRAME_DEFAULT_FACE (f);
+
+ ns_focus (f, &frame_rect, 1);
+ [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set];
+ for (int i = 0; i < 4 ; i++)
+ {
+ NSDivideRect (frame_rect, &edge_rect, &frame_rect, border_width,
edge[i]);
+
+ NSRectFill (edge_rect);
+ }
+ ns_unfocus (f);
+ }
+}
+
+
+static void
ns_after_update_window_line (struct window *w, struct glyph_row *desired_row)
/* --------------------------------------------------------------------------
External (RIF): preparatory to fringe update after text was updated
@@ -3080,12 +3089,32 @@ ns_after_update_window_line (struct window *w, struct
glyph_row *desired_row)
height > 0))
{
int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y));
+ int face_id =
+ !NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
+ : INTERNAL_BORDER_FACE_ID;
+ struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
block_input ();
- ns_clear_frame_area (f, 0, y, width, height);
- ns_clear_frame_area (f,
- FRAME_PIXEL_WIDTH (f) - width,
- y, width, height);
+ if (face)
+ {
+ NSRect r = NSMakeRect (0, y, FRAME_PIXEL_WIDTH (f), height);
+ ns_focus (f, &r, 1);
+
+ [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set];
+ NSRectFill (NSMakeRect (0, y, width, height));
+ NSRectFill (NSMakeRect (FRAME_PIXEL_WIDTH (f) - width,
+ y, width, height));
+
+ ns_unfocus (f);
+ }
+ else
+ {
+ ns_clear_frame_area (f, 0, y, width, height);
+ ns_clear_frame_area (f,
+ FRAME_PIXEL_WIDTH (f) - width,
+ y, width, height);
+ }
unblock_input ();
}
}
@@ -3140,10 +3169,12 @@ ns_compute_glyph_string_overhangs (struct glyph_string
*s)
else
{
s->left_overhang = 0;
+#ifdef NS_IMPL_GNUSTEP
if (EQ (font->driver->type, Qns))
s->right_overhang = ((struct nsfont_info *)font)->ital ?
FONT_HEIGHT (font) * 0.2 : 0;
else
+#endif
s->right_overhang = 0;
}
}
@@ -5301,7 +5332,7 @@ static struct redisplay_interface ns_redisplay_interface =
ns_draw_glyph_string,
ns_define_frame_cursor,
ns_clear_frame_area,
- 0, /* clear_under_internal_border */
+ ns_clear_under_internal_border, /* clear_under_internal_border */
ns_draw_window_cursor,
ns_draw_vertical_window_border,
ns_draw_window_divider,
diff --git a/src/process.c b/src/process.c
index 53f4a1d..50c4250 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1205,6 +1205,16 @@ not the name of the pty that Emacs uses to talk with
that terminal. */)
return XPROCESS (process)->tty_name;
}
+static void
+update_process_mark (struct Lisp_Process *p)
+{
+ Lisp_Object buffer = p->buffer;
+ if (BUFFERP (buffer))
+ set_marker_both (p->mark, buffer,
+ BUF_ZV (XBUFFER (buffer)),
+ BUF_ZV_BYTE (XBUFFER (buffer)));
+}
+
DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
2, 2, 0,
doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
@@ -1217,7 +1227,11 @@ Return BUFFER. */)
if (!NILP (buffer))
CHECK_BUFFER (buffer);
p = XPROCESS (process);
- pset_buffer (p, buffer);
+ if (!EQ (p->buffer, buffer))
+ {
+ pset_buffer (p, buffer);
+ update_process_mark (p);
+ }
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer));
setup_process_coding_systems (process);
@@ -1637,6 +1651,7 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0,
0, 0,
return Fmapcar (Qcdr, Vprocess_alist);
}
+
/* Starting asynchronous inferior processes. */
DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
@@ -1805,10 +1820,7 @@ usage: (make-process &rest ARGS) */)
: EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
/* Make the process marker point into the process buffer (if any). */
- if (BUFFERP (buffer))
- set_marker_both (XPROCESS (proc)->mark, buffer,
- BUF_ZV (XBUFFER (buffer)),
- BUF_ZV_BYTE (XBUFFER (buffer)));
+ update_process_mark (XPROCESS (proc));
USE_SAFE_ALLOCA;
@@ -2453,10 +2465,7 @@ usage: (make-pipe-process &rest ARGS) */)
: EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
/* Make the process marker point into the process buffer (if any). */
- if (BUFFERP (buffer))
- set_marker_both (p->mark, buffer,
- BUF_ZV (XBUFFER (buffer)),
- BUF_ZV_BYTE (XBUFFER (buffer)));
+ update_process_mark (p);
{
/* Setup coding systems for communicating with the network stream. */
@@ -3182,12 +3191,7 @@ usage: (make-serial-process &rest ARGS) */)
if (!EQ (p->command, Qt))
add_process_read_fd (fd);
- if (BUFFERP (buffer))
- {
- set_marker_both (p->mark, buffer,
- BUF_ZV (XBUFFER (buffer)),
- BUF_ZV_BYTE (XBUFFER (buffer)));
- }
+ update_process_mark (p);
tem = Fplist_get (contact, QCcoding);
@@ -3664,10 +3668,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object
addrinfos,
pset_status (p, Qlisten);
/* Make the process marker point into the process buffer (if any). */
- if (BUFFERP (p->buffer))
- set_marker_both (p->mark, p->buffer,
- BUF_ZV (XBUFFER (p->buffer)),
- BUF_ZV_BYTE (XBUFFER (p->buffer)));
+ update_process_mark (p);
if (p->is_non_blocking_client)
{
diff --git a/src/syntax.c b/src/syntax.c
index e6af8a3..066972e 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -2354,6 +2354,13 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte,
ptrdiff_t stop,
/* We have encountered a nested comment of the same style
as the comment sequence which began this comment section. */
nesting++;
+ if (comment_end_can_be_escaped
+ && (code == Sescape || code == Scharquote))
+ {
+ inc_both (&from, &from_byte);
+ UPDATE_SYNTAX_TABLE_FORWARD (from);
+ if (from == stop) continue; /* Failure */
+ }
inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
diff --git a/src/xdisp.c b/src/xdisp.c
index ac5307f..3d40878 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -11809,7 +11809,20 @@ resize_mini_window (struct window *w, bool exact_p)
height = (max_height / unit) * unit;
init_iterator (&it, w, ZV, ZV_BYTE, NULL, DEFAULT_FACE_ID);
move_it_vertically_backward (&it, height - unit);
+ /* The following move is usually a no-op when the stuff
+ displayed in the mini-window comes entirely from buffer
+ text, but it is needed when some of it comes from overlay
+ strings, especially when there's an after-string at ZV.
+ This happens with some completion packages, like
+ icomplete, ido-vertical, etc. With those packages, if we
+ don't force w->start to be at the beginning of a screen
+ line, important parts of the stuff in the mini-window,
+ such as user prompt, will be hidden from view. */
+ move_it_by_lines (&it, 0);
start = it.current.pos;
+ /* Prevent redisplay_window from recentering, and thus from
+ overriding the window-start point we computed here. */
+ w->start_at_line_beg = false;
}
else
SET_TEXT_POS (start, BEGV, BEGV_BYTE);
diff --git a/test/lisp/allout-tests.el b/test/lisp/allout-tests.el
new file mode 100644
index 0000000..f7cd6db
--- /dev/null
+++ b/test/lisp/allout-tests.el
@@ -0,0 +1,148 @@
+;;; allout-tests.el --- Tests for allout.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'allout)
+
+(require 'cl-lib)
+
+(defun allout-tests-obliterate-variable (name)
+ "Completely unbind variable with NAME."
+ (if (local-variable-p name (current-buffer)) (kill-local-variable name))
+ (while (boundp name) (makunbound name)))
+
+(defvar allout-tests-globally-unbound nil
+ "Fodder for allout resumptions tests -- defvar just for byte compiler.")
+(defvar allout-tests-globally-true nil
+ "Fodder for allout resumptions tests -- defvar just for byte compiler.")
+(defvar allout-tests-locally-true nil
+ "Fodder for allout resumptions tests -- defvar just for byte compiler.")
+
+;; For each resumption case, we also test that the right local/global
+;; scopes are affected during resumption effects.
+
+(ert-deftest allout-test-resumption-unbound-return-to-unbound ()
+ "Previously unbound variables return to the unbound state."
+ (with-temp-buffer
+ (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
+ (allout-add-resumptions '(allout-tests-globally-unbound t))
+ (should (not (default-boundp 'allout-tests-globally-unbound)))
+ (should (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
+ (should (boundp 'allout-tests-globally-unbound))
+ (should (equal allout-tests-globally-unbound t))
+ (allout-do-resumptions)
+ (should (not (local-variable-p 'allout-tests-globally-unbound
+ (current-buffer))))
+ (should (not (boundp 'allout-tests-globally-unbound)))))
+
+(ert-deftest allout-test-resumption-variable-resumed ()
+ "Ensure that variable with prior global value is resumed."
+ (with-temp-buffer
+ (allout-tests-obliterate-variable 'allout-tests-globally-true)
+ (setq allout-tests-globally-true t)
+ (allout-add-resumptions '(allout-tests-globally-true nil))
+ (should (equal (default-value 'allout-tests-globally-true) t))
+ (should (local-variable-p 'allout-tests-globally-true (current-buffer)))
+ (should (equal allout-tests-globally-true nil))
+ (allout-do-resumptions)
+ (should (not (local-variable-p 'allout-tests-globally-true
+ (current-buffer))))
+ (should (boundp 'allout-tests-globally-true))
+ (should (equal allout-tests-globally-true t))))
+
+(ert-deftest allout-test-resumption-prior-value-resumed ()
+ "Ensure that prior local value is resumed."
+ (with-temp-buffer
+ (allout-tests-obliterate-variable 'allout-tests-locally-true)
+ (set (make-local-variable 'allout-tests-locally-true) t)
+ (cl-assert (not (default-boundp 'allout-tests-locally-true))
+ nil (concat "Test setup mistake -- variable supposed to"
+ " not have global binding, but it does."))
+ (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))
+ nil (concat "Test setup mistake -- variable supposed to have"
+ " local binding, but it lacks one."))
+ (allout-add-resumptions '(allout-tests-locally-true nil))
+ (should (not (default-boundp 'allout-tests-locally-true)))
+ (should (local-variable-p 'allout-tests-locally-true (current-buffer)))
+ (should (equal allout-tests-locally-true nil))
+ (allout-do-resumptions)
+ (should (boundp 'allout-tests-locally-true))
+ (should (local-variable-p 'allout-tests-locally-true (current-buffer)))
+ (should (equal allout-tests-locally-true t))
+ (should (not (default-boundp 'allout-tests-locally-true)))))
+
+(ert-deftest allout-test-resumption-multiple-holds ()
+ "Ensure that last of multiple resumptions holds, for various scopes."
+ (with-temp-buffer
+ (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
+ (allout-tests-obliterate-variable 'allout-tests-globally-true)
+ (setq allout-tests-globally-true t)
+ (allout-tests-obliterate-variable 'allout-tests-locally-true)
+ (set (make-local-variable 'allout-tests-locally-true) t)
+ (allout-add-resumptions '(allout-tests-globally-unbound t)
+ '(allout-tests-globally-true nil)
+ '(allout-tests-locally-true nil))
+ (allout-add-resumptions '(allout-tests-globally-unbound 2)
+ '(allout-tests-globally-true 3)
+ '(allout-tests-locally-true 4))
+ ;; reestablish many of the basic conditions are maintained after re-add:
+ (should (not (default-boundp 'allout-tests-globally-unbound)))
+ (should (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
+ (should (equal allout-tests-globally-unbound 2))
+ (should (default-boundp 'allout-tests-globally-true))
+ (should (local-variable-p 'allout-tests-globally-true (current-buffer)))
+ (should (equal allout-tests-globally-true 3))
+ (should (not (default-boundp 'allout-tests-locally-true)))
+ (should (local-variable-p 'allout-tests-locally-true (current-buffer)))
+ (should (equal allout-tests-locally-true 4))
+ (allout-do-resumptions)
+ (should (not (local-variable-p 'allout-tests-globally-unbound
+ (current-buffer))))
+ (should (not (boundp 'allout-tests-globally-unbound)))
+ (should (not (local-variable-p 'allout-tests-globally-true
+ (current-buffer))))
+ (should (boundp 'allout-tests-globally-true))
+ (should (equal allout-tests-globally-true t))
+ (should (boundp 'allout-tests-locally-true))
+ (should (local-variable-p 'allout-tests-locally-true (current-buffer)))
+ (should (equal allout-tests-locally-true t))
+ (should (not (default-boundp 'allout-tests-locally-true)))))
+
+(ert-deftest allout-test-resumption-unbinding ()
+ "Ensure that deliberately unbinding registered variables doesn't foul
things."
+ (with-temp-buffer
+ (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
+ (allout-tests-obliterate-variable 'allout-tests-globally-true)
+ (setq allout-tests-globally-true t)
+ (allout-tests-obliterate-variable 'allout-tests-locally-true)
+ (set (make-local-variable 'allout-tests-locally-true) t)
+ (allout-add-resumptions '(allout-tests-globally-unbound t)
+ '(allout-tests-globally-true nil)
+ '(allout-tests-locally-true nil))
+ (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
+ (allout-tests-obliterate-variable 'allout-tests-globally-true)
+ (allout-tests-obliterate-variable 'allout-tests-locally-true)
+ (allout-do-resumptions)))
+
+(provide 'allout-tests)
+;;; allout-tests.el ends here
diff --git a/test/lisp/allout-widgets-tests.el
b/test/lisp/allout-widgets-tests.el
new file mode 100644
index 0000000..2b1bcaa
--- /dev/null
+++ b/test/lisp/allout-widgets-tests.el
@@ -0,0 +1,87 @@
+;;; allout-widgets-tests.el --- Tests for allout-widgets.el -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'allout-widgets)
+
+(require 'cl-lib)
+
+(ert-deftest allout-test-range-overlaps ()
+ "`allout-range-overlaps' unit tests."
+ (let* (ranges
+ got
+ (try (lambda (from to)
+ (setq got (allout-range-overlaps from to ranges))
+ (setq ranges (cadr got))
+ got)))
+;; ;; biggie:
+;; (setq ranges nil)
+;; ;; ~ .02 to .1 seconds for just repeated listing args instead of funcall
+;; ;; ~ 13 seconds for doing repeated funcall
+;; (message "time-trial: %s, resulting size %s"
+;; (time-trial
+;; '(let ((size 10000)
+;; doing)
+;; (dotimes (count size)
+;; (setq doing (random size))
+;; (funcall try doing (+ doing (random 5)))
+;; ;;(list doing (+ doing (random 5)))
+;; )))
+;; (length ranges))
+;; (sit-for 2)
+
+ ;; fresh:
+ (setq ranges nil)
+ (should (equal (funcall try 3 5) '(nil ((3 5)))))
+ ;; add range at end:
+ (should (equal (funcall try 10 12) '(nil ((3 5) (10 12)))))
+ ;; add range at beginning:
+ (should (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12)))))
+ ;; insert range somewhere in the middle:
+ (should (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12)))))
+ ;; consolidate some:
+ (should (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12)))))
+ ;; add more:
+ (should (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17)))))
+ ;; add more:
+ (should (equal (funcall try 20 22)
+ '(nil ((1 2) (3 9) (10 12) (15 17) (20 22)))))
+ ;; encompass more:
+ (should (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22)))))
+ ;; encompass all:
+ (should (equal (funcall try 2 25) '(t ((1 25)))))
+
+ ;; fresh slate:
+ (setq ranges nil)
+ (should (equal (funcall try 20 25) '(nil ((20 25)))))
+ (should (equal (funcall try 30 35) '(nil ((20 25) (30 35)))))
+ (should (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35)))))
+ (should (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35)))))
+ (should (equal (funcall try 10 30) '(t ((10 35)))))
+ (should (equal (funcall try 5 6) '(nil ((5 6) (10 35)))))
+ (should (equal (funcall try 2 100) '(t ((2 100)))))
+
+ (setq ranges nil)))
+
+(provide 'allout-widgets-tests)
+;;; allout-widgets-tests.el ends here
diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el
index 22ca7e2..e92a4d2 100644
--- a/test/lisp/arc-mode-tests.el
+++ b/test/lisp/arc-mode-tests.el
@@ -32,7 +32,7 @@
(cons 1024 "------S---") ; Bug#28092
(cons 2048 "---S------"))))
(dolist (x alist)
- (should (equal (cdr x) (archive-int-to-mode (car x)))))))
+ (should (equal (cdr x) (file-modes-number-to-symbolic (car x)))))))
(ert-deftest arc-mode-test-zip-extract-gz ()
(skip-unless (and archive-zip-extract (executable-find (car
archive-zip-extract))))
diff --git a/test/lisp/completion-tests.el b/test/lisp/completion-tests.el
new file mode 100644
index 0000000..7473bbb
--- /dev/null
+++ b/test/lisp/completion-tests.el
@@ -0,0 +1,170 @@
+;;; completion-tests.el --- Tests for completion.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'completion)
+
+(ert-deftest completion-test-cmpl-string-case-type ()
+ (should (eq (cmpl-string-case-type "123ABCDEF456") :up))
+ (should (eq (cmpl-string-case-type "123abcdef456") :down))
+ (should (eq (cmpl-string-case-type "123aBcDeF456") :mixed))
+ (should (eq (cmpl-string-case-type "123456") :neither))
+ (should (eq (cmpl-string-case-type "Abcde123") :capitalized)))
+
+(ert-deftest completion-test-cmpl-merge-string-cases ()
+ (should (equal (cmpl-merge-string-cases "AbCdEf456" "abc") "AbCdEf456"))
+ (should (equal (cmpl-merge-string-cases "abcdef456" "ABC") "ABCDEF456"))
+ (should (equal (cmpl-merge-string-cases "ABCDEF456" "Abc") "Abcdef456"))
+ (should (equal (cmpl-merge-string-cases "ABCDEF456" "abc") "abcdef456")))
+
+(ert-deftest completion-test-add-find-delete-tail ()
+ (unwind-protect
+ (progn
+ ;; - Add and Find -
+ (should (equal (add-completion-to-head "banana") '("banana" 0 nil 0)))
+ (should (equal (find-exact-completion "banana") '("banana" 0 nil 0)))
+ (should (equal (find-exact-completion "bana") nil))
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil
0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil
0))))
+
+ (should (equal (add-completion-to-head "banish") '("banish" 0 nil 0)))
+ (should (equal (find-exact-completion "banish") '("banish" 0 nil 0)))
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil
0) ("banana" 0 nil 0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil
0))))
+
+ (should (equal (add-completion-to-head "banana") '("banana" 0 nil 0)))
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil
0) ("banish" 0 nil 0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil
0))))
+
+ ;; - Deleting -
+ (should (equal (add-completion-to-head "banner") '("banner" 0 nil 0)))
+ (delete-completion "banner")
+ (should-not (find-exact-completion "banner"))
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil
0) ("banish" 0 nil 0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil
0))))
+ (should (equal (add-completion-to-head "banner") '("banner" 0 nil 0)))
+ (delete-completion "banana")
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banner" 0 nil
0) ("banish" 0 nil 0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil
0))))
+ (delete-completion "banner")
+ (delete-completion "banish")
+ (should-not (find-cmpl-prefix-entry "ban"))
+ (should-error (delete-completion "banner"))
+
+ ;; - Tail -
+ (should (equal (add-completion-to-tail-if-new "banana") '("banana" 0
nil 0)))
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil
0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil
0))))
+ (add-completion-to-tail-if-new "banish") '("banish" 0 nil 0)
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil
0) ("banish" 0 nil 0))))
+ (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil
0)))))
+ (ignore-errors (kill-completion "banana"))
+ (ignore-errors (kill-completion "banner"))
+ (ignore-errors (kill-completion "banish"))))
+
+(ert-deftest completion-test-add-find-accept-delete ()
+ (unwind-protect
+ (progn
+ ;; - Add and Find -
+ (add-completion "banana" 5 10)
+ (should (equal (find-exact-completion "banana") '("banana" 5 10 0)))
+ (add-completion "banana" 6)
+ (should (equal (find-exact-completion "banana") '("banana" 6 10 0)))
+ (add-completion "banish")
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil
0) ("banana" 6 10 0))))
+
+ ;; - Accepting -
+ (setq completion-to-accept "banana")
+ (accept-completion)
+ (should (equal (find-exact-completion "banana") '("banana" 7 10 0)))
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 7 10
0) ("banish" 0 nil 0))))
+ (setq completion-to-accept "banish")
+ (add-completion "banner")
+ (should (equal (car (find-cmpl-prefix-entry "ban"))
+ '(("banner" 0 nil 0) ("banish" 1 nil 0) ("banana" 7 10
0))))
+
+ ;; - Deleting -
+ (kill-completion "banish")
+ (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banner" 0 nil
0) ("banana" 7 10 0)))))
+ (ignore-errors (kill-completion "banish"))
+ (ignore-errors (kill-completion "banana"))
+ (ignore-errors (kill-completion "banner"))))
+
+(ert-deftest completion-test-search ()
+ (unwind-protect
+ (progn
+ ;; - Add and Find -
+ (add-completion "banana")
+ (completion-search-reset "ban")
+ (should (equal (car (completion-search-next 0)) "banana"))
+
+ ;; - Discrimination -
+ (add-completion "cumberland")
+ (add-completion "cumberbund")
+ ;; cumbering
+ (completion-search-reset "cumb")
+ (should (equal (car (completion-search-peek t)) "cumberbund"))
+ (should (equal (car (completion-search-next 0)) "cumberbund"))
+ (should (equal (car (completion-search-peek t)) "cumberland"))
+ (should (equal (car (completion-search-next 1)) "cumberland"))
+ (should-not (completion-search-peek nil))
+
+ ;; FIXME
+ ;; (should (equal (completion-search-next 2) "cumbering")) ;
{cdabbrev}
+ ;;(completion-search-next 3) --> nil or "cumming" {depends on
context}
+
+ (should (equal (car (completion-search-next 1)) "cumberland"))
+
+ ;; FIXME
+ ;; (should (equal (completion-search-peek t) "cumbering")) ;
{cdabbrev}
+
+ ;; - Accepting -
+ (should (equal (car (completion-search-next 1)) "cumberland"))
+ (setq completion-to-accept "cumberland")
+ (completion-search-reset "foo")
+ (completion-search-reset "cum")
+ (should (equal (car (completion-search-next 0)) "cumberland"))
+
+ ;; - Deleting -
+ (kill-completion "cumberland")
+ (add-completion "cummings")
+ (completion-search-reset "cum")
+ (should (equal (car (completion-search-next 0)) "cummings"))
+ (should (equal (car (completion-search-next 1)) "cumberbund"))
+
+ ;; - Ignoring Capitalization -
+ (completion-search-reset "CuMb")
+ (should (equal (car (completion-search-next 0)) "cumberbund")))
+ (ignore-errors (kill-completion "banana"))
+ (ignore-errors (kill-completion "cumberland"))
+ (ignore-errors (kill-completion "cumberbund"))
+ (ignore-errors (kill-completion "cummings"))))
+
+(ert-deftest completion-test-lisp-def-regexp ()
+ (should (= (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end
0)) 8))
+ (should (= (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end
0)) 9))
+ (should (= (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end
0)) 10))
+ (should (= (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end
0)) 9)))
+
+(provide 'completion-tests)
+;;; completion-tests.el ends here
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el
index cabbf86..76661dc 100644
--- a/test/lisp/custom-tests.el
+++ b/test/lisp/custom-tests.el
@@ -147,4 +147,15 @@
(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))))
+
;;; custom-tests.el ends here
diff --git a/test/lisp/emacs-lisp/ert-x-tests.el
b/test/lisp/emacs-lisp/ert-x-tests.el
index b760f8c..f342bff 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -187,18 +187,15 @@
"Tests `ert-describe-test'."
(save-window-excursion
(ert-with-buffer-renamed ("*Help*")
- (if (< emacs-major-version 24)
- (should (equal (should-error (ert-describe-test 'ert-describe-test))
- '(error "Requires Emacs 24")))
- (ert-describe-test 'ert-test-describe-test)
- (with-current-buffer "*Help*"
- (let ((case-fold-search nil))
- (should (string-match (concat
- "\\`ert-test-describe-test is a test"
- " defined in"
- " ['`‘]ert-x-tests.elc?['’]\\.\n\n"
- "Tests ['`‘]ert-describe-test['’]\\.\n\\'")
- (buffer-string)))))))))
+ (ert-describe-test 'ert-test-describe-test)
+ (with-current-buffer "*Help*"
+ (let ((case-fold-search nil))
+ (should (string-match (concat
+ "\\`ert-test-describe-test is a test"
+ " defined in"
+ " ['`‘]ert-x-tests.elc?['’]\\.\n\n"
+ "Tests ['`‘]ert-describe-test['’]\\.\n\\'")
+ (buffer-string))))))))
(ert-deftest ert-test-message-log-truncation ()
:tags '(:causes-redisplay)
diff --git a/test/lisp/emacs-lisp/lisp-tests.el
b/test/lisp/emacs-lisp/lisp-tests.el
index a2b8304..437b907 100644
--- a/test/lisp/emacs-lisp/lisp-tests.el
+++ b/test/lisp/emacs-lisp/lisp-tests.el
@@ -136,8 +136,7 @@
(text-mode)
(insert "\"foo\"")
(goto-char (point-min))
- (delete-pair)
- (should (string-equal "fo\"" (buffer-string)))))
+ (should-error (delete-pair))))
(ert-deftest lisp-delete-pair-quotes-text-mode-syntax-table ()
"Test \\[delete-pair] with modified Text Mode syntax for #15014."
@@ -296,7 +295,7 @@
(lambda () (up-list 1 t t))
(or "(1 '2 ( 2' 1 '2 ) 2' 1)")
;; abcdefghijklmnopqrstuvwxy
- i k x scan-error)
+ i k x user-error)
(define-lisp-up-list-test backward-up-list-basic
(lambda () (backward-up-list))
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index da2b49e..811b367 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -123,6 +123,9 @@ Return first line of the output of (describe-function-1
FUNC)."
(goto-char (point-min))
(should (looking-at "^font-lock-comment-face is "))))
+(defvar foo-test-map)
+(defvar help-fns-test--describe-keymap-foo)
+
;;; Tests for describe-keymap
(ert-deftest help-fns-test-find-keymap-name ()
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 62ed3f2..0f5582b 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -4,18 +4,20 @@
;; Author: Michael Albinus <michael.albinus@gmx.de>
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; 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 this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -63,6 +65,7 @@
(ert-deftest dbus-test01-type-conversion ()
"Check type conversion functions."
+ (skip-unless dbus--test-enabled-session-bus)
(let ((ustr "0123abc_xyz\x01\xff")
(mstr "Grüß Göttin"))
(should
@@ -93,6 +96,7 @@
(ert-deftest dbus-test01-basic-types ()
"Check basic D-Bus type arguments."
+ (skip-unless dbus--test-enabled-session-bus)
;; Unknown keyword.
(should-error
(dbus-check-arguments :session dbus--test-service :keyword)
@@ -265,12 +269,13 @@
(dbus-check-arguments :session dbus--test-service :double "string")
:type 'wrong-type-argument)
- ;; `:unix-fd'. Value range 0 .. 9.
+ ;; `:unix-fd'. UNIX file descriptors are transfered out-of-band.
+ ;; We do not support this, and so we cannot do much testing here for
+ ;; `:unix-fd' being an argument (which is an index to the file
+ ;; descriptor in the array of file descriptors that accompany the
+ ;; D-Bus message). Mainly testing, that values out of `:uint32'
+ ;; type range fail.
(should (dbus-check-arguments :session dbus--test-service :unix-fd 0))
- (should (dbus-check-arguments :session dbus--test-service :unix-fd 9))
- (should-error
- (dbus-check-arguments :session dbus--test-service :unix-fd 10)
- :type 'dbus-error)
(should-error
(dbus-check-arguments :session dbus--test-service :unix-fd -1)
:type 'args-out-of-range)
diff --git a/test/lisp/progmodes/compile-tests.el
b/test/lisp/progmodes/compile-tests.el
index 819f2e7..45eebac 100644
--- a/test/lisp/progmodes/compile-tests.el
+++ b/test/lisp/progmodes/compile-tests.el
@@ -324,6 +324,9 @@
1 8 71 "/home/reto/test/group.xml")
("Warning: Start tag for undeclared element geroup\nin unnamed entity at
line 4 char 8 of file:///home/reto/test/group.xml"
1 8 4 "/home/reto/test/group.xml")
+ ;; shellcheck
+ ("In autogen.sh line 48:"
+ 1 nil 48 "autogen.sh")
;; sparc-pascal-file sparc-pascal-line sparc-pascal-example
("Thu May 14 10:46:12 1992 mom3.p:"
1 nil nil "mom3.p")
@@ -436,7 +439,7 @@ The test data is in `compile-tests--test-regexps-data'."
(compilation-num-warnings-found 0)
(compilation-num-infos-found 0))
(mapc #'compile--test-error-line compile-tests--test-regexps-data)
- (should (eq compilation-num-errors-found 95))
+ (should (eq compilation-num-errors-found 96))
(should (eq compilation-num-warnings-found 35))
(should (eq compilation-num-infos-found 28)))))
diff --git a/test/lisp/progmodes/ps-mode-tests.el
b/test/lisp/progmodes/ps-mode-tests.el
index eedf3f7..61cf4c6 100644
--- a/test/lisp/progmodes/ps-mode-tests.el
+++ b/test/lisp/progmodes/ps-mode-tests.el
@@ -54,7 +54,7 @@
< 23 > %hex string
<~a>a%a~> %base85 string
(%)s
-(sf\(g>a)sdg)
+(sf\\(g>a)sdg)
/foo {
<<
diff --git a/test/lisp/progmodes/ruby-mode-tests.el
b/test/lisp/progmodes/ruby-mode-tests.el
index fb3b42b..5988a49 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -848,8 +848,6 @@ VALUES-PLIST is a list with alternating index and value
elements."
(ruby--insert-coding-comment "utf-8")
(should (string= "# encoding: utf-8\n\n" (buffer-string))))))
-;; TODO: Convert these into unit proper tests instead of using an
-;; external file.
(ert-deftest ruby--indent/converted-from-manual-test ()
:tags '(:expensive-test)
;; Converted from manual test.
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 2adb4a6..505408f 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -456,7 +456,17 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350.";
(should (equal (replace-in-string "azot" "bar" "zat")
"zat"))
(should (equal (replace-in-string "azot" "bar" "azot")
- "bar")))
+ "bar"))
+
+ (should (equal (replace-in-string "azot" "bar" "foozotbar")
+ "foozotbar"))
+
+ (should (equal (replace-in-string "\377" "x" "a\377b")
+ "axb"))
+ (should (equal (replace-in-string "\377" "x" "a\377ø")
+ "axø"))
+
+ (should-error (replace-in-string "" "x" "abc")))
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/lisp/textmodes/css-mode-tests.el
b/test/lisp/textmodes/css-mode-tests.el
index 02bd2ac..f627d1c 100644
--- a/test/lisp/textmodes/css-mode-tests.el
+++ b/test/lisp/textmodes/css-mode-tests.el
@@ -417,8 +417,6 @@
(point))
"black")))))
-;; TODO: Convert these into unit proper tests instead of using an
-;; external file.
(ert-deftest css-mode-test-indent ()
(with-current-buffer
(find-file-noselect (expand-file-name "test-indent.css"
diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el
index 96e88f6..b89e8c8 100644
--- a/test/lisp/wdired-tests.el
+++ b/test/lisp/wdired-tests.el
@@ -106,7 +106,6 @@ only the name before the link arrow."
"Test editing a file name without saving the change.
Finding the new name should be possible while still in
wdired-mode."
- :expected-result (if (< emacs-major-version 27) :failed :passed)
(let* ((test-dir (make-temp-file "test-dir-" t))
(test-file (concat (file-name-as-directory test-dir) "foo.c"))
(replace "bar")
diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el
index 2ddb656..df49ffc 100644
--- a/test/lisp/wid-edit-tests.el
+++ b/test/lisp/wid-edit-tests.el
@@ -113,4 +113,20 @@
(should (eq (current-column)
(widget-get grandchild :indent)))))))
+(ert-deftest widget-test-character-widget-value ()
+ "Check that we get the character widget's value correctly."
+ (with-temp-buffer
+ (let ((wid (widget-create '(character :value ?\n))))
+ (goto-char (widget-get wid :from))
+ (should (string= (widget-apply wid :value-get) "\n"))
+ (should (char-equal (widget-value wid) ?\n))
+ (should-not (widget-apply wid :validate)))))
+
+(ert-deftest widget-test-editable-field-widget-value ()
+ "Test that we get the editable field widget's value correctly."
+ (with-temp-buffer
+ (let ((wid (widget-create '(editable-field :value ""))))
+ (widget-insert "And some non-widget text.")
+ (should (string= (widget-apply wid :value-get) "")))))
+
;;; wid-edit-tests.el ends here
diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el
index 72c78d0..d09336c 100644
--- a/test/lisp/xml-tests.el
+++ b/test/lisp/xml-tests.el
@@ -174,6 +174,27 @@ Parser is called with and without 'symbol-qnames
argument.")
:type 'xml-invalid-character)
'(xml-invalid-character #x3FFFFF 3)))))
+(defvar xml-tests--data-with-comments
+ `(;; simple case
+ ("<?xml version=\"1.0\"?><foo baz=\"true\">bar</foo>"
+ . ((foo ((baz . "true")) "bar")))
+ ;; toplevel comments -- first document child must not get lost
+ (,(concat "<?xml version=\"1.0\"?><foo>bar</foo><!--comment-1-->"
+ "<!--comment-2-->")
+ . ((foo nil "bar")))
+ (,(concat "<?xml version=\"1.0\"?><!--comment-a--><foo a=\"b\">"
+ "<bar>blub</bar></foo><!--comment-b--><!--comment-c-->")
+ . ((foo ((a . "b")) (bar nil "blub")))))
+ "Alist of XML strings and their expected parse trees for discarded
comments.")
+
+(ert-deftest xml-remove-comments ()
+ (dolist (test xml-tests--data-with-comments)
+ (erase-buffer)
+ (insert (car test))
+ (xml-remove-comments (point-min) (point-max))
+ (should (equal (cdr test)
+ (xml-parse-region (point-min) (point-max))))))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index b9a7d29..f2e1a26 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -166,6 +166,8 @@
(should (equal (should-error (sort "cba" #'<) :type 'wrong-type-argument)
'(wrong-type-argument list-or-vector-p "cba"))))
+(defvar w32-collate-ignore-punctuation)
+
(ert-deftest fns-tests-collate-sort ()
(skip-unless (fns-tests--collate-enabled-p))
@@ -228,9 +230,9 @@
(should (equal (func-arity 'format) '(1 . many)))
(require 'info)
(should (equal (func-arity 'Info-goto-node) '(1 . 3)))
- (should (equal (func-arity (lambda (&rest x))) '(0 . many)))
- (should (equal (func-arity (eval '(lambda (x &optional y)) nil)) '(1 . 2)))
- (should (equal (func-arity (eval '(lambda (x &optional y)) t)) '(1 . 2)))
+ (should (equal (func-arity (lambda (&rest _x))) '(0 . many)))
+ (should (equal (func-arity (eval '(lambda (_x &optional y)) nil)) '(1 . 2)))
+ (should (equal (func-arity (eval '(lambda (_x &optional y)) t)) '(1 . 2)))
(should (equal (func-arity 'let) '(1 . unevalled))))
(defun fns-tests--string-repeat (s o)
@@ -901,3 +903,54 @@
(should (equal (delete t [nil t]) [nil]))
(should (equal (delete 1 v1) (vector)))
(should (equal (delete 2 v1) v1))))
+
+(ert-deftest string-search ()
+ (should (equal (string-search "zot" "foobarzot") 6))
+ (should (equal (string-search "foo" "foobarzot") 0))
+ (should (not (string-search "fooz" "foobarzot")))
+ (should (not (string-search "zot" "foobarzo")))
+ (should (equal (string-search "ab" "ab") 0))
+ (should (equal (string-search "ab\0" "ab") nil))
+ (should (equal (string-search "ab" "abababab" 3) 4))
+ (should (equal (string-search "ab" "ababac" 3) nil))
+ (let ((case-fold-search t))
+ (should (equal (string-search "ab" "AB") nil)))
+
+ (should (equal
+ (string-search (make-string 2 130)
+ (concat "helló" (make-string 5 130 t) "bár"))
+ 5))
+ (should (equal
+ (string-search (make-string 2 127)
+ (concat "helló" (make-string 5 127 t) "bár"))
+ 5))
+
+ (should (equal (string-search "\377" "a\377ø") 1))
+ (should (equal (string-search "\377" "a\377a") 1))
+
+ (should (not (string-search (make-string 1 255) "a\377ø")))
+ (should (not (string-search (make-string 1 255) "a\377a")))
+
+ (should (equal (string-search "fóo" "zotfóo") 3))
+
+ (should (equal (string-search (string-to-multibyte "\377") "ab\377c") 2))
+ (should (equal (string-search "\303" "aøb") nil))
+ (should (equal (string-search "\270" "aøb") nil))
+ ;; This test currently fails, but it shouldn't!
+ ;;(should (equal (string-search "ø" "\303\270") nil))
+
+ (should-error (string-search "a" "abc" -1))
+ (should-error (string-search "a" "abc" 4))
+ (should-error (string-search "a" "abc" 100000000000))
+
+ (should (equal (string-search "a" "aaa" 3) nil))
+ (should (equal (string-search "\0" "") nil))
+
+ (should (equal (string-search "" "") 0))
+ (should-error (string-search "" "" 1))
+ (should (equal (string-search "" "abc") 0))
+ (should (equal (string-search "" "abc" 2) 2))
+ (should (equal (string-search "" "abc" 3) 3))
+ (should-error (string-search "" "abc" 4))
+ (should-error (string-search "" "abc" -1))
+ )
diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el
new file mode 100644
index 0000000..3d0d0f5
--- /dev/null
+++ b/test/src/xdisp-tests.el
@@ -0,0 +1,52 @@
+;;; xdisp-tests.el --- tests for xdisp.c functions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest xdisp-tests--minibuffer-resizing () ;; bug#43519
+ ;; FIXME: This test returns success when run in batch but
+ ;; it's only a lucky accident: it also returned success
+ ;; when bug#43519 was not fixed.
+ (should
+ (equal
+ t
+ (catch 'result
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (insert "hello")
+ (let ((ol (make-overlay (point) (point)))
+ (max-mini-window-height 1)
+ (text
"askdjfhaklsjdfhlkasjdfhklasdhflkasdhflkajsdhflkashdfkljahsdlfkjahsdlfkjhasldkfhalskdjfhalskdfhlaksdhfklasdhflkasdhflkasdhflkajsdhklajsdgh"))
+ ;; (save-excursion (insert text))
+ ;; (sit-for 2)
+ ;; (delete-region (point) (point-max))
+ (put-text-property 0 1 'cursor t text)
+ (overlay-put ol 'after-string text)
+ (redisplay 'force)
+ (throw 'result
+ ;; Make sure we do the see "hello" text.
+ (prog1 (equal (window-start) (point-min))
+ ;; (list (window-start) (window-end) (window-width))
+ (delete-overlay ol)))))
+ (let ((executing-kbd-macro t)) ;Force real minibuffer in `read-string'.
+ (read-string "toto: ")))))))
+
+;;; xdisp-tests.el ends here
diff --git a/test/src/xml-tests.el b/test/src/xml-tests.el
index d758c88..800f400 100644
--- a/test/src/xml-tests.el
+++ b/test/src/xml-tests.el
@@ -42,20 +42,6 @@
(comment nil "comment-b") (comment nil "comment-c"))))
"Alist of XML strings and their expected parse trees for preserved
comments.")
-(defvar libxml-tests--data-comments-discarded
- `(;; simple case
- ("<?xml version=\"1.0\"?><foo baz=\"true\">bar</foo>"
- . (foo ((baz . "true")) "bar"))
- ;; toplevel comments -- first document child must not get lost
- (,(concat "<?xml version=\"1.0\"?><foo>bar</foo><!--comment-1-->"
- "<!--comment-2-->")
- . (foo nil "bar"))
- (,(concat "<?xml version=\"1.0\"?><!--comment-a--><foo a=\"b\">"
- "<bar>blub</bar></foo><!--comment-b--><!--comment-c-->")
- . (foo ((a . "b")) (bar nil "blub"))))
- "Alist of XML strings and their expected parse trees for discarded
comments.")
-
-
(ert-deftest libxml-tests ()
"Test libxml."
(when (fboundp 'libxml-parse-xml-region)
@@ -64,11 +50,6 @@
(erase-buffer)
(insert (car test))
(should (equal (cdr test)
- (libxml-parse-xml-region (point-min) (point-max)))))
- (dolist (test libxml-tests--data-comments-discarded)
- (erase-buffer)
- (insert (car test))
- (should (equal (cdr test)
- (libxml-parse-xml-region (point-min) (point-max) nil
t)))))))
+ (libxml-parse-xml-region (point-min) (point-max))))))))
;;; libxml-tests.el ends here