procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk

Browse source
This commit is contained in:
Yuuki Harano 2021-12-06 00:37:01 +09:00
commit e5f74cecf1
64 changed files with 1227 additions and 566 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
ChangeLog.3
View file

@ -83,7 +83,7 @@
* lisp/progmodes/gdb-mi.el (gdb-frame-handler): Protect against
nil fullnames (bug#52196).
2021-11-30 YugaEgo <yet@ego.team> (tiny change)
2021-11-30 Yuga Ego <yet@ego.team> (tiny change)
Format and index concept 'predicate' in ELisp Intro
@ -8597,7 +8597,7 @@
* lisp/net/rcirc.el (reconnect): Kill previous process and start a new one
2021-09-07 A <rgm@gnu.org>
2021-09-07 Glenn Morris <rgm@gnu.org>
* test/lisp/vc/vc-tests.el (vc-test--version-diff): Git env tweak.
@ -11985,7 +11985,7 @@
Valid quoting in .desktop files
* etc/emacsclient.desktop, emacsclient-mail.desktop (Exec): Quote
* etc/emacsclient.desktop, etc/emacsclient-mail.desktop (Exec): Quote
according to the rules in the Freedesktop.org Desktop Entry
Specification.
@ -18217,7 +18217,7 @@
pulse-reset-face change -- reset back to the start face
(bug#48936).
2021-06-13 dick <dick.r.chiang@gmail.com>
2021-06-13 dickmao <dick.r.chiang@gmail.com>
Avoid an infinite loop in mml-expand-html-into-multipart-related
@ -58474,9 +58474,9 @@
Dictionary now uses button
* net/lisp/dictionary-link.el: Removed now obsolete file
* net/lisp/dictionary.el: Use insert-button and make-button
* net/lisp/dictionary.el (dictionary-mode-map): Now defined using defvar
* lisp/net/dictionary-link.el: Removed now obsolete file
* lisp/net/dictionary.el: Use insert-button and make-button
* lisp/net/dictionary.el (dictionary-mode-map): Now defined using defvar
I had to add a conversion function as parameter for the button 'action
as I need to be able to pass nil data to my function. This is not
@ -69091,7 +69091,7 @@
(macfont_glyph_extents): Fix monospace glyph computation.
(macfont_shape): Ditto.
2020-08-12 Mingde (Matthew) Zeng <matthewzmd@gmail.com>
2020-08-12 Mingde Matthew Zeng <matthewzmd@gmail.com>
Fix erc-reuse-buffers behavior

4
Makefile.in
View file

@ -434,6 +434,10 @@ epaths-force-ns-self-contained: epaths-force
-e 's;${ns_appdir}/;;') && \
${srcdir}/build-aux/move-if-change epaths.h.$$$$ src/epaths.h
ifneq ($(NTDIR),)
$(NTDIR): lib
endif
lib-src src: $(NTDIR) lib
src: lib-src

21
admin/authors.el
View file

@ -398,8 +398,12 @@ Changes to files matching one of the regexps in this list are not listed.")
"images/icons/allout-widgets-light-bg"
"lisp/shorthand.el"
"test/lisp/shorthand-tests.el"
"lisp/shorthands.el"
"test/src/comp-test-funcs.el"
"lisp/net/link.el"
"lisp/net/connection.el"
"lisp/net/dictionary-link.el"
"test/src/comp-test-funcs-dyn.el"
;; Never had any meaningful changes logged, now deleted:
"lib/stdarg.in.h" "lib/stdbool.in.h"
"unidata/bidimirror.awk" "unidata/biditype.awk"
@ -537,6 +541,8 @@ Changes to files matching one of the regexps in this list are not listed.")
"lisp/org/ob-abc.el"
"lisp/org/ob-ebnf.el"
"lisp/org/ob-J.el"
;; Removed -- for now.
"test/src/doc-tests.el"
)
"List of files and directories to ignore.
Changes to files in this list are not listed.")
@ -999,6 +1005,7 @@ in the repository.")
("DIFF" . "OTHER.EMACSES")
("CCADIFF" . "OTHER.EMACSES")
("GOSDIFF" . "OTHER.EMACSES")
("emacs.appdata.xml" . "emacs.metainfo.xml")
;; Nextstep
("nextstep/Cocoa/Emacs.base/Contents/Info.plist" . "nextstep/templates/Info.plist.in")
;; Moved from lisp/tpu-doc.el to etc/tpu-edt.doc in Emacs 19.29.
@ -1053,6 +1060,12 @@ in the repository.")
("lisp/gnus/messcompat.el" . "messcompat.el")
("html2text.el" . "html2text.el")
("lisp/net/html2text.el" . "html2text.el")
;; Obsolete in 28.1.
("inversion.el" . "inversion.el")
("test/lisp/cedet/inversion-tests.el" . "inversion-tests.el")
("test/lisp/mail/rfc2368-tests.el" . "rfc2368-tests.el")
;; This file was briefly obsolete:
("lisp/obsolete/erc-compat.el" . "erc-compat.el")
;; From lisp to etc/forms.
("forms-d2.el" . "forms-d2.el")
("forms-pass.el" . "forms-pass.el")
@ -1195,8 +1208,12 @@ in the repository.")
("lisp/gnus/nnir.el" . "nnir.el")
("src/regex.c" . "emacs-regex.c")
("src/regex.h" . "emacs-regex.h")
("erc-compat.el" . "erc-compat.el")
("semantic-utest-fmt.el" . "format-tests.el")
("test/manual/rmailmm.el" . "rmailmm-tests.el")
("test/lisp/cedet/semantic-utest-fmt.el" . "format-tests.el")
("test/lisp/emacs-lisp/tabulated-list-test.el" . "tabulated-list-tests.el")
("test/lisp/url/url-handlers-test.el" . "url-handlers-tests.el")
("test/src/dired-tests.el" . "dired-tests.el")
(".dir-locals.el" . ".dir-locals.el")
)
"Alist of files which have been renamed during their lifetime.
Elements are (OLDNAME . NEWNAME).")

9
doc/lispref/frames.texi
View file

@ -167,11 +167,10 @@ argument, the frame just created.
@end defvar
Note that any functions added to these hooks by your initial file are
usually not run for the initial frame, since Emacs reads the initial
file only after creating that frame. However, if the initial frame is
specified to use a separate minibuffer frame (@pxref{Minibuffers and
Frames}), the functions will be run for both, the minibuffer-less and
the minibuffer frame.
usually not run for the initial frame. However, if the initial frame
is specified to use a separate minibuffer frame (@pxref{Minibuffers
and Frames}), the functions will be run for both, the minibuffer-less
and the minibuffer frame.
@defvar frame-inherited-parameters
This variable specifies the list of frame parameters that a newly

3
doc/lispref/os.texi
View file

@ -1724,7 +1724,8 @@ This function parses the time-string @var{string} and returns the
corresponding Lisp timestamp. The argument @var{string} should represent
a date-time, and should be in one of the forms recognized by
@code{parse-time-string} (see below). This function assumes Universal
Time if @var{string} lacks explicit time zone information.
Time if @var{string} lacks explicit time zone information,
and assumes earliest values if @var{string} lacks month, day, or time.
The operating system limits the range of time and zone values.
@end defun

51
doc/misc/efaq.texi
View file

@ -934,7 +934,7 @@ file (@kbd{C-h n}) for the full list of changes in Emacs 28.
@item
Emacs now optionally supports native compilation of Lisp files. This
can improves performance significantly in some cases. To enable this,
configure Emacs with the '--with-native-compilation' option.
configure Emacs with the @option{--with-native-compilation} option.
@item
The new NonGNU ELPA archive is enabled by default alongside GNU ELPA.
@ -944,6 +944,13 @@ by the @code{list-packages} command.
@item
The Cairo graphics library is now used by default if present.
@item
On GNU/Linux, Emacs now supports loading Secure Computing filters. To
use this feature, invoke Emacs with the @option{--seccomp=@var{file}}
command-line switch, where @var{file} names a binary file that defines
the filtering. See the manual page of the @code{seccomp} system call
for more details.
@item
The new themes @samp{modus-vivendi} and @samp{modus-operandi} have
been added. They are designed to conform with the highest standard
@ -957,10 +964,50 @@ sequences by default, provided that a suitable font is available.
New system for displaying documentation for groups of functions
(@kbd{M-x shortdoc-display-group RET}).
@item
Emacs can now support 24-bit color text-mode terminals even if their
terminfo database doesn't state this support in a standard way. Set
the @env{COLORTERM} environment variable to the value @samp{truecolor}
to activate this.
@item
The @code{strike-through} face attribute is now supported on capable
text-mode terminals.
@item
@code{xterm-mouse-mode} supports TTY menus.
@item
A new minor mode @code{context-menu-mode} causes @code{mouse-3}
(a.k.a.@: ``right-clicks'') of the mouse to pop up context-dependent
menus.
@item
Prefix commands to control the display of the results of the next
command. @kbd{C-x 4 4 @var{command}} displays the result of
@var{command} in a new window. @kbd{C-x 5 5 @var{command}} displays
the results of @var{command} in a new frame.
@item
Emacs now supports ``transient'' input methods. A transient input
method is enabled for inserting a single character, and is then
automatically disabled. Select a transient input method with @kbd{C-u
C-x \}; enable it (for inserting a single character) with @kbd{C-x \}.
New input methods @code{compose} (based on X Window System Multi_key
sequences) and @code{iso-transl} are especially convenient with this
feature, when you need to insert a single special character.
@item
@kbd{M-y}, when invoked after a command that is not a yank command,
allows selection of one of the previous kills.
@item
New minor mode @code{repeat-mode} allows to repeat commands with fewer
keystrokes.
@item
Among the many internal changes in this release, we would like to
highlight that all files in the tree now use @code{lexical-binding}.
@end itemize

3
doc/misc/eieio.texi
View file

@ -703,8 +703,7 @@ This function retrieves the value of @var{slot} from @var{object}.
It can also be used on objects defined by @code{cl-defstruct}.
This is a generalized variable that can be used with @code{setf} to
modify the value stored in @var{slot}, tho not for objects defined by
@code{cl-defstruct}.
modify the value stored in @var{slot}.
@xref{Generalized Variables,,,elisp,GNU Emacs Lisp Reference Manual}.
@end defun

28
doc/misc/erc.texi
View file

@ -87,6 +87,28 @@ Advanced Usage
@node Introduction
@chapter Introduction
IRC is short for Internet Relay Chat. When using IRC, you can
communicate with other users on the same IRC network. There are
several of these networks available---if you search for ``IRC
networks'' in your favorite search engine, you are likely to find
up-to-date lists of IRC networks catering to various interests and
topics.
In order to use IRC, you need an IRC client such as ERC. Using the
client, you connect to an IRC server. Once you've done that, you will
have access to all available channels on that server's network. A
channel is basically a chat room, and what you type in a channel will
be shown to all other users in that channel, and you can be in several
channels at the same time---most clients will show each channel in its
own window. IRC channel names always begin with a @samp{#} character.
For example, the Emacs channel on Libera.Chat is @samp{#emacs}, and
the ERC channel is @samp{#erc}. Do not confuse them with the hashtags
used on many social media platforms.
It is also possible to send private messages to other IRC
users on the same network, regardless of whether or not they are in
the same channel as you.
ERC is a powerful, modular, and extensible IRC client for Emacs.
It is distributed with Emacs since version 22.1.
@ -114,7 +136,11 @@ It comes with the following capabilities enabled by default.
@cindex settings
The command @kbd{M-x erc} will start ERC and prompt for the server to
connect to.
connect to. If you're unsure of which server or network to connect
to, we suggest you start with ``irc.libera.chat''. There you will
find the @samp{#emacs} channels where you can chat with other Emacs
and users, and if you're having trouble with ERC, you can join the
@samp{#erc} channel and ask for help there.
If you want to place ERC settings in their own file, you can place them
in @file{~/.emacs.d/.ercrc.el}, creating it if necessary.

356
doc/misc/eshell.texi
View file

@ -271,8 +271,30 @@ Some of the built-in commands have different behavior from their
external counterparts, and some have no external counterpart. Most of
these will print a usage message when given the @code{--help} option.
In some cases, a built-in command's behavior can be configured via
user settings, some of which are mentioned below. For example,
certain commands have two user settings to allow them to overwrite
files without warning and to ensure that they always prompt before
overwriting files. If both settings are non-@code{nil}, the commands
always prompt. If both settings are @code{nil} (the default), the
commands signal an error.
Several commands observe the value of
@code{eshell-default-target-is-dot}. If non-@code{nil}, then the
default target for the commands @command{cp}, @command{mv}, and
@command{ln} is the current directory.
A few commands are wrappers for more niche Emacs features, and can be
loaded as part of the eshell-xtra module. @xref{Extension modules}.
@table @code
@item .
@cmindex .
Source an Eshell file in the current environment. This is not to be
confused with the command @command{source}, which sources a file in a
subshell environment.
@item addpath
@cmindex addpath
Adds a given path or set of paths to the PATH environment variable, or,
@ -282,26 +304,137 @@ with no arguments, prints the current paths in this variable.
@cmindex alias
Define an alias (@pxref{Aliases}). This adds it to the aliases file.
@item basename
@cmindex basename
Return a file name without its directory.
@item cat
@cmindex cat
Concatenate file contents into standard output. If in a pipeline, or
if the file is not a regular file, directory, or symlink, then this
command reverts to the system's definition of @command{cat}.
@item cd
@cmindex cd
This command changes the current working directory. Usually, it is
invoked as @kbd{cd @var{dir}} where @file{@var{dir}} is the new
working directory. But @command{cd} knows about a few special
arguments:
@itemize @minus{}
@item
When it receives no argument at all, it changes to the home directory.
@item
Giving the command @kbd{cd -} changes back to the previous working
directory (this is the same as @kbd{cd $-}).
@item
The command @kbd{cd =} shows the directory stack. Each line is
numbered.
@item
With @kbd{cd =foo}, Eshell searches the directory stack for a directory
matching the regular expression @samp{foo}, and changes to that
directory.
@item
With @kbd{cd -42}, you can access the directory stack slots by number.
@item
If @code{eshell-cd-shows-directory} is non-@code{nil}, @command{cd}
will report the directory it changes to. If
@code{eshell-list-files-after-cd} is non-@code{nil}, then @command{ls}
is called with any remaining arguments after changing directories.
@end itemize
@item clear
@cmindex clear
Scrolls the contents of the eshell window out of sight, leaving a blank window.
If provided with an optional non-nil argument, the scrollback contents are
cleared instead.
Scrolls the contents of the Eshell window out of sight, leaving a
blank window. If provided with an optional non-@code{nil} argument,
the scrollback contents are cleared instead.
@item clear-scrollback
@cmindex clear-scrollback
Clear the scrollback contents of the Eshell window. Unlike the
command @command{clear}, this command deletes content in the Eshell
buffer.
@item cp
@cmindex cp
Copy a file to a new location or copy multiple files to the same
directory.
If @code{eshell-cp-overwrite-files} is non-@code{nil}, then
@command{cp} will overwrite files without warning. If
@code{eshell-cp-interactive-query} is non-@code{nil}, then
@command{cp} will ask before overwriting anything.
@item date
@cmindex date
Similar to, but slightly different from, the GNU Coreutils
Print the current local time as a human-readable string. This command
is similar to, but slightly different from, the GNU Coreutils
@command{date} command.
@item define
@cmindex define
Define a varalias.
Define a variable alias.
@xref{Variable Aliases, , , elisp, The Emacs Lisp Reference Manual}.
@item diff
@cmindex diff
Use Emacs's internal @code{diff} (not to be confused with
@code{ediff}). @xref{Comparing Files, , , emacs, The GNU Emacs Manual}.
Compare files using Emacs's internal @code{diff} (not to be confused
with @code{ediff}). @xref{Comparing Files, , , emacs, The GNU Emacs
Manual}.
If @code{eshell-plain-diff-behavior} is non-@code{nil}, then this
command does not use Emacs's internal @code{diff}. This is the same
as using @samp{alias diff '*diff $*'}.
@item dirname
@cmindex dirname
Return the directory component of a file name.
@item dirs
@cmindex dirs
Prints the directory stack. Directories can be added or removed from
the stack using the commands @command{pushd} and @command{popd},
respectively.
@item du
@cmindex du
Summarize disk usage for each file.
@item echo
@cmindex echo
Echoes its input. If @code{eshell-plain-echo-behavior} is
non-@code{nil}, @command{echo} will try to behave more like a plain
shell's @command{echo}.
@item env
@cmindex env
Prints the current environment variables. Unlike in Bash, this
command does not yet support running commands with a modified
environment.
@item exit
@cmindex exit
Exit Eshell and save the history. By default, this command kills the
Eshell buffer, but if @code{eshell-kill-on-exit} is @code{nil}, then
the buffer is merely buried instead.
@item export
@cmindex export
Set environment variables using input like Bash's @command{export}, as
in @samp{export @var{var1}=@var{val1} @var{var2}=@var{val2} @dots{}}.
@item expr
@cmindex expr
An implementation of @command{expr} using the Calc package.
@xref{Top,,, calc, The GNU Emacs Calculator}.
This command can be loaded as part of the eshell-xtra module, which is
disabled by default.
@item grep
@cmindex grep
@ -313,13 +446,36 @@ Use Emacs's internal @code{diff} (not to be confused with
@cmindex fgrep
@itemx glimpse
@cmindex glimpse
The @command{grep} commands are compatible with GNU @command{grep}, but
use Emacs's internal @code{grep} instead.
The @command{grep} commands are compatible with GNU @command{grep},
but use Emacs's internal @code{grep} instead.
@xref{Grep Searching, , , emacs, The GNU Emacs Manual}.
If @code{eshell-plain-grep-behavior} is non-@code{nil}, then these
commands do not use Emacs's internal @code{grep}. This is the same as
using @samp{alias grep '*grep $*'}, though this setting applies to all
of the built-in commands for which you would need to create a separate
alias.
@item history
@cmindex history
Prints Eshell's input history. With a numeric argument @var{N}, this
command prints the @var{N} most recent items in the history.
@item info
@cmindex info
Same as the external @command{info} command, but uses Emacs's internal
Info reader.
Browse the available Info documentation. This command is the same as
the external @command{info} command, but uses Emacs's internal Info
reader.
@xref{Misc Help, , , emacs, The GNU Emacs Manual}.
@item intersection
@cmindex intersection
A wrapper around the function @code{cl-intersection} (@pxref{Lists as
Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command
can be used for comparing lists of strings.
This command can be loaded as part of the eshell-xtra module, which is
disabled by default.
@item jobs
@cmindex jobs
@ -337,46 +493,152 @@ Eshell version of @code{list}. Allows you to create a list using Eshell
syntax, rather than Elisp syntax. For example, @samp{listify foo bar}
and @code{("foo" "bar")} both evaluate to @code{("foo" "bar")}.
@item ln
@cmindex ln
Create links to files.
If @code{eshell-ln-overwrite-files} is non-@code{nil}, @command{ln}
will overwrite files without warning. If
@code{eshell-ln-interactive-query} is non-@code{nil}, then
@command{ln} will ask before overwriting files.
@item locate
@cmindex locate
Alias to Emacs's @code{locate} function, which simply runs the external
@command{locate} command and parses the results.
@xref{Dired and Find, , , emacs, The GNU Emacs Manual}.
If @code{eshell-plain-locate-behavior} is non-@code{nil}, then Emacs's
internal @code{locate} is not used. This is the same as using
@samp{alias locate '*locate $*'}.
@item ls
@cmindex ls
Lists the contents of directories.
If @code{eshell-ls-use-colors} is non-@code{nil}, the contents of a
directory is color-coded according to file type and status. These
colors and the regexps used to identify their corresponding files can
be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls @key{RET}}}.
The user option @code{eshell-ls-date-format} determines how the date
is displayed when using the @option{-l} option. The date is produced
using the function @code{format-time-string} (@pxref{Time Parsing,,,
elisp, GNU Emacs Lisp Reference Manual}).
The user option @code{eshell-ls-initial-args} contains a list of
arguments to include with any call to @command{ls}. For example, you
can include the option @option{-h} to always use a more human-readable
format.
The user option @code{eshell-ls-default-blocksize} determines the
default blocksize used when displaying file sizes with the option
@option{-s}.
@item make
@cmindex make
Run @command{make} through @code{compile} when run asynchronously
(e.g., @samp{make &}). @xref{Compilation, , , emacs, The GNU Emacs
Manual}. Otherwise call the external @command{make} command.
@item man
@cmindex man
Display Man pages using the Emacs @code{man} command.
@xref{Man Page, , , emacs, The GNU Emacs Manual}.
@item mismatch
@cmindex mismatch
A wrapper around the function @code{cl-mismatch} (@pxref{Searching
Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can
be used for comparing lists of strings.
This command can be loaded as part of the eshell-xtra module, which is
disabled by default.
@item mkdir
@cmindex mkdir
Make new directories.
@item mv
@cmindex mv
Move or rename files.
If @code{eshell-mv-overwrite-files} is non-@code{nil}, @command{mv}
will overwrite files without warning. If
@code{eshell-mv-interactive-query} is non-@code{nil}, @command{mv}
will prompt before overwriting anything.
@item occur
@cmindex occur
Alias to Emacs's @code{occur}.
@xref{Other Repeating Search, , , emacs, The GNU Emacs Manual}.
@item popd
@cmindex popd
Pop a directory from the directory stack and switch to a another place
in the stack.
@item printnl
@cmindex printnl
Print the arguments separated by newlines.
@item cd
@cmindex cd
This command changes the current working directory. Usually, it is
invoked as @samp{cd foo} where @file{foo} is the new working directory.
But @command{cd} knows about a few special arguments:
@item pushd
@cmindex pushd
Push the current directory onto the directory stack, then change to
another directory.
When it receives no argument at all, it changes to the home directory.
If @code{eshell-pushd-dunique} is non-@code{nil}, then only unique
directories will be added to the stack. If
@code{eshell-pushd-dextract} is non-@code{nil}, then @samp{pushd
+@var{n}} will pop the @var{n}th directory to the top of the stack.
Giving the command @samp{cd -} changes back to the previous working
directory (this is the same as @samp{cd $-}).
@item pwd
@cmindex pwd
Prints the current working directory.
The command @samp{cd =} shows the directory stack. Each line is
numbered.
@item rm
@cmindex rm
Removes files, buffers, processes, or Emacs Lisp symbols, depending on
the argument.
With @samp{cd =foo}, Eshell searches the directory stack for a directory
matching the regular expression @samp{foo} and changes to that
directory.
If @code{eshell-rm-interactive-query} is non-@code{nil}, @command{rm}
will prompt before removing anything. If
@code{eshell-rm-removes-directories} is non-@code{nil}, then
@command{rm} can also remove directories. Otherwise, @command{rmdir}
is required.
With @samp{cd -42}, you can access the directory stack by number.
@item rmdir
@cmindex rmdir
Removes directories if they are empty.
@item set-difference
@cmindex set-difference
A wrapper around the function @code{cl-set-difference} (@pxref{Lists as
Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command
can be used for comparing lists of strings.
This command can be loaded as part of the eshell-xtra module, which is
disabled by default.
@item set-exclusive-or
@cmindex set-exclusive-or
A wrapper around the function @code{cl-set-exclusive-or} (@pxref{Lists
as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be
used for comparing lists of strings.
This command can be loaded as part of the eshell-xtra module, which is
disabled by default.
@item setq
@cmindex setq
Set variable values, using the function @code{setq} like a command.
@xref{Setting variables,,, elisp, GNU Emacs Lisp Reference Manual}.
@item source
@cmindex source
Source an Eshell file in a subshell environment. This is not to be
confused with the command @command{.}, which sources a file in the
current environment.
@item su
@cmindex su
@ -386,6 +648,50 @@ Uses TRAMP's @command{su} or @command{sudo} method @pxref{Inline methods, , , tr
to run a command via @command{su} or @command{sudo}. These commands
are in the eshell-tramp module, which is disabled by default.
@item substitute
@cmindex substitute
A wrapper around the function @code{cl-substitute} (@pxref{Sequence
Functions,,, cl, GNU Emacs Common Lisp Emulation}). This command can
be used for comparing lists of strings.
This command can be loaded as part of the eshell-xtra module, which is
disabled by default.
@item time
@cmindex time
Show the time elapsed during a command's execution.
@item umask
@cmindex umask
Set or view the default file permissions for newly created files and
directories.
@item union
@cmindex union
A wrapper around the function @code{cl-union} (@pxref{Lists as Sets,,,
cl, GNU Emacs Common Lisp Emulation}). This command can be used for
comparing lists of strings.
This command can be loaded as part of the eshell-xtra module, which is
disabled by default.
@item unset
@cmindex unset
Unset an environment variable.
@item wait
@cmindex wait
Wait until a process has successfully completed.
@item which
@cmindex which
Identify a command and its location.
@item whoami
@cmindex whoami
Print the current user. This Eshell version of @command{whoami}
supports Tramp.
@end table
@subsection Built-in variables

4
doc/misc/org.org
View file

@ -15571,7 +15571,7 @@ for usage and configuration details.
:DESCRIPTION: Fine-tuning the export output.
:END:
*** Hooks
*** Export hooks
:PROPERTIES:
:UNNUMBERED: notoc
:END:
@ -18203,7 +18203,7 @@ expanded anyway.
#+kindex: C-c C-v f
Choose a file to tangle. Bound to {{{kbd(C-c C-v f)}}}.
*** Hooks
*** Tangle hooks
:PROPERTIES:
:UNNUMBERED: notoc
:END:

9
doc/misc/tramp.texi
View file

@ -3389,8 +3389,8 @@ indication that the process has been interrupted, and returns a
corresponding string.
This remote process handling does not apply to @acronym{GVFS}
(@pxref{GVFS-based methods}) because the remote file system is mounted on
the local host and @value{tramp} accesses it by changing the
(@pxref{GVFS-based methods}) because the remote file system is mounted
on the local host and @value{tramp} accesses it by changing the
@code{default-directory}.
@value{tramp} starts a remote process when a command is executed in a
@ -4059,6 +4059,11 @@ CPIO archives
@cindex @file{cpio} file archive suffix
@cindex file archive suffix @file{cpio}
@item @samp{.crate} ---
Cargo (Rust) packages
@cindex @file{crate} file archive suffix
@cindex file archive suffix @file{crate}
@item @samp{.deb} ---
Debian packages
@cindex @file{deb} file archive suffix

34
etc/AUTHORS
View file

@ -257,8 +257,8 @@ Alyssa Ross: changed progmodes/compile.el simple.el
Ami Fischman: changed bindings.el calendar.el diary-lib.el print.c
savehist.el vc-git.el
Amin Bandali: changed erc.el erc-backend.el erc-button.el erc-track.el
erc-compat.el erc-dcc.el erc-desktop-notifications.el erc-match.el
Amin Bandali: changed erc.el erc-backend.el erc-button.el erc-compat.el
erc-track.el erc-dcc.el erc-desktop-notifications.el erc-match.el
erc-services.el erc-speedbar.el erc-status-sidebar.el erc.texi
erc-autoaway.el erc-fill.el erc-goodies.el erc-ibuffer.el erc-imenu.el
erc-join.el erc-lang.el erc-list.el erc-log.el and 11 other files
@ -473,8 +473,8 @@ Artem Chuprina: changed message.el
Artem Loenko: changed src/Makefile.in
Arthur Miller: changed help-fns.el ange-ftp.el bytecomp.el comp.c comp.el
dired.c dired.el files.texi help.texi lisp.h ls-lisp.el sysdep.c
tramp-adb.el tramp-rclone.el tramp-sh.el tramp-smb.el tramp.el
dired-tests.el dired.c dired.el files.texi help.texi lisp.h ls-lisp.el
sysdep.c tramp-adb.el tramp-rclone.el tramp-sh.el tramp-smb.el tramp.el
wdired.el
Artur Malabarba: wrote char-fold-tests.el faces-tests.el isearch-tests.el
@ -1422,8 +1422,8 @@ Diane Murray: changed erc.el erc-backend.el erc-menu.el erc-button.el
Dick R. Chiang: changed ffap-tests.el ffap.el gnus-group.el gnus.texi
message.el bindings.el buffer-tests.el buffer.c checkdoc.el
cl-macs-tests.el cl-macs.el comint-tests.el gnus-srvr.el gnus-sum.el
gnus-topic.el gnutls.c key.pub key.sec minibuffer.el misc.texi
package.el and 6 other files
gnus-topic.el gnutls.c key.pub key.sec minibuffer.el misc.texi mml.el
and 7 other files
Didier Verna: wrote gnus-diary.el nndiary.el
and co-wrote nnml.el
@ -2004,7 +2004,7 @@ and changed configure.ac Makefile.in src/Makefile.in calendar.el
lisp/Makefile.in diary-lib.el files.el make-dist rmail.el
progmodes/f90.el bytecomp.el admin.el misc/Makefile.in simple.el
authors.el startup.el emacs.texi lib-src/Makefile.in display.texi
ack.texi subr.el and 1789 other files
ack.texi subr.el and 1790 other files
Glynn Clements: wrote gamegrid.el snake.el tetris.el
@ -2899,7 +2899,7 @@ and co-wrote help-tests.el keymap-tests.el
and changed subr.el desktop.el w32fns.c faces.el simple.el emacsclient.c
files.el server.el bs.el help-fns.el xdisp.c org.el w32term.c w32.c
buffer.c keyboard.c ido.el image.c window.c eval.c allout.el
and 1224 other files
and 1226 other files
Juan Pechiar: changed ob-octave.el
@ -3303,7 +3303,7 @@ and co-wrote gnus-kill.el gnus-mh.el gnus-msg.el gnus-score.el
and changed gnus.texi simple.el subr.el files.el process.c text.texi
display.texi dired.el gnutls.c gnus-ems.el smtpmail.el help-fns.el
auth-source.el url-http.el edebug.el gnus-cite.el image.el pop3.el
dired-aux.el fns.c image.c and 859 other files
dired-aux.el fns.c image.c and 860 other files
Lars Rasmusson: changed ebrowse.c
@ -3977,6 +3977,8 @@ and changed comint.el faces.el simple.el editfns.c xfaces.c xdisp.c
Milton Wulei: changed gdb-ui.el
Mingde Matthew Zeng: changed erc-join.el erc.el
Mirek Kaim: changed configure.ac
Mirko Vukovic: changed emacs.texi maintaining.texi
@ -4130,7 +4132,7 @@ and changed README authors.el configure.ac sed2v2.inp sequences.texi
README.W32 emacs.png HISTORY emacs23.png arc-mode.el cl-extra.el
emacs.svg manoj-dark-theme.el Emacs.icns Makefile.in auth-source.el
emacs.ico fns.c make-tarball.txt obarray-tests.el obarray.el
and 36 other files
and 37 other files
Nicolas Richard: wrote cl-seq-tests.el cmds-tests.el replace-tests.el
and changed ffap.el package.el byte-run.el help.el keyboard.c landmark.el
@ -4422,8 +4424,8 @@ Peter Münster: changed image-dired.el gnus-delay.el gnus-demon.el
Peter O'Gorman: changed configure.ac frame.h hpux10-20.h termhooks.h
Peter Oliver: changed emacsclient.desktop Makefile.in emacs-mail.desktop
emacsclient-mail.desktop server.el configure.ac emacs.desktop
Peter Oliver: changed emacsclient.desktop emacsclient-mail.desktop
Makefile.in emacs-mail.desktop server.el configure.ac emacs.desktop
emacs.metainfo.xml misc.texi perl-mode.el ruby-mode-tests.el vc-sccs.el
Peter Povinec: changed term.el
@ -4746,7 +4748,7 @@ Robert Cochran: changed tab-bar.el bytecomp.el checkdoc.el data.c
Robert Fenk: changed desktop.el
Robert Jarzmik: changed ede/linux.el
Robert Jarzmik: changed ede/linux.el inversion.el
Robert J. Chassell: wrote makeinfo.el page-ext.el texinfo.el
texnfo-upd.el
@ -5162,7 +5164,7 @@ and changed efaq.texi checkdoc.el package.el cperl-mode.el bookmark.el
help.el keymap.c subr.el simple.el erc.el ediff-util.el idlwave.el
time.el bytecomp-tests.el comp.el speedbar.el bytecomp.el
emacs-lisp-intro.texi flyspell.el ibuffer.el package-tests.el
and 1333 other files
and 1337 other files
Stefan Merten: co-wrote rst.el
@ -5179,7 +5181,7 @@ and co-wrote font-lock.el gitmerge.el pcvs.el
and changed subr.el simple.el keyboard.c bytecomp.el cl-macs.el files.el
lisp.h vc.el xdisp.c alloc.c eval.c sh-script.el progmodes/compile.el
keymap.c buffer.c window.c tex-mode.el lisp-mode.el newcomment.el
help-fns.el lread.c and 1615 other files
help-fns.el lread.c and 1616 other files
Stefano Facchini: changed gtkutil.c
@ -5984,6 +5986,8 @@ Yuchen Pei: changed calendar.texi diary-lib.el icalendar-tests.el
Yue Daian: wrote cl-font-lock.el
Yuga Ego: changed emacs-lisp-intro.texi
Yu-ji Hosokawa: changed README.W32
Yukihiro Matsumoto: co-wrote ruby-mode.el

13
etc/NEWS
View file

@ -423,7 +423,7 @@ representation as emojis.
** EIEIO
+++
*** 'slot-value' can now be used to read slots of 'cl-defstruct' objects.
*** 'slot-value' can now be used to access slots of 'cl-defstruct' objects.
** align
@ -771,10 +771,9 @@ Use 'exif-parse-file' and 'exif-field' instead.
This change is now applied in 'dired-insert-directory'.
** Some functions and variables obsolete since Emacs 23 have been removed:
'find-emacs-lisp-shadows', 'newsticker--cache-read-version1',
'newsticker--cache-save-version1', 'newsticker--cache-update',
'newsticker-cache-filename', 'unify-8859-on-decoding-mode',
'unify-8859-on-encoding-mode', 'vc-arch-command'.
'find-emacs-lisp-shadows', 'newsticker-cache-filename',
'unify-8859-on-decoding-mode', 'unify-8859-on-encoding-mode',
'vc-arch-command'.
* Lisp Changes in Emacs 29.1
@ -1085,6 +1084,10 @@ cookies set by web pages on disk.
** New variable 'help-buffer-under-preparation'.
This variable is bound to t during the preparation of a "*Help*" buffer.
+++
** 'date-to-time' now assumes earliest values if its argument lacks
month, day, or time. For example, (date-to-time "2021-12-04") now
assumes a time of 00:00 instead of signaling an error.
* Changes in Emacs 29.1 on Non-Free Operating Systems

5
lisp/bookmark.el
View file

@ -510,8 +510,9 @@ If DEFAULT is nil then return empty string for empty input."
(defmacro bookmark-maybe-historicize-string (string)
"Put STRING into the bookmark prompt history, if caller non-interactive.
We need this because sometimes bookmark functions are invoked from
menus, so `completing-read' never gets a chance to set `bookmark-history'."
We need this because sometimes bookmark functions are invoked
from other commands that pass in the bookmark name, so
`completing-read' never gets a chance to set `bookmark-history'."
`(or
(called-interactively-p 'interactive)
(setq bookmark-history (cons ,string bookmark-history))))

38
lisp/calendar/time-date.el
View file

@ -153,28 +153,22 @@ it is assumed that PICO was omitted and should be treated as zero."
"Parse a string DATE that represents a date-time and return a time value.
DATE should be in one of the forms recognized by `parse-time-string'.
If DATE lacks timezone information, GMT is assumed."
;; Pass the result of parsing through decoded-time-set-defaults
;; because encode-time signals if HH:MM:SS are not filled in.
(encode-time
(decoded-time-set-defaults
(condition-case err
(let ((time (parse-time-string date)))
(prog1 time
;; Cause an error if data `parse-time-string' returns is invalid.
(setq time (encode-time time))))
(error
(let ((overflow-error '(error "Specified time is not representable")))
(if (or (equal err overflow-error)
;; timezone-make-date-arpa-standard misbehaves if
;; not given at least HH:MM as part of the date.
(not (string-match ":" date)))
(signal (car err) (cdr err))
(condition-case err
(parse-time-string (timezone-make-date-arpa-standard date))
(error
(if (equal err overflow-error)
(signal (car err) (cdr err))
(error "Invalid date: %s" date)))))))))))
(condition-case err
(let ((parsed (parse-time-string date)))
(when (decoded-time-year parsed)
(decoded-time-set-defaults parsed))
(encode-time parsed))
(error
(let ((overflow-error '(error "Specified time is not representable")))
(if (equal err overflow-error)
(signal (car err) (cdr err))
(condition-case err
(encode-time (parse-time-string
(timezone-make-date-arpa-standard date)))
(error
(if (equal err overflow-error)
(signal (car err) (cdr err))
(error "Invalid date: %s" date)))))))))
;;;###autoload
(defalias 'time-to-seconds 'float-time)

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

@ -469,7 +469,7 @@ just FUNCTION is printed."
(funcall orig-fun nil)))
(defun edebug-eval-defun (edebug-it)
(declare (obsolete "use eval-defun or edebug--eval-defun instead" "28.1"))
(declare (obsolete "use `eval-defun' or `edebug--eval-defun' instead" "28.1"))
(interactive "P")
(if (advice-member-p #'edebug--eval-defun 'eval-defun)
(eval-defun edebug-it)

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

@ -450,7 +450,7 @@ See `defclass' for more information."
))
;; Now that everything has been loaded up, all our lists are backwards!
;; Fix that up now and then them into vectors.
;; Fix that up now and turn them into vectors.
(cl-callf (lambda (slots) (apply #'vector (nreverse slots)))
(eieio--class-slots newc))
(cl-callf nreverse (eieio--class-initarg-tuples newc))
@ -704,11 +704,15 @@ an error."
nil
;; Trim off object IDX junk added in for the object index.
(setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots)))
(let ((st (cl--slot-descriptor-type (aref (eieio--class-slots class)
slot-idx))))
(if (not (eieio--perform-slot-validation st value))
(signal 'invalid-slot-type
(list (eieio--class-name class) slot st value))))))
(let* ((sd (aref (eieio--class-slots class)
slot-idx))
(st (cl--slot-descriptor-type sd)))
(cond
((not (eieio--perform-slot-validation st value))
(signal 'invalid-slot-type
(list (eieio--class-name class) slot st value)))
((alist-get :read-only (cl--slot-descriptor-props sd))
(signal 'eieio-read-only (list (eieio--class-name class) slot)))))))
(defun eieio--validate-class-slot-value (class slot-idx value slot)
"Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
@ -813,7 +817,7 @@ Fills in CLASS's SLOT with its default value."
(defun eieio-oset (obj slot value)
"Do the work for the macro `oset'.
Fills in OBJ's SLOT with VALUE."
(cl-check-type obj eieio-object)
(cl-check-type obj (or eieio-object cl-structure-object))
(cl-check-type slot symbol)
(let* ((class (eieio--object-class obj))
(c (eieio--slot-name-index class slot)))
@ -1063,6 +1067,7 @@ method invocation orders of the involved classes."
;;
(define-error 'invalid-slot-name "Invalid slot name")
(define-error 'invalid-slot-type "Invalid slot type")
(define-error 'eieio-read-only "Read-only slot")
(define-error 'unbound-slot "Unbound slot")
(define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy")

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

@ -1181,13 +1181,17 @@ The return result is a `package-desc'."
info)
(while files
(with-temp-buffer
(insert-file-contents (pop files))
;; When we find the file with the data,
(when (setq info (ignore-errors (package-buffer-info)))
;; stop looping,
(setq files nil)
;; set the 'dir kind,
(setf (package-desc-kind info) 'dir))))
(let ((file (pop files)))
;; The file may be a link to a nonexistent file; e.g., a
;; lock file.
(when (file-exists-p file)
(insert-file-contents file)
;; When we find the file with the data,
(when (setq info (ignore-errors (package-buffer-info)))
;; stop looping,
(setq files nil)
;; set the 'dir kind,
(setf (package-desc-kind info) 'dir))))))
(unless info
(error "No .el files with package headers in `%s'" default-directory))
;; and return the info.

11
lisp/frame.el
View file

@ -808,12 +808,19 @@ also select the new frame."
new-frame))
(defvar before-make-frame-hook nil
"Functions to run before `make-frame' creates a new frame.")
"Functions to run before `make-frame' creates a new frame.
Note that these functions are usually not run for the initial
frame, except when the initial frame is created from an Emacs
daemon.")
(defvar after-make-frame-functions nil
"Functions to run after `make-frame' created a new frame.
The functions are run with one argument, the newly created
frame.")
frame.
Note that these functions are usually not run for the initial
frame, except when the initial frame is created from an Emacs
daemon.")
(defvar after-setting-font-hook nil
"Functions to run after a frame's font has been changed.")

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

@ -1748,7 +1748,7 @@ this is a reply."
(concat "\"" str "\"")
str)))
(when groups
(insert " ")))
(insert ",")))
(insert "\n")))))))
(defun gnus-mailing-list-followup-to ()

10
lisp/gnus/gnus-search.el
View file

@ -105,9 +105,13 @@
(gnus-add-shutdown #'gnus-search-shutdown 'gnus)
(define-error 'gnus-search-parse-error "Gnus search parsing error")
(define-error 'gnus-search-error "Gnus search error")
(define-error 'gnus-search-config-error "Gnus search configuration error")
(define-error 'gnus-search-parse-error "Gnus search parsing error"
'gnus-search-error)
(define-error 'gnus-search-config-error "Gnus search configuration error"
'gnus-search-error)
;;; User Customizable Variables:
@ -1927,7 +1931,7 @@ Assume \"size\" key is equal to \"larger\"."
(apply #'nnheader-message 4
"Search engine for %s improperly configured: %s"
server (cdr err))
(signal 'gnus-search-config-error err)))))
(signal (car err) (cdr err))))))
(alist-get 'search-group-spec specs))
;; Some search engines do their own limiting, but some don't, so
;; do it again here. This is bad because, if the user is

4
lisp/gnus/nnselect.el
View file

@ -779,6 +779,10 @@ Return an article list."
(args (alist-get 'nnselect-args specs)))
(condition-case-unless-debug err
(funcall func args)
;; Don't swallow gnus-search errors; the user should be made
;; aware of them.
(gnus-search-error
(signal (car err) (cdr err)))
(error (gnus-error 3 "nnselect-run: %s on %s gave error %s" func args err)
[]))))

3
lisp/help.el
View file

@ -1353,7 +1353,8 @@ Return nil if the key sequence is too long."
(defun help--describe-command (definition &optional translation)
(cond ((symbolp definition)
(if (fboundp definition)
(if (and (fboundp definition)
help-buffer-under-preparation)
(insert-text-button (symbol-name definition)
'type 'help-function
'help-args (list definition))

12
lisp/isearch.el
View file

@ -2504,6 +2504,11 @@ If no input items have been entered yet, just beep."
(if (null (cdr isearch-cmds))
(ding)
(isearch-pop-state))
;; When going back to the hidden match, reopen it.
(when (and (eq search-invisible 'open) isearch-hide-immediately
isearch-other-end)
(isearch-range-invisible (min (point) isearch-other-end)
(max (point) isearch-other-end)))
(isearch-update))
(defun isearch-del-char (&optional arg)
@ -3787,10 +3792,9 @@ Isearch, at least partially, as determined by `isearch-range-invisible'.
If `search-invisible' is t, which allows Isearch matches inside
invisible text, this function will always return non-nil, regardless
of what `isearch-range-invisible' says."
(and (or (eq search-invisible t)
(not (isearch-range-invisible beg end)))
(not (text-property-not-all (min beg end) (max beg end)
'inhibit-isearch nil))))
(and (not (text-property-not-all beg end 'inhibit-isearch nil))
(or (eq search-invisible t)
(not (isearch-range-invisible beg end)))))
;; General utilities

2
lisp/mwheel.el
View file

@ -255,7 +255,7 @@ Also see `mouse-wheel-tilt-scroll'."
(if (featurep 'xinput2)
'wheel-left
(unless (featurep 'x)
'mouse-8))
'mouse-6))
"Alternative wheel left event to consider.")
(defvar mouse-wheel-right-event

6
lisp/net/newst-plainview.el
View file

@ -589,7 +589,7 @@ calls `w3m-toggle-inline-image'. It works only if
(defun newsticker-close-buffer ()
"Close the newsticker buffer."
(interactive)
(newsticker--cache-update t)
(newsticker--cache-save)
(bury-buffer))
(defun newsticker-next-new-item (&optional do-not-wrap-at-eob)
@ -748,7 +748,7 @@ Return new buffer position."
(newsticker--cache-replace-age newsticker--cache feed 'new 'old)
(newsticker--cache-replace-age newsticker--cache feed 'obsolete
'old)
(newsticker--cache-update)
(newsticker--cache-save)
(newsticker--buffer-set-uptodate nil)
(newsticker--ticker-text-setup)
(newsticker-buffer-update)
@ -879,7 +879,7 @@ not get changed."
(newsticker--cache-replace-age newsticker--cache 'any 'new 'old)
(newsticker--buffer-set-uptodate nil)
(newsticker--ticker-text-setup)
(newsticker--cache-update)
(newsticker--cache-save)
(newsticker-buffer-update)))
(defun newsticker-hide-extra ()

2
lisp/net/tramp-archive.el
View file

@ -54,6 +54,7 @@
;; * ".ar" - UNIX archiver formats
;; * ".cab", ".CAB" - Microsoft Windows cabinets
;; * ".cpio" - CPIO archives
;; * ".crate" - Cargo (Rust) packages
;; * ".deb" - Debian packages
;; * ".depot" - HP-UX SD depots
;; * ".exe" - Self extracting Microsoft Windows EXE files
@ -141,6 +142,7 @@
"ar" ;; UNIX archiver formats.
"cab" "CAB" ;; Microsoft Windows cabinets.
"cpio" ;; CPIO archives.
"crate" ;; Cargo (Rust) packages. Not in libarchive testsuite.
"deb" ;; Debian packages. Not in libarchive testsuite.
"depot" ;; HP-UX SD depot. Not in libarchive testsuite.
"exe" ;; Self extracting Microsoft Windows EXE files.

10
lisp/net/tramp-gvfs.el
View file

@ -1521,11 +1521,11 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(size (cdr (assoc "filesystem::size" attr)))
(used (cdr (assoc "filesystem::used" attr)))
(free (cdr (assoc "filesystem::free" attr))))
(when (or size used free)
(list (string-to-number (or size "0"))
(string-to-number (or free "0"))
(- (string-to-number (or size "0"))
(string-to-number (or used "0"))))))))
(when (or size free)
(list (and size (string-to-number size))
(and free (string-to-number free))
(and size used
(- (string-to-number size) (string-to-number used))))))))
(defun tramp-gvfs-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."

23
lisp/net/tramp-sh.el
View file

@ -2678,17 +2678,15 @@ The method used must be an out-of-band method."
(point-min) 'noerror)
(replace-match (file-relative-name filename) t))
;; Try to insert the amount of free space. This is moved to
;; `dired-insert-directory' in Emacs 29.1.
(unless (boundp 'dired-free-space)
(goto-char (point-min))
;; First find the line to put it on.
(when (re-search-forward "^\\([[:space:]]*total\\)" nil t)
(when-let ((available (get-free-disk-space ".")))
;; Replace "total" with "total used", to avoid confusion.
(replace-match "\\1 used in directory")
(end-of-line)
(insert " available " available)))))
;; Try to insert the amount of free space.
(goto-char (point-min))
;; First find the line to put it on.
(when (re-search-forward "^\\([[:space:]]*total\\)" nil t)
(when-let ((available (get-free-disk-space ".")))
;; Replace "total" with "total used", to avoid confusion.
(replace-match "\\1 used in directory")
(end-of-line)
(insert " available " available))))
(prog1 (goto-char end-marker)
(set-marker beg-marker nil)
@ -6024,5 +6022,8 @@ function cell is returned to be applied on a buffer."
;; be to stipulate, as a directory or connection-local variable, an
;; additional rc file on the remote machine that is sourced every
;; time Tramp connects. <https://emacs.stackexchange.com/questions/62306>
;;
;; * Support hostname canonicalization in ~/.ssh/config.
;; <https://stackoverflow.com/questions/70205232/>
;;; tramp-sh.el ends here

14
lisp/net/tramp-smb.el
View file

@ -1120,14 +1120,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setcar x (concat (car x) "*"))))))
entries))
;; Insert size information. This is moved to
;; `dired-insert-directory' in Emacs 29.1.
(unless (boundp 'dired-free-space)
(when full-directory-p
(insert
(if avail
(format "total used in directory %s available %s\n" used avail)
(format "total %s\n" used)))))
;; Insert size information.
(when full-directory-p
(insert
(if avail
(format "total used in directory %s available %s\n" used avail)
(format "total %s\n" used))))
;; Print entries.
(mapc

2
lisp/org/org-version.el
View file

@ -11,7 +11,7 @@ Inserted by installing Org mode or when a release is made."
(defun org-git-version ()
"The Git version of Org mode.
Inserted by installing Org or when a release is made."
(let ((org-git-version "release_9.5.1-11-g96d91b"))
(let ((org-git-version "release_9.5.1-15-gdb4805"))
org-git-version))
(provide 'org-version)

2
lisp/org/ox-latex.el
View file

@ -3706,7 +3706,7 @@ Return PDF file's name."
(let ((outfile (org-export-output-file-name ".tex" subtreep)))
(org-export-to-file 'latex outfile
async subtreep visible-only body-only ext-plist
(lambda (file) (org-latex-compile file)))))
#'org-latex-compile)))
(defun org-latex-compile (texfile &optional snippet)
"Compile a TeX file.

101
lisp/pixel-scroll.el
View file

@ -133,6 +133,14 @@ This is only effective if supported by your mouse or touchpad."
:type 'float
:version "29.1")
(defcustom pixel-scroll-precision-large-scroll-height 70
"Pixels that must be scrolled before an animation is performed.
Nil means to not interpolate such scrolls."
:group 'mouse
:type '(choice (const :tag "Do not interpolate large scrolls" nil)
number)
:version "29.1")
(defun pixel-scroll-in-rush-p ()
"Return non-nil if next scroll should be non-smooth.
When scrolling request is delivered soon after the previous one,
@ -411,23 +419,23 @@ the height of the current window."
(object (posn-object desired-pos))
(desired-start (posn-point desired-pos))
(desired-vscroll (cdr (posn-object-x-y desired-pos)))
(edges (window-edges nil t))
(usable-height (- (nth 3 edges)
(nth 1 edges)))
(next-pos (save-excursion
(goto-char desired-start)
(when (zerop (vertical-motion (1+ scroll-margin)))
(signal 'end-of-buffer nil))
(point))))
(if (and (< (point) next-pos)
(let ((pos-visibility (pos-visible-in-window-p next-pos nil t)))
(and pos-visibility
(or (eq (length pos-visibility) 2)
(when-let* ((posn (posn-at-point next-pos))
(edges (window-edges nil t))
(usable-height (- (nth 3 edges)
(nth 1 edges))))
(> (cdr (posn-object-width-height posn))
usable-height))))))
(goto-char next-pos))
(if (or (consp object) (stringp object))
(point)))
(end-pos (posn-at-x-y 0 (+ usable-height
(window-tab-line-height)
(window-header-line-height)))))
(if (or (overlayp object)
(stringp object)
(and (consp object)
(stringp (car object)))
(and (consp (posn-object end-pos))
(> (cdr (posn-object-x-y end-pos)) 0)))
;; We are either on an overlay or a string, so set vscroll
;; directly.
(set-window-vscroll nil (+ (window-vscroll nil t)
@ -441,7 +449,15 @@ the height of the current window."
(beginning-of-visual-line)
(point)))
t))
(set-window-vscroll nil desired-vscroll t))))
(set-window-vscroll nil desired-vscroll t))
(if (and (or (< (point) next-pos))
(let ((pos-visibility (pos-visible-in-window-p next-pos nil t)))
(and pos-visibility
(or (eq (length pos-visibility) 2)
(when-let* ((posn (posn-at-point next-pos)))
(> (cdr (posn-object-width-height posn))
usable-height))))))
(goto-char next-pos))))
(defun pixel-scroll-precision-scroll-down (delta)
"Scroll the current window down by DELTA pixels."
@ -510,6 +526,28 @@ the height of the current window."
(set-window-vscroll nil desired-vscroll t))
(set-window-vscroll nil (abs delta) t)))))))
(defun pixel-scroll-precision-interpolate (delta)
"Interpolate a scroll of DELTA pixels.
This results in the window being scrolled by DELTA pixels with an
animation."
(while-no-input
(let ((percentage 0)
(total-time 0.01)
(time-elapsed 0.0)
(between-scroll 0.001))
(while (< percentage 1)
(sit-for between-scroll)
(setq time-elapsed (+ time-elapsed between-scroll)
percentage (/ time-elapsed total-time))
(if (< delta 0)
(pixel-scroll-precision-scroll-down
(ceiling (abs (* delta
(/ between-scroll total-time)))))
(pixel-scroll-precision-scroll-up
(ceiling (* delta
(/ between-scroll total-time)))))
(redisplay t)))))
(defun pixel-scroll-precision-scroll-up (delta)
"Scroll the current window up by DELTA pixels."
(let ((max-height (- (window-text-height nil t)
@ -535,17 +573,32 @@ wheel."
(if (> (abs delta) (window-text-height window t))
(mwheel-scroll event nil)
(with-selected-window window
(condition-case nil
(if (and pixel-scroll-precision-large-scroll-height
(> (abs delta)
pixel-scroll-precision-large-scroll-height)
(let* ((kin-state (pixel-scroll-kinetic-state))
(ring (aref kin-state 0))
(time (aref kin-state 1)))
(or (null time)
(> (- (float-time) time) 1.0)
(and (consp ring)
(ring-empty-p ring)))))
(progn
(if (< delta 0)
(pixel-scroll-precision-scroll-down (- delta))
(pixel-scroll-precision-scroll-up delta))
(pixel-scroll-accumulate-velocity delta))
;; Do not ding at buffer limits. Show a message instead.
(beginning-of-buffer
(message (error-message-string '(beginning-of-buffer))))
(end-of-buffer
(message (error-message-string '(end-of-buffer)))))))))
(let ((kin-state (pixel-scroll-kinetic-state)))
(aset kin-state 0 (make-ring 10))
(aset kin-state 1 nil))
(pixel-scroll-precision-interpolate delta))
(condition-case nil
(progn
(if (< delta 0)
(pixel-scroll-precision-scroll-down (- delta))
(pixel-scroll-precision-scroll-up delta))
(pixel-scroll-accumulate-velocity delta))
;; Do not ding at buffer limits. Show a message instead.
(beginning-of-buffer
(message (error-message-string '(beginning-of-buffer))))
(end-of-buffer
(message (error-message-string '(end-of-buffer))))))))))
(mwheel-scroll event nil))))
(defun pixel-scroll-kinetic-state ()

2
lisp/progmodes/gdb-mi.el
View file

@ -1266,7 +1266,7 @@ Used by Speedbar."
:version "22.1")
(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch)
(define-key global-map (vconcat gud-key-prefix "\C-w") 'gud-watch)
(keymap-set gud-global-map "C-w" 'gud-watch)
(declare-function tooltip-identifier-from-point "tooltip" (point))

8
lisp/progmodes/gud.el
View file

@ -90,8 +90,10 @@ pdb (Python), and jdb."
"Prefix of all GUD commands valid in C buffers."
:type 'key-sequence)
(global-set-key (vconcat gud-key-prefix "\C-l") #'gud-refresh)
;; (define-key ctl-x-map " " 'gud-break); backward compatibility hack
(defvar-keymap gud-global-map
"C-l" #'gud-refresh)
(global-set-key gud-key-prefix gud-global-map)
(defvar gud-marker-filter nil)
(put 'gud-marker-filter 'permanent-local t)
@ -433,7 +435,7 @@ we're in the GUD buffer)."
;; Unused lexical warning if cmd does not use "arg".
cmd))))
,(if key `(local-set-key ,(concat "\C-c" key) #',func))
,(if key `(global-set-key (vconcat gud-key-prefix ,key) #',func))))
,(if key `(define-key gud-global-map ,key #',func))))
;; Where gud-display-frame should put the debugging arrow; a cons of
;; (filename . line-number). This is set by the marker-filter, which scans

11
lisp/startup.el
View file

@ -1636,9 +1636,10 @@ Each element in the list should be a list of strings or pairs
`((:face (variable-pitch font-lock-comment-face)
"This is "
:link ("GNU Emacs"
,(lambda (_button) (browse-url "https://www.gnu.org/software/emacs/"))
,(lambda (_button)
(browse-url "https://www.gnu.org/software/emacs/"))
"Browse https://www.gnu.org/software/emacs/")
", one component of the "
", a text editor and more.\nIt's a component of the "
:link
,(lambda ()
(if (eq system-type 'gnu/linux)
@ -1651,7 +1652,11 @@ Each element in the list should be a list of strings or pairs
" operating system.\n"
:face (variable-pitch font-lock-builtin-face)
"\n"
,(lambda () (emacs-version))
,(lambda ()
(with-temp-buffer
(insert (emacs-version))
(fill-region (point-min) (point-max))
(buffer-string)))
"\n"
:face (variable-pitch (:height 0.8))
,(lambda () emacs-copyright)

19
lisp/textmodes/pixel-fill.el
View file

@ -116,15 +116,13 @@ prefix on subsequent lines."
(while (not (eolp))
;; We have to do some folding. First find the first previous
;; point suitable for folding.
(if (or (not (pixel-fill-find-fill-point (line-beginning-position)))
(= (point) start))
;; We had unbreakable text (for this width), so just go to
;; the first space and carry on.
(progn
(beginning-of-line)
(skip-chars-forward " ")
(search-forward " " (line-end-position) 'move)))
;; Success; continue.
(when (or (not (pixel-fill-find-fill-point (line-beginning-position)))
(= (point) start))
;; We had unbreakable text (for this width), so just go to
;; the first space and carry on.
(beginning-of-line)
(skip-chars-forward " ")
(search-forward " " (line-end-position) 'move))
(when (= (preceding-char) ?\s)
(delete-char -1))
(unless (eobp)
@ -133,7 +131,8 @@ prefix on subsequent lines."
(insert (propertize " " 'display
(list 'space :align-to (list indentation))))))
(setq start (point))
(pixel-fill--goto-pixel width))))
(unless (eobp)
(pixel-fill--goto-pixel width)))))
(define-inline pixel-fill--char-breakable-p (char)
"Return non-nil if a line can be broken before and after CHAR."

2
src/image.c
View file

@ -10208,7 +10208,7 @@ DEF_DLL_FN (void, rsvg_handle_set_dpi_x_y,
(RsvgHandle * handle, double dpi_x, double dpi_y));
# if LIBRSVG_CHECK_VERSION (2, 52, 1)
DEF_DLL_FN (void, rsvg_handle_get_intrinsic_size_in_pixels,
DEF_DLL_FN (gboolean, rsvg_handle_get_intrinsic_size_in_pixels,
(RsvgHandle *, gdouble *, gdouble *));
# endif
# if LIBRSVG_CHECK_VERSION (2, 46, 0)

45
src/nsfns.m
View file

@ -2362,6 +2362,47 @@ Frames are listed from topmost (first) to bottommost (last). */)
========================================================================== */
#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1080
/* Moving files to the system recycle bin.
Used by `move-file-to-trash' instead of the default moving to ~/.Trash */
DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash,
Ssystem_move_file_to_trash, 1, 1, 0,
doc: /* Move file or directory named FILENAME to the recycle bin. */)
(Lisp_Object filename)
{
Lisp_Object handler;
Lisp_Object operation;
operation = Qdelete_file;
if (!NILP (Ffile_directory_p (filename))
&& NILP (Ffile_symlink_p (filename)))
{
operation = intern ("delete-directory");
filename = Fdirectory_file_name (filename);
}
/* Must have fully qualified file names for moving files to Trash. */
filename = Fexpand_file_name (filename, Qnil);
handler = Ffind_file_name_handler (filename, operation);
if (!NILP (handler))
return call2 (handler, operation, filename);
else
{
NSFileManager *fm = [NSFileManager defaultManager];
BOOL result = NO;
NSURL *fileURL = [NSURL fileURLWithPath:[NSString stringWithLispString:filename]
isDirectory:!NILP (Ffile_directory_p (filename))];
if ([fm respondsToSelector:@selector(trashItemAtURL:resultingItemURL:error:)])
result = [fm trashItemAtURL:fileURL resultingItemURL:nil error:nil];
if (!result)
report_file_error ("Removing old name", list1 (filename));
}
return Qnil;
}
#endif
DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
doc: /* SKIP: real doc in xfns.c. */)
(Lisp_Object color, Lisp_Object frame)
@ -3243,6 +3284,10 @@ - (Lisp_Object)lispString
defsubr (&Sx_show_tip);
defsubr (&Sx_hide_tip);
#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1080
defsubr (&Ssystem_move_file_to_trash);
#endif
as_status = 0;
as_script = Qnil;
staticpro (&as_script);

17
src/xdisp.c
View file

@ -5822,8 +5822,15 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
if (CONSP (XCDR (XCDR (spec))))
{
Lisp_Object face_name = XCAR (XCDR (XCDR (spec)));
int face_id2 = lookup_derived_face (it->w, it->f, face_name,
FRINGE_FACE_ID, false);
int face_id2;
/* Don't allow quitting from lookup_derived_face, for when
we are displaying a non-selected window, and the buffer's
point was temporarily moved to the window-point. */
ptrdiff_t count1 = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
face_id2 = lookup_derived_face (it->w, it->f, face_name,
FRINGE_FACE_ID, false);
unbind_to (count1, Qnil);
if (face_id2 >= 0)
face_id = face_id2;
}
@ -17699,9 +17706,9 @@ cursor_row_fully_visible_p (struct window *w, bool force_p,
enum
{
SCROLLING_SUCCESS,
SCROLLING_FAILED,
SCROLLING_NEED_LARGER_MATRICES
SCROLLING_SUCCESS = 1,
SCROLLING_FAILED = 0,
SCROLLING_NEED_LARGER_MATRICES = -1
};
/* If scroll-conservatively is more than this, never recenter.

7
test/lisp/calendar/time-date-tests.el
View file

@ -41,6 +41,13 @@
(encode-time-value 1 2 3 4 3))
'(1 2 3 4))))
(ert-deftest test-date-to-time ()
(should (equal (format-time-string "%F %T" (date-to-time "2021-12-04"))
"2021-12-04 00:00:00")))
(ert-deftest test-days-between ()
(should (equal (days-between "2021-10-22" "2020-09-29") 388)))
(ert-deftest test-leap-year ()
(should-not (date-leap-year-p 1999))
(should-not (date-leap-year-p 1900))

2
test/lisp/dired-aux-tests.el
View file

@ -64,7 +64,7 @@
(ert-deftest dired-test-bug28834 ()
"test for https://debbugs.gnu.org/28834 ."
(let (from to-cp to-mv)
(let (to-cp to-mv)
;; `dired-create-destination-dirs' set to 'always.
(with-dired-bug28834-test
'always nil

49
test/lisp/dired-tests.el
View file

@ -543,10 +543,12 @@ path's data to use."
((equal "." path) default-directory)
(path)))
(return-size
(car (files-tests--look-up-free-data path))))
;; It is always defined but this silences the byte-compiler:
(when (fboundp 'files-tests--look-up-free-data)
(car (files-tests--look-up-free-data path)))))
(list return-size return-size return-size))))
(defun files-tests--insert-directory-output (dir &optional verbose)
(defun files-tests--insert-directory-output (dir &optional _verbose)
"Run `insert-directory' and return its output."
(with-current-buffer-window "files-tests--insert-directory" nil nil
(let ((dired-free-space 'separate))
@ -555,35 +557,46 @@ path's data to use."
(ert-deftest files-tests-insert-directory-shows-files ()
"Verify `insert-directory' reports the files in the directory."
(let* ((test-dir (car test-files))
(files (cdr test-files))
(output (files-tests--insert-directory-output test-dir)))
(dolist (file files)
(should (string-match-p file output)))))
;; It is always defined but this silences the byte-compiler:
(when (fboundp 'files-tests--insert-directory-output)
(let* ((test-dir (car test-files))
(files (cdr test-files))
(output (files-tests--insert-directory-output test-dir)))
(dolist (file files)
(should (string-match-p file output))))))
(defun files-tests--insert-directory-shows-given-free (dir &optional
info-func)
"Run `insert-directory' and verify it reports the correct available space.
Stub `file-system-info' to ensure the available space is consistent,
either with the given stub function or a default one using test data."
(cl-letf (((symbol-function 'file-system-info)
(or info-func
(files-tests--make-file-system-info-stub))))
(should (string-match-p (cadr
(files-tests--look-up-free-data dir))
(files-tests--insert-directory-output dir t)))))
;; It is always defined but this silences the byte-compiler:
(when (and (fboundp 'files-tests--make-file-system-info-stub)
(fboundp 'files-tests--look-up-free-data)
(fboundp 'files-tests--insert-directory-output))
(cl-letf (((symbol-function 'file-system-info)
(or info-func
(files-tests--make-file-system-info-stub))))
(should (string-match-p (cadr
(files-tests--look-up-free-data dir))
(files-tests--insert-directory-output dir t))))))
(ert-deftest files-tests-insert-directory-shows-free ()
"Test that verbose `insert-directory' shows the correct available space."
(files-tests--insert-directory-shows-given-free
test-dir
(files-tests--make-file-system-info-stub test-dir)))
;; It is always defined but this silences the byte-compiler:
(when (and (fboundp 'files-tests--insert-directory-shows-given-free)
(fboundp 'files-tests--make-file-system-info-stub))
(files-tests--insert-directory-shows-given-free
test-dir
(files-tests--make-file-system-info-stub test-dir))))
(ert-deftest files-tests-bug-50630 ()
"Verify verbose `insert-directory' shows free space of the target directory.
The current directory at call time should not affect the result (Bug#50630)."
(let ((default-directory test-dir-other))
(files-tests--insert-directory-shows-given-free test-dir))))
;; It is always defined but this silences the byte-compiler:
(when (fboundp 'files-tests--insert-directory-shows-given-free)
(let ((default-directory test-dir-other))
(files-tests--insert-directory-shows-given-free test-dir)))))
(provide 'dired-tests)
;;; dired-tests.el ends here

9
test/lisp/emacs-lisp/cl-generic-tests.el
View file

@ -200,9 +200,14 @@
(fmakunbound 'cl--generic-1)
(cl-defgeneric cl--generic-1 (x y))
(cl-defmethod cl--generic-1 ((x t) y)
(list x y (cl-next-method-p)))
(list x y
(with-suppressed-warnings ((obsolete cl-next-method-p))
(cl-next-method-p))))
(cl-defmethod cl--generic-1 ((_x (eql 4)) _y)
(cl-list* "quatre" (cl-next-method-p) (cl-call-next-method)))
(cl-list* "quatre"
(with-suppressed-warnings ((obsolete cl-next-method-p))
(cl-next-method-p))
(cl-call-next-method)))
(should (equal (cl--generic-1 4 5) '("quatre" t 4 5 nil))))
(ert-deftest cl-generic-test-12-context ()

4
test/lisp/emacs-lisp/cl-macs-tests.el
View file

@ -668,6 +668,10 @@ collection clause."
#'len))
(`(function (lambda (,_ ,_) . ,_)) t))))
(with-suppressed-warnings ((lexical test) (lexical test1) (lexical test2))
(defvar test)
(defvar test1)
(defvar test2))
(ert-deftest cl-macs--progv ()
(should (= (cl-progv '(test test) '(1 2) test) 2))
(should (equal (cl-progv '(test1 test2) '(1 2) (list test1 test2))

4
test/lisp/emacs-lisp/derived-tests.el
View file

@ -24,13 +24,13 @@
(define-derived-mode derived-tests--parent-mode prog-mode "P"
:after-hook
(let ((f (let ((x "S")) (lambda () x))))
(insert (format "AFP=%s " (let ((x "D")) (funcall f)))))
(insert (format "AFP=%s " (let ((x "D")) x (funcall f)))))
(insert "PB "))
(define-derived-mode derived-tests--child-mode derived-tests--parent-mode "C"
:after-hook
(let ((f (let ((x "S")) (lambda () x))))
(insert (format "AFC=%s " (let ((x "D")) (funcall f)))))
(insert (format "AFC=%s " (let ((x "D")) x (funcall f)))))
(insert "CB "))
(ert-deftest derived-tests-after-hook-lexical ()

9
test/lisp/emacs-lisp/edebug-tests.el
View file

@ -860,7 +860,8 @@ test and possibly others should be updated."
(let ((inhibit-read-only t))
(delete-region (point-min) (point-max))
(insert "`1"))
(edebug-eval-defun nil)
(with-suppressed-warnings ((obsolete edebug-eval-defun))
(edebug-eval-defun nil))
;; `eval-defun' outputs its message to the echo area in a rather
;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed
;; there in separate pieces (via `print' rather than via `message').
@ -870,7 +871,8 @@ test and possibly others should be updated."
(setq edebug-initial-mode 'go)
;; In Bug#23651 Edebug would hang reading `1.
(edebug-eval-defun t)))
(with-suppressed-warnings ((obsolete edebug-eval-defun))
(edebug-eval-defun t))))
(ert-deftest edebug-tests-trivial-comma ()
"Edebug can read a trivial comma expression (Bug#23651)."
@ -879,7 +881,8 @@ test and possibly others should be updated."
(delete-region (point-min) (point-max))
(insert ",1")
(read-only-mode)
(should-error (edebug-eval-defun t))))
(with-suppressed-warnings ((obsolete edebug-eval-defun))
(should-error (edebug-eval-defun t)))))
(ert-deftest edebug-tests-circular-read-syntax ()
"Edebug can instrument code using circular read object syntax (Bug#23660)."

285
test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
View file

@ -85,37 +85,40 @@
(defclass eitest-B-base2 () ())
(defclass eitest-B (eitest-B-base1 eitest-B-base2) ())
(defmethod eitest-F :BEFORE ((_p eitest-B-base1))
(eieio-test-method-store :BEFORE 'eitest-B-base1))
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric)
(obsolete call-next-method)
(obsolete next-method-p))
(defmethod eitest-F :BEFORE ((_p eitest-B-base1))
(eieio-test-method-store :BEFORE 'eitest-B-base1))
(defmethod eitest-F :BEFORE ((_p eitest-B-base2))
(eieio-test-method-store :BEFORE 'eitest-B-base2))
(defmethod eitest-F :BEFORE ((_p eitest-B-base2))
(eieio-test-method-store :BEFORE 'eitest-B-base2))
(defmethod eitest-F :BEFORE ((_p eitest-B))
(eieio-test-method-store :BEFORE 'eitest-B))
(defmethod eitest-F :BEFORE ((_p eitest-B))
(eieio-test-method-store :BEFORE 'eitest-B))
(defmethod eitest-F ((_p eitest-B))
(eieio-test-method-store :PRIMARY 'eitest-B)
(call-next-method))
(defmethod eitest-F ((_p eitest-B-base1))
(eieio-test-method-store :PRIMARY 'eitest-B-base1)
(call-next-method))
(defmethod eitest-F ((_p eitest-B-base2))
(eieio-test-method-store :PRIMARY 'eitest-B-base2)
(when (next-method-p)
(defmethod eitest-F ((_p eitest-B))
(eieio-test-method-store :PRIMARY 'eitest-B)
(call-next-method))
)
(defmethod eitest-F :AFTER ((_p eitest-B-base1))
(eieio-test-method-store :AFTER 'eitest-B-base1))
(defmethod eitest-F ((_p eitest-B-base1))
(eieio-test-method-store :PRIMARY 'eitest-B-base1)
(call-next-method))
(defmethod eitest-F :AFTER ((_p eitest-B-base2))
(eieio-test-method-store :AFTER 'eitest-B-base2))
(defmethod eitest-F ((_p eitest-B-base2))
(eieio-test-method-store :PRIMARY 'eitest-B-base2)
(when (next-method-p)
(call-next-method)))
(defmethod eitest-F :AFTER ((_p eitest-B))
(eieio-test-method-store :AFTER 'eitest-B))
(defmethod eitest-F :AFTER ((_p eitest-B-base1))
(eieio-test-method-store :AFTER 'eitest-B-base1))
(defmethod eitest-F :AFTER ((_p eitest-B-base2))
(eieio-test-method-store :AFTER 'eitest-B-base2))
(defmethod eitest-F :AFTER ((_p eitest-B))
(eieio-test-method-store :AFTER 'eitest-B)))
(ert-deftest eieio-test-method-order-list-3 ()
(let ((eieio-test-method-order-list nil)
@ -138,9 +141,11 @@
;;; Test static invocation
;;
(defmethod eitest-H :STATIC ((_class eitest-A))
"No need to do work in here."
'moose)
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod eitest-H :STATIC ((_class eitest-A))
"No need to do work in here."
'moose))
(ert-deftest eieio-test-method-order-list-4 ()
;; Both of these situations should succeed.
@ -149,17 +154,19 @@
;;; Return value from :PRIMARY
;;
(defmethod eitest-I :BEFORE ((_a eitest-A))
(eieio-test-method-store :BEFORE 'eitest-A)
":before")
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod eitest-I :BEFORE ((_a eitest-A))
(eieio-test-method-store :BEFORE 'eitest-A)
":before")
(defmethod eitest-I :PRIMARY ((_a eitest-A))
(eieio-test-method-store :PRIMARY 'eitest-A)
":primary")
(defmethod eitest-I :PRIMARY ((_a eitest-A))
(eieio-test-method-store :PRIMARY 'eitest-A)
":primary")
(defmethod eitest-I :AFTER ((_a eitest-A))
(eieio-test-method-store :AFTER 'eitest-A)
":after")
(defmethod eitest-I :AFTER ((_a eitest-A))
(eieio-test-method-store :AFTER 'eitest-A)
":after"))
(ert-deftest eieio-test-method-order-list-5 ()
(let ((eieio-test-method-order-list nil)
@ -175,16 +182,18 @@
(defclass C-base2 () ())
(defclass C (C-base1 C-base2) ())
;; Just use the obsolete name once, to make sure it also works.
(defmethod constructor :STATIC ((_p C-base1) &rest _args)
(eieio-test-method-store :STATIC 'C-base1)
(if (next-method-p) (call-next-method))
)
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric)
(obsolete next-method-p)
(obsolete call-next-method))
;; Just use the obsolete name once, to make sure it also works.
(defmethod constructor :STATIC ((_p C-base1) &rest _args)
(eieio-test-method-store :STATIC 'C-base1)
(if (next-method-p) (call-next-method)))
(defmethod make-instance :STATIC ((_p C-base2) &rest _args)
(eieio-test-method-store :STATIC 'C-base2)
(if (next-method-p) (call-next-method))
)
(defmethod make-instance :STATIC ((_p C-base2) &rest _args)
(eieio-test-method-store :STATIC 'C-base2)
(if (next-method-p) (call-next-method))))
(cl-defmethod make-instance ((_p (subclass C)) &rest _args)
(eieio-test-method-store :STATIC 'C)
@ -215,29 +224,32 @@
(defclass D-base2 (D-base0) () :method-invocation-order :depth-first)
(defclass D (D-base1 D-base2) () :method-invocation-order :depth-first)
(defmethod eitest-F ((_p D))
"D"
(eieio-test-method-store :PRIMARY 'D)
(call-next-method))
(defmethod eitest-F ((_p D-base0))
"D-base0"
(eieio-test-method-store :PRIMARY 'D-base0)
;; This should have no next
;; (when (next-method-p) (call-next-method))
)
(defmethod eitest-F ((_p D-base1))
"D-base1"
(eieio-test-method-store :PRIMARY 'D-base1)
(call-next-method))
(defmethod eitest-F ((_p D-base2))
"D-base2"
(eieio-test-method-store :PRIMARY 'D-base2)
(when (next-method-p)
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric)
(obsolete call-next-method)
(obsolete next-method-p))
(defmethod eitest-F ((_p D))
"D"
(eieio-test-method-store :PRIMARY 'D)
(call-next-method))
)
(defmethod eitest-F ((_p D-base0))
"D-base0"
(eieio-test-method-store :PRIMARY 'D-base0)
;; This should have no next
;; (when (next-method-p) (call-next-method))
)
(defmethod eitest-F ((_p D-base1))
"D-base1"
(eieio-test-method-store :PRIMARY 'D-base1)
(call-next-method))
(defmethod eitest-F ((_p D-base2))
"D-base2"
(eieio-test-method-store :PRIMARY 'D-base2)
(when (next-method-p)
(call-next-method))))
(ert-deftest eieio-test-method-order-list-7 ()
(let ((eieio-test-method-order-list nil)
@ -258,25 +270,27 @@
(defclass E-base2 (E-base0) () :method-invocation-order :breadth-first)
(defclass E (E-base1 E-base2) () :method-invocation-order :breadth-first)
(defmethod eitest-F ((_p E))
(eieio-test-method-store :PRIMARY 'E)
(call-next-method))
(defmethod eitest-F ((_p E-base0))
(eieio-test-method-store :PRIMARY 'E-base0)
;; This should have no next
;; (when (next-method-p) (call-next-method))
)
(defmethod eitest-F ((_p E-base1))
(eieio-test-method-store :PRIMARY 'E-base1)
(call-next-method))
(defmethod eitest-F ((_p E-base2))
(eieio-test-method-store :PRIMARY 'E-base2)
(when (next-method-p)
(with-suppressed-warnings ((obsolete defmethod)
(obsolete next-method-p)
(obsolete call-next-method))
(defmethod eitest-F ((_p E))
(eieio-test-method-store :PRIMARY 'E)
(call-next-method))
)
(defmethod eitest-F ((_p E-base0))
(eieio-test-method-store :PRIMARY 'E-base0)
;; This should have no next
;; (when (next-method-p) (call-next-method))
)
(defmethod eitest-F ((_p E-base1))
(eieio-test-method-store :PRIMARY 'E-base1)
(call-next-method))
(defmethod eitest-F ((_p E-base2))
(eieio-test-method-store :PRIMARY 'E-base2)
(when (next-method-p)
(call-next-method))))
(ert-deftest eieio-test-method-order-list-8 ()
(let ((eieio-test-method-order-list nil)
@ -295,24 +309,31 @@
(defclass eitest-Ja ()
())
(defmethod initialize-instance :after ((_this eitest-Ja) &rest _slots)
;(message "+Ja")
;; FIXME: Using next-method-p in an after-method is invalid!
(when (next-method-p)
(call-next-method))
;(message "-Ja")
)
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric)
(obsolete next-method-p)
(obsolete call-next-method))
(defmethod initialize-instance :after ((_this eitest-Ja) &rest _slots)
;;(message "+Ja")
;; FIXME: Using next-method-p in an after-method is invalid!
(when (next-method-p)
(call-next-method))
;;(message "-Ja")
))
(defclass eitest-Jb ()
())
(defmethod initialize-instance :after ((_this eitest-Jb) &rest _slots)
;(message "+Jb")
;; FIXME: Using next-method-p in an after-method is invalid!
(when (next-method-p)
(call-next-method))
;(message "-Jb")
)
(with-suppressed-warnings ((obsolete defmethod)
(obsolete next-method-p)
(obsolete call-next-method))
(defmethod initialize-instance :after ((_this eitest-Jb) &rest _slots)
;;(message "+Jb")
;; FIXME: Using next-method-p in an after-method is invalid!
(when (next-method-p)
(call-next-method))
;;(message "-Jb")
))
(defclass eitest-Jc (eitest-Jb)
())
@ -320,12 +341,16 @@
(defclass eitest-Jd (eitest-Jc eitest-Ja)
())
(defmethod initialize-instance ((_this eitest-Jd) &rest _slots)
;(message "+Jd")
(when (next-method-p)
(call-next-method))
;(message "-Jd")
)
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric)
(obsolete next-method-p)
(obsolete call-next-method))
(defmethod initialize-instance ((_this eitest-Jd) &rest _slots)
;;(message "+Jd")
(when (next-method-p)
(call-next-method))
;;(message "-Jd")
))
(ert-deftest eieio-test-method-order-list-9 ()
(should (eitest-Jd)))
@ -345,32 +370,36 @@
(defclass CNM-2 (CNM-1-1 CNM-1-2)
())
(defmethod CNM-M ((this CNM-0) args)
(push (cons 'CNM-0 (copy-sequence args))
eieio-test-call-next-method-arguments)
(when (next-method-p)
(call-next-method
this (cons 'CNM-0 args))))
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric)
(obsolete next-method-p)
(obsolete call-next-method))
(defmethod CNM-M ((this CNM-0) args)
(push (cons 'CNM-0 (copy-sequence args))
eieio-test-call-next-method-arguments)
(when (next-method-p)
(call-next-method
this (cons 'CNM-0 args))))
(defmethod CNM-M ((this CNM-1-1) args)
(push (cons 'CNM-1-1 (copy-sequence args))
eieio-test-call-next-method-arguments)
(when (next-method-p)
(call-next-method
this (cons 'CNM-1-1 args))))
(defmethod CNM-M ((this CNM-1-1) args)
(push (cons 'CNM-1-1 (copy-sequence args))
eieio-test-call-next-method-arguments)
(when (next-method-p)
(call-next-method
this (cons 'CNM-1-1 args))))
(defmethod CNM-M ((_this CNM-1-2) args)
(push (cons 'CNM-1-2 (copy-sequence args))
eieio-test-call-next-method-arguments)
(when (next-method-p)
(call-next-method)))
(defmethod CNM-M ((_this CNM-1-2) args)
(push (cons 'CNM-1-2 (copy-sequence args))
eieio-test-call-next-method-arguments)
(when (next-method-p)
(call-next-method)))
(defmethod CNM-M ((this CNM-2) args)
(push (cons 'CNM-2 (copy-sequence args))
eieio-test-call-next-method-arguments)
(when (next-method-p)
(call-next-method
this (cons 'CNM-2 args))))
(defmethod CNM-M ((this CNM-2) args)
(push (cons 'CNM-2 (copy-sequence args))
eieio-test-call-next-method-arguments)
(when (next-method-p)
(call-next-method
this (cons 'CNM-2 args)))))
(ert-deftest eieio-test-method-order-list-10 ()
(let ((eieio-test-call-next-method-arguments nil))

326
test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
View file

@ -160,30 +160,33 @@
;; error
(should-error (abstract-class)))
(defgeneric generic1 () "First generic function.")
(with-suppressed-warnings ((obsolete defgeneric))
(defgeneric generic1 () "First generic function."))
(ert-deftest eieio-test-03-generics ()
(defun anormalfunction () "A plain function for error testing." nil)
(should-error
(progn
(defgeneric anormalfunction ()
"Attempt to turn it into a generic.")))
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defun anormalfunction () "A plain function for error testing." nil)
(should-error
(progn
(defgeneric anormalfunction ()
"Attempt to turn it into a generic.")))
;; Check that generic-p works
(should (generic-p 'generic1))
;; Check that generic-p works
(should (generic-p 'generic1))
(defmethod generic1 ((c class-a))
"Method on generic1."
'monkey)
(defmethod generic1 ((_c class-a))
"Method on generic1."
'monkey)
(defmethod generic1 (not-an-object)
"Method generic1 that can take a non-object."
not-an-object)
(defmethod generic1 (not-an-object)
"Method generic1 that can take a non-object."
not-an-object)
(let ((ans-obj (generic1 (class-a)))
(ans-num (generic1 666)))
(should (eq ans-obj 'monkey))
(should (eq ans-num 666))))
(let ((ans-obj (generic1 (class-a)))
(ans-num (generic1 666)))
(should (eq ans-obj 'monkey))
(should (eq ans-num 666)))))
(defclass static-method-class ()
((some-slot :initform nil
@ -191,11 +194,13 @@
:documentation "A slot."))
:documentation "A class used for testing static methods.")
(defmethod static-method-class-method :STATIC ((c static-method-class) value)
"Test static methods.
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod static-method-class-method :STATIC ((c static-method-class) value)
"Test static methods.
Argument C is the class bound to this static method."
(if (eieio-object-p c) (setq c (eieio-object-class c)))
(oset-default c some-slot value))
(if (eieio-object-p c) (setq c (eieio-object-class c)))
(oset-default c some-slot value)))
(ert-deftest eieio-test-04-static-method ()
;; Call static method on a class and see if it worked
@ -209,11 +214,13 @@ Argument C is the class bound to this static method."
()
"A second class after the previous for static methods.")
(defmethod static-method-class-method :STATIC ((c static-method-class-2) value)
"Test static methods.
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod static-method-class-method :STATIC ((c static-method-class-2) value)
"Test static methods.
Argument C is the class bound to this static method."
(if (eieio-object-p c) (setq c (eieio-object-class c)))
(oset-default c some-slot (intern (concat "moose-" (symbol-name value)))))
(if (eieio-object-p c) (setq c (eieio-object-class c)))
(oset-default c some-slot (intern (concat "moose-" (symbol-name value))))))
(static-method-class-method 'static-method-class-2 'class)
(should (eq (oref-default 'static-method-class-2 some-slot) 'moose-class))
@ -240,64 +247,71 @@ Argument C is the class bound to this static method."
(should (make-instance 'class-a :water 'cho))
(should (make-instance 'class-b)))
(defmethod class-cn ((a class-a))
"Try calling `call-next-method' when there isn't one.
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod class-cn ((_a class-a))
"Try calling `call-next-method' when there isn't one.
Argument A is object of type symbol `class-a'."
(call-next-method))
(with-suppressed-warnings ((obsolete call-next-method))
(call-next-method)))
(defmethod no-next-method ((a class-a) &rest args)
"Override signal throwing for variable `class-a'.
(defmethod no-next-method ((_a class-a) &rest _args)
"Override signal throwing for variable `class-a'.
Argument A is the object of class variable `class-a'."
'moose)
'moose))
(ert-deftest eieio-test-08-call-next-method ()
;; Play with call-next-method
(should (eq (class-cn eitest-ab) 'moose)))
(defmethod no-applicable-method ((b class-b) method &rest args)
"No need.
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod no-applicable-method ((_b class-b) _method &rest _args)
"No need.
Argument B is for booger.
METHOD is the method that was attempting to be called."
'moose)
'moose))
(ert-deftest eieio-test-09-no-applicable-method ()
;; Non-existing methods.
(should (eq (class-cn eitest-b) 'moose)))
(defmethod class-fun ((a class-a))
"Fun with class A."
'moose)
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod class-fun ((_a class-a))
"Fun with class A."
'moose)
(defmethod class-fun ((b class-b))
"Fun with class B."
(error "Class B fun should not be called")
)
(defmethod class-fun ((_b class-b))
"Fun with class B."
(error "Class B fun should not be called"))
(defmethod class-fun-foo ((b class-b))
"Foo Fun with class B."
'moose)
(defmethod class-fun-foo ((_b class-b))
"Foo Fun with class B."
'moose)
(defmethod class-fun2 ((a class-a))
"More fun with class A."
'moose)
(defmethod class-fun2 ((_a class-a))
"More fun with class A."
'moose)
(defmethod class-fun2 ((b class-b))
"More fun with class B."
(error "Class B fun2 should not be called")
)
(defmethod class-fun2 ((_b class-b))
"More fun with class B."
(error "Class B fun2 should not be called"))
(defmethod class-fun2 ((ab class-ab))
"More fun with class AB."
(call-next-method))
(defmethod class-fun2 ((_ab class-ab))
"More fun with class AB."
(with-suppressed-warnings ((obsolete call-next-method))
(call-next-method)))
;; How about if B is the only slot?
(defmethod class-fun3 ((b class-b))
"Even More fun with class B."
'moose)
;; How about if B is the only slot?
(defmethod class-fun3 ((_b class-b))
"Even More fun with class B."
'moose)
(defmethod class-fun3 ((ab class-ab))
"Even More fun with class AB."
(call-next-method))
(defmethod class-fun3 ((_ab class-ab))
"Even More fun with class AB."
(with-suppressed-warnings ((obsolete call-next-method))
(call-next-method))))
(ert-deftest eieio-test-10-multiple-inheritance ()
;; play with methods and mi
@ -314,20 +328,22 @@ METHOD is the method that was attempting to be called."
(defvar class-fun-value-seq '())
(defmethod class-fun-value :BEFORE ((a class-a))
"Return `before', and push `before' in `class-fun-value-seq'."
(push 'before class-fun-value-seq)
'before)
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod class-fun-value :BEFORE ((_a class-a))
"Return `before', and push `before' in `class-fun-value-seq'."
(push 'before class-fun-value-seq)
'before)
(defmethod class-fun-value :PRIMARY ((a class-a))
"Return `primary', and push `primary' in `class-fun-value-seq'."
(push 'primary class-fun-value-seq)
'primary)
(defmethod class-fun-value :PRIMARY ((_a class-a))
"Return `primary', and push `primary' in `class-fun-value-seq'."
(push 'primary class-fun-value-seq)
'primary)
(defmethod class-fun-value :AFTER ((a class-a))
"Return `after', and push `after' in `class-fun-value-seq'."
(push 'after class-fun-value-seq)
'after)
(defmethod class-fun-value :AFTER ((_a class-a))
"Return `after', and push `after' in `class-fun-value-seq'."
(push 'after class-fun-value-seq)
'after))
(ert-deftest eieio-test-12-generic-function-call ()
;; Test value of a generic function call
@ -343,20 +359,23 @@ METHOD is the method that was attempting to be called."
;;
(ert-deftest eieio-test-13-init-methods ()
(defmethod initialize-instance ((a class-a) &rest slots)
"Initialize the slots of class-a."
(call-next-method)
(if (/= (oref a test-tag) 1)
(error "shared-initialize test failed."))
(oset a test-tag 2))
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric)
(obsolete call-next-method))
(defmethod initialize-instance ((a class-a) &rest _slots)
"Initialize the slots of class-a."
(call-next-method)
(if (/= (oref a test-tag) 1)
(error "shared-initialize test failed."))
(oset a test-tag 2))
(defmethod shared-initialize ((a class-a) &rest slots)
"Shared initialize method for class-a."
(call-next-method)
(oset a test-tag 1))
(defmethod shared-initialize ((a class-a) &rest _slots)
"Shared initialize method for class-a."
(call-next-method)
(oset a test-tag 1))
(let ((ca (class-a)))
(should (= (oref ca test-tag) 2))))
(let ((ca (class-a)))
(should (= (oref ca test-tag) 2)))))
;;; Perform slot testing
@ -368,10 +387,11 @@ METHOD is the method that was attempting to be called."
(should (oref eitest-ab amphibian)))
(ert-deftest eieio-test-15-slot-missing ()
(defmethod slot-missing ((ab class-ab) &rest foo)
"If a slot in AB is unbound, return something cool. FOO."
'moose)
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod slot-missing ((_ab class-ab) &rest _foo)
"If a slot in AB is unbound, return something cool. FOO."
'moose))
(should (eq (oref eitest-ab ooga-booga) 'moose))
(should-error (oref eitest-a ooga-booga) :type 'invalid-slot-name))
@ -391,17 +411,20 @@ METHOD is the method that was attempting to be called."
(defclass virtual-slot-class ()
((base-value :initarg :base-value))
"Class has real slot :base-value and simulated slot :derived-value.")
(defmethod slot-missing ((vsc virtual-slot-class)
slot-name operation &optional new-value)
"Simulate virtual slot derived-value."
(cond
((or (eq slot-name :derived-value)
(eq slot-name 'derived-value))
(with-slots (base-value) vsc
(if (eq operation 'oref)
(+ base-value 1)
(setq base-value (- new-value 1)))))
(t (call-next-method))))
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod slot-missing ((vsc virtual-slot-class)
slot-name operation &optional new-value)
"Simulate virtual slot derived-value."
(cond
((or (eq slot-name :derived-value)
(eq slot-name 'derived-value))
(with-slots (base-value) vsc
(if (eq operation 'oref)
(+ base-value 1)
(setq base-value (- new-value 1)))))
(t (with-suppressed-warnings ((obsolete call-next-method))
(call-next-method))))))
(ert-deftest eieio-test-17-virtual-slot ()
(setq eitest-vsca (virtual-slot-class :base-value 1))
@ -424,35 +447,37 @@ METHOD is the method that was attempting to be called."
(should (= (oref eitest-vscb :derived-value) 5)))
(ert-deftest eieio-test-18-slot-unbound ()
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod slot-unbound ((_a class-a) &rest _foo)
"If a slot in A is unbound, ignore FOO."
'moose)
(defmethod slot-unbound ((a class-a) &rest foo)
"If a slot in A is unbound, ignore FOO."
'moose)
(should (eq (oref eitest-a water) 'moose))
(should (eq (oref eitest-a water) 'moose))
;; Check if oset of unbound works
(oset eitest-a water 'moose)
(should (eq (oref eitest-a water) 'moose))
;; Check if oset of unbound works
(oset eitest-a water 'moose)
(should (eq (oref eitest-a water) 'moose))
;; oref/oref-default comparison
(should-not (eq (oref eitest-a water) (oref-default eitest-a water)))
;; oref/oref-default comparison
(should-not (eq (oref eitest-a water) (oref-default eitest-a water)))
;; oset-default -> oref/oref-default comparison
(oset-default (eieio-object-class eitest-a) water 'moose)
(should (eq (oref eitest-a water) (oref-default eitest-a water)))
;; oset-default -> oref/oref-default comparison
(oset-default (eieio-object-class eitest-a) water 'moose)
(should (eq (oref eitest-a water) (oref-default eitest-a water)))
;; After setting 'water to 'moose, make sure a new object has
;; the right stuff.
(oset-default (eieio-object-class eitest-a) water 'penguin)
(should (eq (oref (class-a) water) 'penguin))
;; After setting 'water to 'moose, make sure a new object has
;; the right stuff.
(oset-default (eieio-object-class eitest-a) water 'penguin)
(should (eq (oref (class-a) water) 'penguin))
;; Revert the above
(defmethod slot-unbound ((a class-a) &rest foo)
"If a slot in A is unbound, ignore FOO."
;; Disable the old slot-unbound so we can run this test
;; more than once
(call-next-method)))
;; Revert the above
(defmethod slot-unbound ((_a class-a) &rest _foo)
"If a slot in A is unbound, ignore FOO."
;; Disable the old slot-unbound so we can run this test
;; more than once
(with-suppressed-warnings ((obsolete call-next-method))
(call-next-method)))))
(ert-deftest eieio-test-19-slot-type-checking ()
;; Slot type checking
@ -617,12 +642,14 @@ METHOD is the method that was attempting to be called."
()
"Protection testing baseclass.")
(defmethod prot0-slot-2 ((s2 prot-0))
"Try to access slot-2 from this class which doesn't have it.
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod prot0-slot-2 ((s2 prot-0))
"Try to access slot-2 from this class which doesn't have it.
The object S2 passed in will be of class prot-1, which does have
the slot. This could be allowed, and currently is in EIEIO.
Needed by the eieio persistent base class."
(oref s2 slot-2))
(oref s2 slot-2)))
(defclass prot-1 (prot-0)
((slot-1 :initarg :slot-1
@ -640,26 +667,28 @@ Needed by the eieio persistent base class."
nil
"A class for testing the :protection option.")
(defmethod prot1-slot-2 ((s2 prot-1))
"Try to access slot-2 in S2."
(oref s2 slot-2))
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod prot1-slot-2 ((s2 prot-1))
"Try to access slot-2 in S2."
(oref s2 slot-2))
(defmethod prot1-slot-2 ((s2 prot-2))
"Try to access slot-2 in S2."
(oref s2 slot-2))
(defmethod prot1-slot-2 ((s2 prot-2))
"Try to access slot-2 in S2."
(oref s2 slot-2))
(defmethod prot1-slot-3-only ((s2 prot-1))
"Try to access slot-3 in S2.
(defmethod prot1-slot-3-only ((s2 prot-1))
"Try to access slot-3 in S2.
Do not override for `prot-2'."
(oref s2 slot-3))
(oref s2 slot-3))
(defmethod prot1-slot-3 ((s2 prot-1))
"Try to access slot-3 in S2."
(oref s2 slot-3))
(defmethod prot1-slot-3 ((s2 prot-1))
"Try to access slot-3 in S2."
(oref s2 slot-3))
(defmethod prot1-slot-3 ((s2 prot-2))
"Try to access slot-3 in S2."
(oref s2 slot-3))
(defmethod prot1-slot-3 ((s2 prot-2))
"Try to access slot-3 in S2."
(oref s2 slot-3)))
(defvar eitest-p1 nil)
(defvar eitest-p2 nil)
@ -914,8 +943,10 @@ Subclasses to override slot attributes.")
(defclass eieio--testing () ())
(defmethod constructor :static ((_x eieio--testing) newname &rest _args)
(list newname 2))
(with-suppressed-warnings ((obsolete defmethod)
(obsolete defgeneric))
(defmethod constructor :static ((_x eieio--testing) newname &rest _args)
(list newname 2)))
(ert-deftest eieio-test-37-obsolete-name-in-constructor ()
;; FIXME repeated intermittent failures on hydra and elsewhere (bug#24503).
@ -971,7 +1002,7 @@ Subclasses to override slot attributes.")
;;;; Interaction with defstruct
(cl-defstruct eieio-test--struct a b c)
(cl-defstruct eieio-test--struct a b (c nil :read-only t))
(ert-deftest eieio-test-defstruct-slot-value ()
(let ((x (make-eieio-test--struct :a 'A :b 'B :c 'C)))
@ -980,7 +1011,10 @@ Subclasses to override slot attributes.")
(should (eq (eieio-test--struct-b x)
(slot-value x 'b)))
(should (eq (eieio-test--struct-c x)
(slot-value x 'c)))))
(slot-value x 'c)))
(setf (slot-value x 'a) 1)
(should (eq (eieio-test--struct-a x) 1))
(should-error (setf (slot-value x 'c) 3) :type 'eieio-read-only)))
(provide 'eieio-tests)

9
test/lisp/emacs-lisp/generator-tests.el
View file

@ -74,7 +74,7 @@ identical output."
(cps-testcase cps-prog1-b (prog1 1))
(cps-testcase cps-prog1-c (prog2 1 2 3))
(cps-testcase cps-quote (progn 'hello))
(cps-testcase cps-function (progn #'hello))
(cps-testcase cps-function (progn #'message))
(cps-testcase cps-and-fail (and 1 nil 2))
(cps-testcase cps-and-succeed (and 1 2 3))
@ -85,9 +85,9 @@ identical output."
(cps-testcase cps-or-empty (or))
(cps-testcase cps-let* (let* ((i 10)) i))
(cps-testcase cps-let*-shadow-empty (let* ((i 10)) (let (i) i)))
(cps-testcase cps-let*-shadow-empty (let* ((i 10)) i (let ((i nil)) i)))
(cps-testcase cps-let (let ((i 10)) i))
(cps-testcase cps-let-shadow-empty (let ((i 10)) (let (i) i)))
(cps-testcase cps-let-shadow-empty (let ((i 10)) i (let ((i nil)) i)))
(cps-testcase cps-let-novars (let nil 42))
(cps-testcase cps-let*-novars (let* nil 42))
@ -95,7 +95,7 @@ identical output."
(let ((a 5) (b 6)) (let ((a b) (b a)) (list a b))))
(cps-testcase cps-let*-parallel
(let* ((a 5) (b 6)) (let* ((a b) (b a)) (list a b))))
(let* ((a 5) (b 6)) a (let* ((a b) (b a)) (list a b))))
(cps-testcase cps-while-dynamic
(setq *cps-test-i* 0)
@ -307,6 +307,7 @@ identical output."
(1+ it)))))))
-2)))
(defun generator-tests-edebug ()) ; silence byte-compiler
(ert-deftest generator-tests-edebug ()
"Check that Bug#40434 is fixed."
(with-temp-buffer

1
test/lisp/emacs-lisp/lisp-tests.el
View file

@ -213,6 +213,7 @@
(should-error (forward-sexp)))) ;; FIXME: Shouldn't be an error.
;; Test some core Elisp rules.
(defvar c-e-x)
(ert-deftest core-elisp-tests-1-defvar-in-let ()
"Test some core Elisp rules."
(with-temp-buffer

22
test/lisp/emacs-lisp/seq-tests.el
View file

@ -173,16 +173,18 @@ Evaluate BODY for each created sequence.
(should (seq-find #'null '(1 2 3) 'sentinel)))
(ert-deftest test-seq-contains ()
(with-test-sequences (seq '(3 4 5 6))
(should (seq-contains seq 3))
(should-not (seq-contains seq 7)))
(with-test-sequences (seq '())
(should-not (seq-contains seq 3))
(should-not (seq-contains seq nil))))
(with-suppressed-warnings ((obsolete seq-contains))
(with-test-sequences (seq '(3 4 5 6))
(should (seq-contains seq 3))
(should-not (seq-contains seq 7)))
(with-test-sequences (seq '())
(should-not (seq-contains seq 3))
(should-not (seq-contains seq nil)))))
(ert-deftest test-seq-contains-should-return-the-elt ()
(with-test-sequences (seq '(3 4 5 6))
(should (= 5 (seq-contains seq 5)))))
(with-suppressed-warnings ((obsolete seq-contains))
(with-test-sequences (seq '(3 4 5 6))
(should (= 5 (seq-contains seq 5))))))
(ert-deftest test-seq-contains-p ()
(with-test-sequences (seq '(3 4 5 6))
@ -404,7 +406,7 @@ Evaluate BODY for each created sequence.
(let ((seq '(1 (2 (3 (4))))))
(seq-let (_ (_ (_ (a)))) seq
(should (= a 4))))
(let (seq)
(let ((seq nil))
(seq-let (a b c) seq
(should (null a))
(should (null b))
@ -428,7 +430,7 @@ Evaluate BODY for each created sequence.
(seq '(1 (2 (3 (4))))))
(seq-setq (_ (_ (_ (a)))) seq)
(should (= a 4)))
(let (seq a b c)
(let ((seq nil) a b c)
(seq-setq (a b c) seq)
(should (null a))
(should (null b))

26
test/lisp/emacs-lisp/subr-x-tests.el
View file

@ -169,13 +169,13 @@
"no")
"no"))
(should (equal
(let (z)
(let ((z nil))
(if-let* (z (a 1) (b 2) (c 3))
"yes"
"no"))
"no"))
(should (equal
(let (d)
(let ((d nil))
(if-let* ((a 1) (b 2) (c 3) d)
"yes"
"no"))
@ -191,7 +191,7 @@
(ert-deftest subr-x-test-if-let*-and-laziness-is-preserved ()
"Test `if-let' respects `and' laziness."
(let (a-called b-called c-called)
(let ((a-called nil) (b-called nil) c-called)
(should (equal
(if-let* ((a nil)
(b (setq b-called t))
@ -199,7 +199,7 @@
"yes"
(list a-called b-called c-called))
(list nil nil nil))))
(let (a-called b-called c-called)
(let ((a-called nil) (b-called nil) c-called)
(should (equal
(if-let* ((a (setq a-called t))
(b nil)
@ -207,12 +207,12 @@
"yes"
(list a-called b-called c-called))
(list t nil nil))))
(let (a-called b-called c-called)
(let ((a-called nil) (b-called nil) c-called)
(should (equal
(if-let* ((a (setq a-called t))
(b (setq b-called t))
(c nil)
(d (setq c-called t)))
(b (setq b-called t))
(c nil)
(d (setq c-called t)))
"yes"
(list a-called b-called c-called))
(list t t nil)))))
@ -329,12 +329,12 @@
"no")
nil))
(should (equal
(let (z)
(let ((z nil))
(when-let* (z (a 1) (b 2) (c 3))
"no"))
nil))
(should (equal
(let (d)
(let ((d nil))
(when-let* ((a 1) (b 2) (c 3) d)
"no"))
nil)))
@ -348,7 +348,7 @@
(ert-deftest subr-x-test-when-let*-and-laziness-is-preserved ()
"Test `when-let' respects `and' laziness."
(let (a-called b-called c-called)
(let ((a-called nil) (b-called nil) (c-called nil))
(should (equal
(progn
(when-let* ((a nil)
@ -357,7 +357,7 @@
"yes")
(list a-called b-called c-called))
(list nil nil nil))))
(let (a-called b-called c-called)
(let ((a-called nil) (b-called nil) (c-called nil))
(should (equal
(progn
(when-let* ((a (setq a-called t))
@ -366,7 +366,7 @@
"yes")
(list a-called b-called c-called))
(list t nil nil))))
(let (a-called b-called c-called)
(let ((a-called nil) (b-called nil) (c-called nil))
(should (equal
(progn
(when-let* ((a (setq a-called t))

3
test/lisp/emacs-lisp/timer-tests.el
View file

@ -37,7 +37,8 @@
(ert-deftest timer-tests-debug-timer-check ()
;; This function exists only if --enable-checking.
(skip-unless (fboundp 'debug-timer-check))
(should (debug-timer-check)))
(when (fboundp 'debug-timer-check) ; silence byte-compiler
(should (debug-timer-check))))
(ert-deftest timer-test-multiple-of-time ()
(should (time-equal-p

4
test/lisp/format-spec-tests.el
View file

@ -56,7 +56,7 @@
(ert-deftest format-spec-do-flags-truncate ()
"Test `format-spec--do-flags' truncation."
(let (flags)
(let ((flags nil))
(should (equal (format-spec--do-flags "" flags nil 0) ""))
(should (equal (format-spec--do-flags "" flags nil 1) ""))
(should (equal (format-spec--do-flags "a" flags nil 0) ""))
@ -75,7 +75,7 @@
(ert-deftest format-spec-do-flags-pad ()
"Test `format-spec--do-flags' padding."
(let (flags)
(let ((flags nil))
(should (equal (format-spec--do-flags "" flags 0 nil) ""))
(should (equal (format-spec--do-flags "" flags 1 nil) " "))
(should (equal (format-spec--do-flags "a" flags 0 nil) "a"))

3
test/lisp/ls-lisp-tests.el
View file

@ -54,7 +54,8 @@
(kill-buffer buf)
(setq buf (dired (nconc (list dir) files)))
(should (looking-at "src"))
(next-line) ; File names must be aligned.
(with-suppressed-warnings ((interactive-only next-line))
(next-line)) ; File names must be aligned.
(should (looking-at "src")))
(when (buffer-live-p buf) (kill-buffer buf)))))

9
test/lisp/obsolete/cl-tests.el
View file

@ -25,12 +25,11 @@
(require 'cl))
(require 'ert)
(ert-deftest labels-function-quoting ()
"Test that #'foo does the right thing in `labels'." ; Bug#31792.
(should (eq (funcall (labels ((foo () t))
#'foo))
t)))
(with-suppressed-warnings ((obsolete labels))
(should (eq (funcall (labels ((foo () t))
#'foo))
t))))
;;; cl-tests.el ends here

18
test/lisp/progmodes/elisp-mode-tests.el
View file

@ -438,7 +438,8 @@ to (xref-elisp-test-descr-to-target xref)."
;; track down the problem.
(cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type) arg2)
"Doc string generic no-default xref-elisp-root-type."
"non-default for no-default")
"non-default for no-default"
(list this arg2)) ; silence byte-compiler
;; defgeneric after defmethod in file to ensure the fallback search
;; method of just looking for the function name will fail.
@ -463,19 +464,23 @@ to (xref-elisp-test-descr-to-target xref)."
(cl-defmethod xref-elisp-generic-separate-default (arg1 arg2)
"Doc string generic separate-default default."
"separate default")
"separate default"
(list arg1 arg2)) ; silence byte-compiler
(cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type) arg2)
"Doc string generic separate-default xref-elisp-root-type."
"non-default for separate-default")
"non-default for separate-default"
(list this arg2)) ; silence byte-compiler
(cl-defmethod xref-elisp-generic-implicit-generic (arg1 arg2)
"Doc string generic implicit-generic default."
"default for implicit generic")
"default for implicit generic"
(list arg1 arg2)) ; silence byte-compiler
(cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type) arg2)
"Doc string generic implicit-generic xref-elisp-root-type."
"non-default for implicit generic")
"non-default for implicit generic"
(list this arg2)) ; silence byte-compiler
(xref-elisp-deftest find-defs-defgeneric-no-methods
@ -845,7 +850,8 @@ to (xref-elisp-test-descr-to-target xref)."
(if (stringp form)
(insert form)
(pp form (current-buffer)))
(font-lock-debug-fontify)
(with-suppressed-warnings ((interactive-only font-lock-debug-fontify))
(font-lock-debug-fontify))
(goto-char (point-min))
(and (re-search-forward search nil t)
(get-text-property (match-beginning 1) 'face))))

11
test/lisp/replace-tests.el
View file

@ -599,11 +599,12 @@ bound to HIGHLIGHT-LOCUS."
(with-temp-buffer
(insert before)
(goto-char (point-min))
(replace-regexp
"\\(\\(L\\)\\|\\(R\\)\\)"
'(replace-eval-replacement
replace-quote
(if (match-string 2) "R" "L")))
(with-suppressed-warnings ((interactive-only replace-regexp))
(replace-regexp
"\\(\\(L\\)\\|\\(R\\)\\)"
'(replace-eval-replacement
replace-quote
(if (match-string 2) "R" "L"))))
(should (equal (buffer-string) after)))))
(ert-deftest test-count-matches ()

4
test/lisp/ses-tests.el
View file

@ -24,6 +24,10 @@
(require 'ert)
(require 'ses)
;; Silence byte-compiler.
(with-suppressed-warnings ((lexical A2) (lexical A3))
(defvar A2)
(defvar A3))
;; PLAIN FORMULA TESTS
;; ======================================================================

1
test/lisp/subr-tests.el
View file

@ -926,6 +926,7 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
(should-not (apropos-internal "^next-line$" #'keymapp)))
(defvar test-global-boundp)
(ert-deftest test-buffer-local-boundp ()
(let ((buf (generate-new-buffer "boundp")))
(with-current-buffer buf

3
test/lisp/tar-mode-tests.el
View file

@ -32,7 +32,8 @@
(cons 1024 "-----S---")
(cons 2048 "--S------"))))
(dolist (x alist)
(should (equal (cdr x) (tar-grind-file-mode (car x)))))))
(with-suppressed-warnings ((obsolete tar-grind-file-mode))
(should (equal (cdr x) (tar-grind-file-mode (car x))))))))
(ert-deftest tar-mode-test-tar-extract-gz ()
(skip-unless (executable-find "gzip"))

41
test/src/data-tests.el
View file

@ -433,26 +433,27 @@ comparing the subr with a much slower Lisp implementation."
;; More specifically, test the problem seen in bug#41029 where setting
;; the default value of a variable takes time proportional to the
;; number of buffers.
(let* ((fun #'error)
(test (lambda ()
(with-temp-buffer
(let ((st (car (current-cpu-time))))
(dotimes (_ 1000)
(let ((case-fold-search 'data-test))
;; Use an indirection through a mutable var
;; to try and make sure the byte-compiler
;; doesn't optimize away the let bindings.
(funcall fun)))
;; FIXME: Handle the wraparound, if any.
(- (car (current-cpu-time)) st)))))
(_ (setq fun #'ignore))
(time1 (funcall test))
(bufs (mapcar (lambda (_) (generate-new-buffer " data-test"))
(make-list 1000 nil)))
(time2 (funcall test)))
(mapc #'kill-buffer bufs)
;; Don't divide one time by the other since they may be 0.
(should (< time2 (* time1 5)))))
(when (fboundp 'current-cpu-time) ; silence byte-compiler
(let* ((fun #'error)
(test (lambda ()
(with-temp-buffer
(let ((st (car (current-cpu-time))))
(dotimes (_ 1000)
(let ((case-fold-search 'data-test))
;; Use an indirection through a mutable var
;; to try and make sure the byte-compiler
;; doesn't optimize away the let bindings.
(funcall fun)))
;; FIXME: Handle the wraparound, if any.
(- (car (current-cpu-time)) st)))))
(_ (setq fun #'ignore))
(time1 (funcall test))
(bufs (mapcar (lambda (_) (generate-new-buffer " data-test"))
(make-list 1000 nil)))
(time2 (funcall test)))
(mapc #'kill-buffer bufs)
;; Don't divide one time by the other since they may be 0.
(should (< time2 (* time1 5))))))
;; More tests to write -
;; kill-local-variable

2
test/src/search-tests.el
View file

@ -28,7 +28,7 @@
(setq ov-set (make-overlay 3 5))
(overlay-put
ov-set 'modification-hooks
(list (lambda (o after &rest _args)
(list (lambda (_o after &rest _args)
(when after
(let ((inhibit-modification-hooks t))
(save-excursion