diff --git a/.dir-locals.el b/.dir-locals.el index d9ccf82b166..b1123032443 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -22,11 +22,19 @@ ;; (vc-topic-branch-regexps . ("\\`feature/")) )) (c-mode . ((c-file-style . "GNU") - (c-noise-macro-names . ("INLINE" "NO_INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" - "ATTRIBUTE_NO_SANITIZE_ADDRESS" - "UNINIT" "CALLBACK" "ALIGN_STACK" "ATTRIBUTE_MALLOC" - "ATTRIBUTE_DEALLOC_FREE" "ANDROID_EXPORT" "TEST_STATIC" - "INLINE_HEADER_BEGIN" "INLINE_HEADER_END")) + (c-noise-macro-names + "ALIGN_STACK" "ATTRIBUTE_COLD" "ATTRIBUTE_CONST" + "ATTRIBUTE_DEALLOC_FREE" "ATTRIBUTE_MALLOC" "ATTRIBUTE_MAY_ALIAS" + "ATTRIBUTE_NO_SANITIZE_ADDRESS" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" + "ATTRIBUTE_NONSTRING" "ATTRIBUTE_RETURNS_NONNULL" + "CALLBACK" "EXTERNALLY_VISIBLE" + "INLINE" "INLINE_HEADER_BEGIN" "INLINE_HEADER_END" "NO_INLINE" + "MAYBE_UNUSED" "NODISCARD" "TEST_STATIC" "UNINIT") + (c-noise-macro-with-parens-names + "ARG_NONNULL" "ATTRIBUTE_ALLOC_SIZE" + "ATTRIBUTE_DEALLOC" "ATTRIBUTE_FORMAT_PRINTF" + "ATTRIBUTE_MALLOC_SIZE" "ATTRIBUTE_SECTION" + "EMACS_ATTRIBUTE_NONNULL") (electric-quote-comment . nil) (electric-quote-string . nil) (indent-tabs-mode . t) diff --git a/Makefile.in b/Makefile.in index f0e9e07def4..1a0d3bdac24 100644 --- a/Makefile.in +++ b/Makefile.in @@ -342,7 +342,7 @@ SUBDIR_MAKEFILES = $(patsubst ${srcdir}/%,%,${SUBDIR_MAKEFILES_IN:.in=}) # Non-makefile files created by config.status. CONFIG_STATUS_FILES_IN = \ ${srcdir}/nt/emacs.rc.in ${srcdir}/nt/emacsclient.rc.in \ - ${srcdir}/doc/man/emacs.1.in ${srcdir}/src/emacs-module.h.in \ + ${srcdir}/doc/man/emacs.1.in ${srcdir}/src/emacs-module.in.h \ ${srcdir}/src/module-env-*.h # Subdirectories to install, and where they'll go. lib-src's and nt's @@ -646,7 +646,7 @@ endif ### Windows-specific install target for installing programs produced ### in nt/, and its Posix do-nothing shadow. install-: -install-nt: +install-nt: | $(NTDIR) $(MAKE) -C $(NTDIR) install ## In the share directory, we are deleting: diff --git a/admin/authors.el b/admin/authors.el index 516182a8801..7a1a350beaa 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -1505,6 +1505,8 @@ in the repository.") ;; module.* moved to emacs-module.* ("src/module.h" . "emacs-module.h") ("src/module.c" . "emacs-module.c") + ;; Renamed from .h.in to .in.h. + ("src/emacs-module.h.in" . "emacs-module.in.h") ("test/src/regex-tests.el" . "regex-emacs-tests.el") ("test/lisp/emacs-lisp/cl-tests.el" . "cl-tests.el") ("url-ns.el" . "url-ns.el") diff --git a/admin/release-branch.txt b/admin/release-branch.txt index b59bc12dfb9..0897a83e017 100644 --- a/admin/release-branch.txt +++ b/admin/release-branch.txt @@ -60,7 +60,7 @@ Instructions for cutting the Emacs release branch AC_SUBST_FILE([module_env_snippet_XY+1]) module_env_snippet_XY+1="$srcdir/src/module-env-XY+1.h" - . adding a new 'struct emacs_env_XY+1' to src/emacs-module.h.in, + . adding a new 'struct emacs_env_XY+1' to src/emacs-module.in.h, with the contents identical to 'struct emacs_env_XY', with one line added: diff --git a/build-aux/git-hooks/pre-commit b/build-aux/git-hooks/pre-commit index cc30f0d83b4..79e987290d4 100755 --- a/build-aux/git-hooks/pre-commit +++ b/build-aux/git-hooks/pre-commit @@ -84,10 +84,12 @@ fi # The '--check' option of git diff-index makes Git complain if changes # introduce whitespace errors. This can be a pain when editing test -# files that deliberately contain lines with trailing whitespace. -# To work around the problem you can run a command like 'git config -# core.whitespace -trailing-space'. It may be better to revamp the -# tests so that trailing spaces are generated on the fly rather than +# files that deliberately flout the normal whitespace rules. +# To work around the problem, set EMACS_GIT_CORE_WHITESPACE temporarily +# in your environment. For example, set it to '-blank-at-eol' to commit +# a test with blanks at line end. It may be better to revamp the +# tests so that offending lines are generated on the fly rather than # being committed as source. -exec git diff-index --check --cached $head -- +exec git -c core.whitespace="$EMACS_GIT_CORE_WHITESPACE" \ + diff-index --check --cached $head -- diff --git a/configure.ac b/configure.ac index 9f8fb50bf41..b3276753cdb 100644 --- a/configure.ac +++ b/configure.ac @@ -5112,7 +5112,7 @@ AC_SUBST([HAVE_MODULES]) AC_SUBST([MODULES_SUFFIX]) AC_SUBST([MODULES_SECONDARY_SUFFIX]) -ARCH_INDEPENDENT_CONFIG_FILES([src/emacs-module.h]) +ARCH_INDEPENDENT_CONFIG_FILES([src/emacs-module.h:src/emacs-module.in.h]) AC_SUBST_FILE([module_env_snippet_25]) AC_SUBST_FILE([module_env_snippet_26]) AC_SUBST_FILE([module_env_snippet_27]) diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 2de147a204c..bf137ef946b 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -3245,6 +3245,11 @@ persistently. This can be changed by customizing the user option @node Newcomers Theme @section Newcomers Theme +@ifinfo + (If you got here by clicking a link on the startup screen, you can +type @kbd{q} to go back.) +@end ifinfo + Each release of Emacs brings new features, but they are not enabled by default to avoid disrupting users' existing workflows. Many of these features, however, are intended to make Emacs more approachable to new @@ -3261,6 +3266,3 @@ Therefore, if you get used to the newcomers' presets, consider copying them into your own configuration and then disabling the theme again. You can use the command @code{copy-theme-options} (@pxref{Custom Themes}) to do this. - - (If you got here by clicking a link on the startup screen, type -@kbd{q} to go back.) diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 57d3babef41..7cf7b2ff96f 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -1688,6 +1688,13 @@ row). Just what constitutes a block depends on the major mode. In C mode and related modes, blocks are delimited by braces, while in Lisp mode they are delimited by parentheses. Multi-line comments also count as blocks. + +Additionally, Hideshow mode supports optional indentation-based +hiding/showing. By default this is disabled; to enable it, turn on the +buffer-local minor mode @code{hs-indentation-mode}. Enabling +@code{hs-indentation-mode} does not require that @code{hs-minor-mode} is +already enabled. + @vindex hs-prefix-map Hideshow mode provides the following commands (defined in @code{hs-prefix-map}): @@ -1743,6 +1750,7 @@ Either hide or show all the blocks in the current buffer. (@code{hs-toggle-all}) @vindex hs-isearch-open @vindex hs-hide-block-behavior @vindex hs-cycle-filter +@vindex hs-indentation-respect-end-block These variables can be used to customize Hideshow mode: @table @code @@ -1751,10 +1759,11 @@ If non-@code{nil}, @code{hs-hide-all}, @code{hs-cycle} and @code{hs-hide-level} hide comments too. @item hs-hide-block-behavior -This variable controls how @code{hs-hide-block} and -@code{hs-toggle-hiding} should hide a block. The possible values can be -'after-bol', hide the innermost block to which the current line belongs; -or 'after-cursor', hide the block after cursor position. +This variable controls how @code{hs-hide-block}, @code{hs-cycle}, +@code{hs-hide-level}, and @code{hs-toggle-hiding} should hide a block. +The possible values can be 'after-bol', hide the innermost block to +which the current line belongs; or 'after-cursor', hide the block after +cursor position. @item hs-display-lines-hidden If non-@code{nil}, display the number of hidden lines next to the @@ -1795,6 +1804,11 @@ block. Its value should be either @code{code} (unhide only code blocks), @code{comment} (unhide only comments), @code{t} (unhide both code blocks and comments), or @code{nil} (unhide neither code blocks nor comments). The default value is @code{code}. + +@item hs-indentation-respect-end-block +This variable controls whether the end of the block should be hidden +together with the hidden region. This only has effect if +@code{hs-indentation-mode} is enabled. @end table @node Symbol Completion diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index f6fa65b9e3d..1497a9906bd 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -12826,7 +12826,7 @@ of the pattern. Specifically, @code{parsep} is set to the original value of the paragraph separate regular expression concatenated with an alternative expression that consists of the @code{fill-prefix-regexp} followed by -optional whitespace to the end of the line. The whitespace is defined +optional whitespace to the end of the line. (The whitespace is defined by @w{@code{"[ \t]*$"}}.) The @samp{\\|} defines this portion of the regexp as an alternative to @code{parsep}. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index a7d605cf0a0..d3662f727cc 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -2447,12 +2447,13 @@ as the overall value. The argument @var{var} is a variable. @code{condition-case} does not bind this variable when executing the @var{protected-form}, only when it handles an error. At that time, it binds @var{var} locally to an -@dfn{error description}, which is a list giving the particulars of the -error. The error description has the form @code{(@var{error-symbol} +@dfn{error descriptor}, also sometimes called error description, +which is a list giving the particulars of the error. +The error descriptor has the form @code{(@var{error-symbol} . @var{data})}. The handler can refer to this list to decide what to do. For example, if the error is for failure opening a file, the file name is the second element of @var{data}---the third element of the -error description. +error descriptor. If @var{var} is @code{nil}, that means no variable is bound. Then the error symbol and associated data are not available to the handler. @@ -2469,15 +2470,27 @@ Sometimes it is necessary to re-throw a signal caught by how to do that: @example - (signal (car err) (cdr err)) + (signal err) @end example @noindent -where @code{err} is the error description variable, the first argument +where @code{err} is the error descriptor variable, the first argument to @code{condition-case} whose error condition you want to re-throw. @xref{Definition of signal}. @end defspec +@defun error-type error +This function returns the error symbol of the error descriptor @var{error}. +@end defun + +@defun error-slot-value error pos +This function returns the value in the field number @var{pos} of the error +descriptor @var{error}. The fields are numbered starting with 1. E.g., +for an error of type @code{wrong-type-argument}, @code{(error-slot-value +@var{error} 2)} returns the object that failed the type test, and +@code{(error-slot-value @var{error} 1)} returns the predicate that failed. +@end defun + @defun error-message-string error-descriptor This function returns the error message string for a given error descriptor. It is useful if you want to handle an error by printing the @@ -2615,7 +2628,7 @@ Emacs searches all the active @code{condition-case} and specifies one or more of these condition names. When the innermost matching handler is one installed by @code{handler-bind}, the @var{handler} function is called with a single argument holding the -error description. +error descriptor. Contrary to what happens with @code{condition-case}, @var{handler} is called in the dynamic context where the error happened. This means it @@ -2799,6 +2812,18 @@ make it possible to categorize errors at various levels of generality when you write an error handler. Using error symbols alone would eliminate all but the narrowest level of classification. +@defun error-type-p symbol +This function returns non-@code{nil} if @var{symbol} is a valid +error condition name. +@end defun + +@defun error-has-type-p error condition +This function tests whether @var{condition} is a parent of the error +symbol of the error descriptor @var{error}. +It returns non-@code{nil} if the type of the error descriptor +@var{error} belongs to the condition name @var{condition}. +@end defun + @xref{Standard Errors}, for a list of the main error symbols and their conditions. diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index e1bba484708..e1591c66130 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -830,6 +830,26 @@ list, and you can then say, for instance: @end lisp @end defun +@defun ensure-proper-list object +This function returns @var{object} as a proper list (@pxref{(elisp) Cons +Cells}). If @var{object} is already a proper list, the function returns +it; otherwise, the function returns a one-element list containing +@var{object}. + +If @var{object} might be a long list, prefer @code{ensure-list}, because +the latter function runs in constant time, whereas +@code{ensure-proper-list} runs in linear time. For short lists this +function is a convenient way to treat cons-cells as non-lists: + +@lisp +(ensure-list '(1 . 2)) + @result{}(1 . 2) + +(ensure-proper-list '(1 . 2)) + @result{}((1 . 2)) +@end lisp +@end defun + @defun number-sequence from &optional to separation This function returns a list of numbers starting with @var{from} and incrementing by @var{separation}, and ending at or just before @@ -1976,11 +1996,15 @@ through a simple example: @result{} white @end lisp -The @var{body} is inspected at compilation time, and only the symbols -that appear in @var{body} with a @samp{.} as the first character in +The @var{body} is inspected during macro-expansion, and the symbols that +appear literally in @var{body} with a @samp{.} as the first character in the symbol name will be bound. Finding the keys is done with -@code{assq}, and the @code{cdr} of the return value of this -@code{assq} is assigned as the value for the binding. +@code{assq}, and the @code{cdr} of the return value of this @code{assq} +is assigned as the value for the binding. The generated code performs +all @var{alist} lookups before any other part of @var{body}, so a symbol +@code{.foo} that appears anywhere in body will be looked up (using key +@code{foo}) and bound whether or not it is actually used in @var{body} +at runtime. Nested association lists is supported: @@ -2006,7 +2030,7 @@ Indexing into lists is also supported: Note that forms like @samp{.0} or @samp{.3} are interpreted as numbers rather than as symbols, so they won't be bound to the corresponding -values in ALIST. +values in @var{alist}. @end defmac diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index e89b28eb0c0..abb2c883f78 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -402,6 +402,10 @@ values even if their symbols' value cells are unassigned. This function empties out the value cell of @var{symbol}, making the variable void. It returns @var{symbol}. +When applied to a variable alias (@pxref{Variable Aliases}), it first +disconnects the variable from its alias, thereby undoing the effect of +@code{defvaralias}. + If @var{symbol} has a dynamic local binding, @code{makunbound} voids the current binding, and this voidness lasts only as long as the local binding is in effect. Afterwards, the previously shadowed local or diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index d804c34250f..007aee73cdf 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -704,10 +704,10 @@ in the group). Emacs provides miscellaneous functions for finding the height and width of a window. The return value of many of these functions can be -specified either in units of pixels or in units of lines and columns. -On a graphical display, the latter actually correspond to the height and -width of a default character specified by the frame's default font as -returned by @code{frame-char-height} and @code{frame-char-width} +specified either in units of pixels or in units of canonical lines and +columns. On a graphical display, the latter actually correspond to the +height and width of a default character specified by the frame's default +font as returned by @code{frame-char-height} and @code{frame-char-width} (@pxref{Frame Font}). Thus, if a window is displaying text with a different font or size, the reported line height and column width for that window may differ from the actual number of text lines or columns @@ -720,10 +720,10 @@ displayed within it. its body and its top and bottom decorations (@pxref{Basic Windows}). @defun window-total-height &optional window round -This function returns the total height, in lines, of the window -@var{window}. If @var{window} is omitted or @code{nil}, it defaults to -the selected window. If @var{window} is an internal window, the return -value is the total height occupied by its descendant windows. +This function returns the total height, in canonical lines, of the +window @var{window}. If @var{window} is omitted or @code{nil}, it +defaults to the selected window. If @var{window} is an internal window, +the return value is the total height occupied by its descendant windows. If a window's pixel height is not an integral multiple of its frame's default character height, the number of lines occupied by the window is @@ -736,9 +736,9 @@ vertically combined and has a next sibling, the topmost row of that sibling can be calculated as the sum of this window's topmost row and total height (@pxref{Coordinates and Windows}) - If the optional argument @var{round} is @code{ceiling}, this -function returns the smallest integer larger than @var{window}'s pixel -height divided by the character height of its frame; if it is + If the optional argument @var{round} is @code{ceiling}, this function +returns the smallest integer larger than @var{window}'s pixel height +divided by the canonical character height of its frame; if it is @code{floor}, it returns the largest integer smaller than said value; with any other @var{round} it returns the internal value of @var{windows}'s total height. @@ -751,19 +751,19 @@ The @dfn{total width} of a window is the number of columns comprising its body and its left and right decorations (@pxref{Basic Windows}). @defun window-total-width &optional window round -This function returns the total width, in columns, of the window -@var{window}. If @var{window} is omitted or @code{nil}, it defaults to -the selected window. If @var{window} is internal, the return value is -the total width occupied by its descendant windows. +This function returns the total width, in canonical columns, of the +window @var{window}. If @var{window} is omitted or @code{nil}, it +defaults to the selected window. If @var{window} is internal, the +return value is the total width occupied by its descendant windows. If a window's pixel width is not an integral multiple of its frame's -character width, the number of columns occupied by the window is rounded -internally. This is done in a way such that, if the window is a parent -window, the sum of the total widths of all its children internally -equals the total width of their parent. This means that although two -windows have the same pixel width, their internal total widths may -differ by one column. This means also, that if this window is -horizontally combined and has a next sibling, the leftmost column of +canonical character width, the number of columns occupied by the window +is rounded internally. This is done in a way such that, if the window +is a parent window, the sum of the total widths of all its children +internally equals the total width of their parent. This means that +although two windows have the same pixel width, their internal total +widths may differ by one column. This means also, that if this window +is horizontally combined and has a next sibling, the leftmost column of that sibling can be calculated as the sum of this window's leftmost column and total width (@pxref{Coordinates and Windows}). The optional argument @var{round} behaves as it does for @code{window-total-height}. @@ -835,17 +835,17 @@ does not include any of its top or bottom decorations (@pxref{Basic Windows}). @defun window-body-height &optional window pixelwise -This function returns the height, in lines, of the body of window -@var{window}. If @var{window} is omitted or @code{nil}, it defaults to -the selected window; otherwise it must be a live window. +This function returns the height, in canonical lines, of the body of +window @var{window}. If @var{window} is omitted or @code{nil}, it +defaults to the selected window; otherwise it must be a live window. The optional argument @var{pixelwise} defines the units to use for the height. If @code{nil}, return the body height of @var{window} in -characters, rounded down to the nearest integer, if necessary. This -means that if a line at the bottom of the text area is only partially -visible, that line is not counted. It also means that the height of a -window's body can never exceed its total height as returned by -@code{window-total-height}. +canonical characters, rounded down to the nearest integer, if necessary. +This means that if a line at the bottom of the text area is only +partially visible, that line is not counted. It also means that the +height of a window's body can never exceed its total height as returned +by @code{window-total-height}. If @var{pixelwise} is @code{remap} and the default face is remapped (@pxref{Face Remapping}), use the remapped face to determine the @@ -867,16 +867,16 @@ glyphs, which leaves 2 columns less for text display. (The function peculiarity into account.) @defun window-body-width &optional window pixelwise -This function returns the width, in columns, of the body of window -@var{window}. If @var{window} is omitted or @code{nil}, it defaults to -the selected window; otherwise it must be a live window. +This function returns the width, in canonical columns, of the body of +window @var{window}. If @var{window} is omitted or @code{nil}, it +defaults to the selected window; otherwise it must be a live window. The optional argument @var{pixelwise} defines the units to use for the width. If @code{nil}, return the body width of @var{window} in -characters, rounded down to the nearest integer, if necessary. This -means that if a column on the right of the text area is only partially -visible, that column is not counted. It also means that the width of -a window's body can never exceed its total width as returned by +canonical characters, rounded down to the nearest integer, if necessary. +This means that if a column on the right of the text area is only +partially visible, that column is not counted. It also means that the +width of a window's body can never exceed its total width as returned by @code{window-total-width}. If @var{pixelwise} is @code{remap} and the default face is remapped diff --git a/doc/misc/use-package.texi b/doc/misc/use-package.texi index 445030b7806..ce432b67f0e 100644 --- a/doc/misc/use-package.texi +++ b/doc/misc/use-package.texi @@ -1733,6 +1733,16 @@ that currently, you cannot upgrade built-in packages using @code{:vc}. For example, +@example +@group +(use-package bbdb + :vc "https://git.savannah.nongnu.org/git/bbdb.git") +@end group +@end example + +will check out the latest release commit using +@code{package-vc-install}, while + @example @group (use-package bbdb @@ -1741,8 +1751,8 @@ For example, @end group @end example -would try -- by invoking @code{package-vc-install} -- to install the -latest commit of the package @code{foo} from the specified remote. +would try to install the latest commit of the package @code{foo} from +the specified remote. @vindex use-package-vc-prefer-newest Alternatively, the @code{use-package-vc-prefer-newest} user option diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi index 7787493c992..8fc28499d30 100644 --- a/doc/misc/vtable.texi +++ b/doc/misc/vtable.texi @@ -461,10 +461,10 @@ The table is first sorted by the first element in this list, and then the next, until the end is reached. @item :ellipsis -By default, when shortening displayed values, an ellipsis will be -shown. If this is @code{nil}, no ellipsis is shown. (The text to use -as the ellipsis is determined by the @code{truncate-string-ellipsis} -function.) +Displayed values are shortened to fit column widths. This defaults to +@code{t} which shows an ellipsis using the text returned by the function +@code{truncate-string-ellipsis}. Set this to a string to use your own +ellipsis text. Set this to @code{nil} to inhibit the ellipsis. @findex vtable-insert @item :insert diff --git a/etc/NEWS b/etc/NEWS index 6e57adcd052..053d2f0a2a2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -70,14 +70,14 @@ done from early-init.el, such as adding to 'package-directory-list'. +++ ** Emacs prepares a User Lisp directory by default. -If you have a directory named "user-lisp" in your Emacs configuration -directory, then the recursive contents will now be byte-compiled, -scraped for autoload cookies and ensured to be in 'load-path' by -default. You can disable the feature by setting 'user-lisp-auto-scrape' -to nil, or set the 'user-lisp-directory' user option to process any -other directory on your system. You can also invoke the -'prepare-user-lisp' command manually at any time. See the Info node -"(emacs) User Lisp Directory" for more details. +If you have a subdirectory "user-lisp/" in your Emacs configuration +directory, then Lisp files in it and its subdirectories will now be +recursively byte-compiled, scraped for autoload cookies and ensured to +be in 'load-path' by default. You can disable the feature by setting +'user-lisp-auto-scrape' to nil, or set the 'user-lisp-directory' user +option to process any other directory on your system. You can also +invoke the 'prepare-user-lisp' command manually at any time. See the +Info node "(emacs) User Lisp Directory" for more details. * Changes in Emacs 31.1 @@ -1021,7 +1021,7 @@ The duration for which the values are cached depends on whether it is called from 'non-essential' context, and it determined by variables 'project-vc-cache-timeout' and 'project-vc-non-essential-cache-timeout'. -** Network Security Manager (NSM) is now more strict. +** Network Security Manager (NSM) *** NSM warns about TLS 1.1 by default. It has been deprecated by RFC 8996, published in 2021. @@ -1351,11 +1351,13 @@ to customize the indicators appearance only if 'hs-indicator-type' is set to 'margin' or nil. +++ -*** New user option 'hs-hide-block-behavior'. -This user option controls how 'hs-hide-block' and 'hs-toggle-hiding' -should hide a block. If set to 'after-bol', hide the innermost block to -which the current line belongs. If set to 'after-cursor', hide the block -after cursor position. By default this is set to 'after-bol'. +*** The hiding behavior of some hideshow commands has changed. +'hs-hide-block', 'hs-hide-level', 'hs-cycle' and 'hs-toggle-hiding' now +hide the innermost block to which the current line belongs instead of +the block after cursor position. + +To restore the old behavior set the new user option +'hs-hide-block-behavior' to 'after-cursor'. +++ *** New user option 'hs-cycle-filter' for visibility-cycling with 'TAB'. @@ -1374,6 +1376,14 @@ buffer-local variables 'hs-block-start-regexp', 'hs-c-start-regexp', *** 'hs-hide-level' can now hide comments too. This is controlled by 'hs-hide-comments-when-hiding-all'. ++++ +*** New minor mode 'hs-indentation-mode'. +This buffer-local minor mode configures 'hs-indentation-mode' to detect +blocks based on indentation. + +The new user option 'hs-indentation-respect-end-block' can be used to +adjust the hiding range for this minor mode. + ** C-ts mode +++ @@ -3097,6 +3107,12 @@ tarballs and prepare them to be activated in the sub-process. +++ *** package-x.el is now obsolete. +--- +*** The command 'package-vc-install-from-checkout' is now obsolete. +Please use the User Lisp directory instead, see Info node "(emacs) User +Lisp Directory" for more details on how to use. This also means that +combining the 'use-package' keywords ':vc' and ':load-path' is obsolete. + --- *** Package menu now highlights packages marked for installation or deletion. @@ -3311,10 +3327,10 @@ This is intended for customizing directory-local variables in the current directory's ".dir-locals.el" file. +++ -*** New keybinding 'C-c C-k' for 'Custom-reset-standard' +*** New keybinding 'C-c C-k' for 'Custom-reset-standard'. +++ -*** New command 'Custom-goto-first-choice' (bound to 'C-c C-i') +*** New command 'Custom-goto-first-choice' (bound to 'C-c C-i'). When first opening the customization interface for a user option, you can use this command as a shortcut to jump to the first actionable button or field (for instance an on/off button for boolean options, or a @@ -3758,6 +3774,14 @@ the mode line without polling for changes every means the mode line will update only when the battery power state, percentage, or presence in the bay changes. +** Etags Regen mode + +*** Tags table is not created during completion anymore. +Previously, when there was no tags table loaded and the default +completion function was called, 'etags-regen-mode' ensured that tags +were created. This has been disabled, and the new user option +'etags-regen-create-on-completion' can be used to enable it again. + * New Modes and Packages in Emacs 31.1 @@ -3832,6 +3856,11 @@ all versions, sleep events require Windows 8 or later). * Incompatible Lisp Changes in Emacs 31.1 ++++ +** 'makunbound' on a variable alias undoes the alias. +Previously it had the effect of applying the 'makunbound' on the +target of the alias (which can fail on some builtin variables). + --- ** 'FOO-ts-mode-indent-offset' renamed to 'FOO-ts-indent-offset'. When the new TS modes were introduced, a mistake was made where those @@ -4030,6 +4059,14 @@ that will provide an Xref backend when used. * Lisp Changes in Emacs 31.1 ++++ +** The API to manipulate error descriptors has been improved. +There are new functions: 'error-type-p', 'error-type', +'error-has-type-p', and 'error-slot-value'. +And you can now do '(signal err)' instead of +'(signal (car err) (cdr err))', which is not only more concise +but also preserves the 'eq'uality of the error descriptor. + +++ ** 'secure-hash' now supports generating SHA-3 message digests. The list returned by 'secure-hash-algorithms' now contains the symbols @@ -4407,11 +4444,17 @@ current buffer, just like 'eval-expression' already did. +++ ** New function 'multiple-command-partition-arguments'. This function partitions a list of command arguments that might be -arbitrarily long. It can be used in cases in which it's known to be +arbitrarily long. It can be used in cases in which it is known to be safe to run the command multiple times on subsequent partitions of the list of arguments. The variable 'command-line-max-length' controls the partitioning. +** New function 'ensure-proper-list'. +This function is a variation on 'ensure-list' that checks if an object +is a proper list, in which case the list will be returned as is, +otherwise the function will return the object wrapped in a +singleton list. + * Changes in Emacs 31.1 on Non-Free Operating Systems diff --git a/etc/themes/newcomers-presets-theme.el b/etc/themes/newcomers-presets-theme.el index 542c424dec8..b14465d8e3f 100644 --- a/etc/themes/newcomers-presets-theme.el +++ b/etc/themes/newcomers-presets-theme.el @@ -150,7 +150,8 @@ This minor mode will enable and disable the theme on startup." '(package-autosuggest-mode t) '(package-menu-use-current-if-no-marks nil) -;;;; Frame and window-related options +;;;; Frame- and window-related options + '(frame-inhibit-implied-resize t) '(tab-bar-history-mode t) '(tab-bar-show 0)) diff --git a/lisp/bindings.el b/lisp/bindings.el index c0c2cf10996..b13dc0a705c 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -653,7 +653,23 @@ zero, otherwise they start from one." "Specification of \"percentage offset\" of window through buffer. This option specifies both the field width and the type of offset displayed in `mode-line-position', a component of the default -`mode-line-format'." +`mode-line-format'. +Since mode-line layout is a delicate matter, given the restricted +space Emacs has there, and given the hard-to-account-for length of +the percentage offsets produced by this element, we do not recommend +setting this to any value other than those described below (`setopt' +will show a warning if you try anything else): + + nil -- do not display percentage offset + \\='(-3 \"%o\") -- size of text above the window top as percentage of + text outside the window + \\='(-3 \"%p\") -- size of text above the window top as percentage of + all the buffer text + \\='(-3 \"%P\") -- size of text above the window bottom as percentage + of all the buffer text + \\='(6 \"%q\") -- percentage offsets of both top and bottom of the + window, separated by a dash +" :type '(radio (const :tag "nil: No offset is displayed" nil) (const :tag "\"%o\": Proportion of \"travel\" of the window through the buffer" diff --git a/lisp/bookmark.el b/lisp/bookmark.el index c75a8d33da3..1113144f87a 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1381,7 +1381,7 @@ then offer interactively to relocate BOOKMARK-NAME-OR-RECORD." (message "Bookmark not relocated; consider removing it (%s)." bookmark-name-or-record) - (signal (car err) (cdr err)))))))))) + (signal err))))))))) ;; Added by db. (when (stringp bookmark-name-or-record) (setq bookmark-current-bookmark bookmark-name-or-record)) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 6a23f860123..98bf1e4c2a4 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1688,7 +1688,7 @@ See calc-keypad for details." (error (substitute-command-keys "Computation got stuck or ran too long. Type \\`M' to increase the limit")) (setq calc-aborted-prefix nil) - (signal (car err) (cdr err))))) + (signal err)))) (when calc-aborted-prefix (calc-record "" calc-aborted-prefix)) (and calc-start-time diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index df8e28319e5..f12a51c3dc9 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -232,7 +232,7 @@ also calls `beep' for an audible reminder." time string) (wrong-type-argument (if (not (listp mins)) - (signal (car err) (cdr err)) + (signal err) (message "Argtype error in `appt-disp-window-function' - \ update it for multiple appts?") ;; Fallback to just displaying the first appt, as we used to. diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index bd1e7a88f16..83764074eec 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -161,7 +161,7 @@ If DATE lacks time zone information, local time is assumed." (encode-time parsed)) (error (if (equal err '(error "Specified time is not representable")) - (signal (car err) (cdr err)) + (signal err) (error "Invalid date: %s" date))))) ;;;###autoload diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index ed7cad4d6da..0e3c8bf6a5f 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -437,11 +437,6 @@ then it searches *all* buffers." (let ((completion-list (dabbrev--find-all-expansions abbrev ignore-case-p)) (completion-ignore-case ignore-case-p)) - (or (consp completion-list) - (user-error "No dynamic expansion for \"%s\" found%s" - abbrev - (if dabbrev--check-other-buffers - "" " in this-buffer"))) (setq list (cond ((not (and ignore-case-p dabbrev-case-replace)) diff --git a/lisp/delsel.el b/lisp/delsel.el index 183966a9347..8cc4e7b1343 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -193,10 +193,13 @@ the active region is killed instead of deleted." Search for the next stretch of text identical to the region last replaced by typing text over it and replaces it with the same stretch of text. With ARG (interactively, prefix numeric argument), repeat that many times. -Just `\\[universal-argument]' means repeat until the end of the buffer's accessible portion." +Just `\\[universal-argument]' means repeat until the end of the buffer's accessible portion. +This function requires the last replacement to be available in a register, +so it does not work when `delete-selection-save-to-register' is nil." (interactive "P") - (let ((old-text (and delete-selection-save-to-register - (get-register delete-selection-save-to-register))) + (unless delete-selection-save-to-register + (user-error "Can't work without delete-selection-save-to-register")) + (let ((old-text (get-register delete-selection-save-to-register)) (count (if (consp arg) (point-max) (prefix-numeric-value current-prefix-arg)))) (if (not (and old-text (> (length old-text) 0))) diff --git a/lisp/desktop.el b/lisp/desktop.el index df98079b1c2..f478cf2307b 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -812,7 +812,7 @@ is nil, ask the user where to save the desktop." (desktop-save desktop-dirname t) (file-error (unless (yes-or-no-p "Error while saving the desktop. Ignore? ") - (signal (car err) (cdr err)))))) + (signal err))))) (desktop--on-kill) t) diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el index 492d8180848..c3f43355a31 100644 --- a/lisp/ebuff-menu.el +++ b/lisp/ebuff-menu.el @@ -172,11 +172,12 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry. (switch-to-buffer (Buffer-menu-buffer t))))))) (defun electric-buffer-menu-looper (state condition) + ;; NOTE: This code looks very much like `ebrowse-electric-list-looper'. (cond ((and condition - (not (memq (car condition) '(buffer-read-only - end-of-buffer - beginning-of-buffer)))) - (signal (car condition) (cdr condition))) + (not (or (error-has-type-p condition 'buffer-read-only) + (error-has-type-p condition 'end-of-buffer) + (error-has-type-p condition 'beginning-of-buffer)))) + (signal condition)) ((< (point) (car state)) (goto-char (point-min)) (unless Buffer-menu-use-header-line diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 333d95dbf1a..9387f8f5402 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4967,9 +4967,9 @@ binding slots have been popped." (unless (and c (symbolp c)) (byte-compile-warn-x c "`%S' is not a condition name (in condition-case)" c)) - ;; In reality, the `error-conditions' property is only required + ;; In reality, the `error-conditions' property is required only ;; for the argument to `signal', not to `condition-case'. - ;;(unless (consp (get c 'error-conditions)) + ;;(unless (error-type-p c) ;; (byte-compile-warn ;; "`%s' is not a known condition name (in condition-case)" ;; c)) @@ -5779,24 +5779,13 @@ already up-to-date." (byte-compile-file file) (condition-case err (byte-compile-file file) - (file-error - (message (if (cdr err) - ">>Error occurred processing %s: %s (%s)" - ">>Error occurred processing %s: %s") - file - (get (car err) 'error-message) - (prin1-to-string (cdr err))) - (let ((destfile (byte-compile-dest-file file))) - (if (file-exists-p destfile) - (delete-file destfile))) - nil) (error - (message (if (cdr err) - ">>Error occurred processing %s: %s (%s)" - ">>Error occurred processing %s: %s") - file - (get (car err) 'error-message) - (prin1-to-string (cdr err))) + (message ">>Error occurred processing %s: %s" + file (error-message-string err)) + (when (error-has-type-p err 'file-error) + (let ((destfile (byte-compile-dest-file file))) + (if (file-exists-p destfile) + (delete-file destfile)))) nil))))) (defun byte-compile-refresh-preloaded () diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 0195d2b2469..de7e0a9c032 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3604,18 +3604,15 @@ the deferred compilation mechanism." ;; If we are doing an async native compilation print the ;; error in the correct format so is parsable and abort. (if (and comp-async-compilation - (not (eq (car err) 'native-compiler-error))) + (not (error-has-type-p err 'native-compiler-error))) (progn (message "%S: Error %s" function-or-file (error-message-string err)) (kill-emacs -1)) ;; Otherwise re-signal it adding the compilation input. - ;; FIXME: We can't just insert arbitrary info in the - ;; error-data part of an error: the handler may expect - ;; specific data at specific positions! (comp--error-add-context err function-or-file) - (signal (car err) (cdr err))))) + (signal err)))) (if (stringp function-or-file) data ;; So we return the compiled function. diff --git a/lisp/emacs-lisp/cursor-sensor.el b/lisp/emacs-lisp/cursor-sensor.el index cd672ba68c9..e85f0da4b48 100644 --- a/lisp/emacs-lisp/cursor-sensor.el +++ b/lisp/emacs-lisp/cursor-sensor.el @@ -67,13 +67,14 @@ By convention, this is a list of symbols where each symbol stands for the \"cause\" of the suspension.") -(defun cursor-sensor--intangible-p (pos) - (let ((p (get-pos-property pos 'cursor-intangible))) +(defun cursor-sensor--intangible-p (pos &optional window) + (let ((p (get-pos-property pos 'cursor-intangible window))) (if p (let (a b) - (if (and (setq a (get-char-property pos 'cursor-intangible)) + (if (and (setq a (get-char-property pos 'cursor-intangible window)) (setq b (if (> pos (point-min)) - (get-char-property (1- pos) 'cursor-intangible))) + (get-char-property (1- pos) 'cursor-intangible + window))) (not (eq a b))) ;; If we're right between two different intangible thingies, ;; we can stop here. This is not quite consistent with the @@ -84,27 +85,32 @@ By convention, this is a list of symbols where each symbol stands for the p))) (defun cursor-sensor-tangible-pos (curpos window) - (when (cursor-sensor--intangible-p curpos) + (when (cursor-sensor--intangible-p curpos window) ;; Find the two nearest tangible positions. (let ((nextpos curpos) (prevpos curpos) (oldpos (window-parameter window 'cursor-intangible--last-point))) (while (if (>= nextpos (point-max)) - (when (cursor-sensor--intangible-p nextpos) (setq nextpos nil)) + (when (cursor-sensor--intangible-p nextpos window) + (setq nextpos nil)) (setq nextpos - (if (get-char-property nextpos 'cursor-intangible) + (if (get-char-property nextpos 'cursor-intangible window) (next-single-char-property-change - nextpos 'cursor-intangible nil (point-max)) + nextpos 'cursor-intangible nil ;;FIXME: window + (point-max)) (1+ nextpos))) - (cursor-sensor--intangible-p nextpos))) + (cursor-sensor--intangible-p nextpos window))) (while (if (<= prevpos (point-min)) - (when (cursor-sensor--intangible-p prevpos) (setq prevpos nil)) + (when (cursor-sensor--intangible-p prevpos window) + (setq prevpos nil)) (setq prevpos - (if (get-char-property (1- prevpos) 'cursor-intangible) + (if (get-char-property (1- prevpos) + 'cursor-intangible window) (previous-single-char-property-change - prevpos 'cursor-intangible nil (point-min)) + prevpos 'cursor-intangible nil ;;FIXME: window + (point-min)) (1- prevpos))) - (cursor-sensor--intangible-p prevpos))) + (cursor-sensor--intangible-p prevpos window))) ;; Pick the preferred one depending on the direction of the motion. ;; Goals, from most important to least important: ;; - Prefer a tangible position. @@ -146,6 +152,7 @@ By convention, this is a list of symbols where each symbol stands for the ;;; Detect cursor movement. (defun cursor-sensor--detect (&optional window) + (unless window (setq window (selected-window))) ;; We're run from `pre-redisplay-functions' and `post-command-hook' ;; where we can't handle errors very well, so just demote them to make ;; sure they don't get in the way. @@ -158,11 +165,12 @@ By convention, this is a list of symbols where each symbol stands for the ;; ends, so we can't use just `get-pos-property' because it ;; might never see it. ;; FIXME: Combine properties from covering overlays? - (new (or (get-pos-property point 'cursor-sensor-functions) - (get-char-property point 'cursor-sensor-functions) + (new (or (get-pos-property point 'cursor-sensor-functions window) + (get-char-property point + 'cursor-sensor-functions window) (unless (<= (point-min) point) (get-char-property (1- point) - 'cursor-sensor-functions)))) + 'cursor-sensor-functions window)))) (old (window-parameter window 'cursor-sensor--last-state)) (oldposmark (car old)) (oldpos (or (if oldposmark (marker-position oldposmark)) @@ -184,13 +192,13 @@ By convention, this is a list of symbols where each symbol stands for the (missing nil)) (while (< (setq pos (next-single-char-property-change pos 'cursor-sensor-functions - nil end)) + nil ;;FIXME: window + end)) end) (unless (memq f (get-char-property - pos 'cursor-sensor-functions)) + pos 'cursor-sensor-functions window)) (setq missing t))) - missing))) - (window (selected-window))) + missing)))) (dolist (f (cdr old)) (unless (and (memq f new) (not (funcall missing-p f))) (funcall f window oldpos 'left))) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index bcea708c678..3019ada1bbd 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -560,9 +560,7 @@ The environment used is the one when entering the activation frame at point." (condition-case err (backtrace-eval exp nframe base) (error (setq errored - (format "%s: %s" - (get (car err) 'error-message) - (car (cdr err))))))))) + (error-message-string err))))))) (if errored (progn (message "Error: %s" errored) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 5cb781cb39f..3bb12e18842 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3745,9 +3745,7 @@ Return the result of the last expression." ;; If there is an error, a string is returned describing the error. (condition-case edebug-err (edebug-eval expr) - (error (edebug-format "%s: %s" ;; could - (get (car edebug-err) 'error-message) - (car (cdr edebug-err)))))) + (error (error-message-string edebug-err)))) ;;; Printing @@ -3755,14 +3753,7 @@ Return the result of the last expression." (defun edebug-report-error (value) ;; Print an error message like command level does. ;; This also prints the error name if it has no error-message. - (message "%s: %s" - (or (get (car value) 'error-message) - (format "peculiar error (%s)" (car value))) - (mapconcat (lambda (edebug-arg) - ;; continuing after an error may - ;; complain about edebug-arg. why?? - (prin1-to-string edebug-arg)) - (cdr value) ", "))) + (message "%s" (error-message-string value))) ;; Alternatively, we could change the definition of ;; edebug-safe-prin1-to-string to only use these if defined. @@ -3812,10 +3803,7 @@ this is the prefix key.)" (condition-case err (edebug-eval expr) (error - (setq errored - (format "%s: %s" - (get (car err) 'error-message) - (car (cdr err))))))))) + (setq errored (error-message-string err))))))) (result (unless errored (values--store-value value) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index d5e0afe3b92..1c2df07f137 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -396,12 +396,11 @@ Returns nil." Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES, and aborts the current test as failed if it doesn't." - (let ((signaled-conditions (get (car condition) 'error-conditions)) - (handled-conditions (pcase-exhaustive type + (let ((handled-conditions (pcase-exhaustive type ((pred listp) type) ((pred symbolp) (list type))))) - (cl-assert signaled-conditions) - (unless (cl-intersection signaled-conditions handled-conditions) + (unless (any (lambda (hc) (error-has-type-p condition hc)) + handled-conditions) (ert-fail (append (funcall form-description-fn) (list @@ -409,7 +408,7 @@ and aborts the current test as failed if it doesn't." :fail-reason (concat "the error signaled did not" " have the expected type"))))) (when exclude-subtypes - (unless (member (car condition) handled-conditions) + (unless (member (error-type condition) handled-conditions) (ert-fail (append (funcall form-description-fn) (list diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el index 103e03c777d..62465884d0a 100644 --- a/lisp/emacs-lisp/let-alist.el +++ b/lisp/emacs-lisp/let-alist.el @@ -118,9 +118,13 @@ symbol, and each cdr is the same symbol without the `.'." ;;;###autoload (defmacro let-alist (alist &rest body) "Let-bind dotted symbols to their cdrs in ALIST and execute BODY. -Dotted symbol is any symbol starting with a `.'. Only those present -in BODY are let-bound and this search is done at compile time. -A number will result in a list index. +Dotted symbol is any symbol starting with a `.'. This macro creates +let-bindings for dotted symbols that appear literally in BODY (whether +or not they are actually used). It does not create bindings for dotted +symbols that are introdcued by macro-expansion in BODY. + +A symbol of the form `.foo.N' where N is a natural number refers to the +Nth element of the value that ALIST associates to key `foo'. For instance, the following code @@ -132,7 +136,7 @@ For instance, the following code essentially expands to - (let ((.title (nth 0 (cdr (assq \\='title alist)))) + (let ((.title.0 (nth 0 (cdr (assq \\='title alist)))) (.body (cdr (assq \\='body alist))) (.site (cdr (assq \\='site alist))) (.site.contents (cdr (assq \\='contents (cdr (assq \\='site alist)))))) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 5cbd4213028..936d5f91a06 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -331,7 +331,7 @@ On error, location of point is unspecified." (if no-syntax-crossing ;; Assume called interactively; don't signal an error. (user-error "At top level") - (signal (car err) (cdr err))))))) + (signal err)))))) (setq arg (- arg inc))))) (defun kill-sexp (&optional arg interactive) diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el index f3cc4b73338..8df3d9e4b22 100644 --- a/lisp/emacs-lisp/multisession.el +++ b/lisp/emacs-lisp/multisession.el @@ -295,7 +295,7 @@ DOC should be a doc string, and ARGS are keywords as applicable to (setq i (1+ i) last-error err) (sleep-for (+ 0.1 (/ (float (random 10)) 10)))))) - (signal (car last-error) (cdr last-error))))) + (signal last-error)))) (defun multisession--object-file-name (object) (expand-file-name diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index 11ea9d2850f..f3ea440fb30 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -30,8 +30,7 @@ ;; To install a package from source use `package-vc-install'. If you ;; aren't interested in activating a package, you can use ;; `package-vc-checkout' instead, which will prompt you for a target -;; directory. If you wish to reuse an existing checkout, the command -;; `package-vc-install-from-checkout' will prepare the package. +;; directory. ;; ;; If you make local changes that you wish to share with an upstream ;; maintainer, the command `package-vc-prepare-patch' can prepare @@ -987,14 +986,12 @@ installs takes precedence." ;;;###autoload (defun package-vc-checkout (pkg-desc directory &optional rev) "Clone the sources for PKG-DESC into DIRECTORY and visit that directory. -Unlike `package-vc-install', this does not yet set up the package -for use with Emacs; use `package-vc-install-from-checkout' for -setting the package up after this function finishes. Optional -argument REV means to clone a specific version of the package; it -defaults to the last version available from the package's -repository. If REV has the special value -`:last-release' (interactively, the prefix argument), that stands -for the last released version of the package." +Unlike `package-vc-install', this does not yet set up the package for +use with Emacs. Optional argument REV means to clone a specific version +of the package; it defaults to the last version available from the +package's repository. If REV has the special value +`:last-release' (interactively, the prefix argument), that stands for +the last released version of the package." (interactive (let* ((name (package-vc--read-package-name "Fetch package source: "))) (list (cadr (assoc name package-archive-contents #'string=)) @@ -1022,7 +1019,8 @@ one created by `package-vc-checkout'. If invoked interactively with a prefix argument, prompt the user for the NAME of the package to set up. If the optional argument INTERACTIVE is non-nil (as happens interactively), DIR must be an absolute file name." - (declare (obsolete "use the User Lisp directory instead." "31.1")) + (declare (obsolete "Use the User Lisp directory instead, \ +see Info node `(emacs) User Lisp Directory'." "31.1")) (interactive (let ((dir (expand-file-name (read-directory-name "Directory: ")))) (list dir (and current-prefix-arg (let ((base (file-name-base diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 8bd95c7c9ec..5cf2e535c99 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1219,8 +1219,7 @@ errors signaled by ERROR-FORM or by BODY). (when (condition-case ,err (progn ,@before-body t) (error (funcall error-function) - (unless noerror - (signal (car ,err) (cdr ,err))))) + (unless noerror (signal ,err)))) (funcall ,body))))) (cl-defun package--with-response-buffer-1 (url body &key async file error-function noerror &allow-other-keys) @@ -2093,8 +2092,9 @@ NAME should be a symbol." (error "Use `package-vc-upgrade' for VC packages") (let ((new-desc (cadr (assq name package-archive-contents)))) (when (or (null new-desc) - (version-list-= (package-desc-version pkg-desc) - (package-desc-version new-desc))) + (and pkg-desc + (version-list-= (package-desc-version pkg-desc) + (package-desc-version new-desc)))) (user-error "Cannot upgrade `%s'" name)) (package-install new-desc ;; An active built-in has never been "selected" diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 08dbb9dad19..ea6910c60fc 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -731,7 +731,12 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (number-sequence 5 8)) (ensure-list :eval (ensure-list "foo") - :eval (ensure-list '(1 2 3))) + :eval (ensure-list '(1 2 3)) + :eval (ensure-list '(1 . 2))) + (ensure-proper-list + :eval (ensure-proper-list "foo") + :eval (ensure-proper-list '(1 2 3)) + :eval (ensure-proper-list '(1 . 2))) "Operations on Lists" (append :eval (append '("foo" "bar") '("zot"))) diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 4db3e933551..826ed21f6ff 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -438,18 +438,15 @@ This also updates the displayed table." (setcar cache (nconc lines (list line))) (vtable-end-of-table))) (let* ((start (point)) - (ellipsis (if (vtable-ellipsis table) - (propertize (truncate-string-ellipsis) - 'face (vtable-face table)) - "")) - (ellipsis-width (string-pixel-width ellipsis (current-buffer))) (keymap (get-text-property (point) 'keymap))) ;; FIXME: We have to adjust colors in lines below this if we ;; have :row-colors. (vtable--insert-line table line 0 (vtable--cache-widths cache) (vtable--spacer table) - ellipsis ellipsis-width) + (vtable--ellipsis table) + (string-pixel-width + (vtable--ellipsis table) (current-buffer))) (add-text-properties start (point) (list 'keymap keymap 'vtable table))) ;; We may have inserted a non-numerical value into a previously @@ -518,6 +515,13 @@ recompute the column specs when the table data has changed." column) (vtable-columns table)))) +(defun vtable--ellipsis (table) + (let ((ellipsis (vtable-ellipsis table))) + (pcase ellipsis + ((pred (stringp)) ellipsis) + ('nil "") + (_ (truncate-string-ellipsis))))) + (defun vtable--spacer (table) (vtable--compute-width table (vtable-separator-width table))) @@ -530,10 +534,8 @@ recompute the column specs when the table data has changed." (defun vtable--insert (table) (let* ((spacer (vtable--spacer table)) (start (point)) - (ellipsis (if (vtable-ellipsis table) - (propertize (truncate-string-ellipsis) - 'face (vtable-face table)) - "")) + (ellipsis (propertize (vtable--ellipsis table) + 'face (vtable-face table))) (ellipsis-width (string-pixel-width ellipsis (vtable-buffer table))) ;; We maintain a cache per screen/window width, so that we render ;; correctly if Emacs is open on two different screens (or the @@ -632,23 +634,16 @@ itself in the new buffer." ;; If we don't have a displayer, use the pre-made ;; (cached) string value. (if (> (nth 1 elem) (elt widths index)) - (concat - (vtable--limit-string - pre-computed (- (elt widths index) - (or ellipsis-width 0)) - buffer) - ellipsis) + (truncate-string-pixelwise pre-computed + (elt widths index) + buffer + ellipsis ellipsis-width) pre-computed)) - ;; Recompute widths. (t - (if (> (string-pixel-width value buffer) (elt widths index)) - (concat - (vtable--limit-string - value (- (elt widths index) - (or ellipsis-width 0)) - buffer) - ellipsis) - value)))) + (truncate-string-pixelwise value + (elt widths index) + buffer + ellipsis ellipsis-width)))) (start (point)) ;; Don't insert the separator after the final column. (last (= index (- (length line) 2)))) @@ -761,14 +756,10 @@ itself in the new buffer." (indicator (vtable--indicator table index)) (indicator-width (string-pixel-width indicator buffer)) (last (= index (1- (length (vtable-columns table))))) - displayed) - (setq displayed - (if (> (string-pixel-width name buffer) - (- (elt widths index) indicator-width)) - (vtable--limit-string - name (- (elt widths index) indicator-width) - buffer) - name)) + (displayed (truncate-string-pixelwise + name + (- (elt widths index) indicator-width) + buffer))) (let* ((indicator-lead-width (if (display-graphic-p) ;; On a graphical frame, we want the indicator to @@ -882,12 +873,6 @@ If NEXT, do the next column." (vtable-header-mode 1)) -(defun vtable--limit-string (string pixels buffer) - (while (and (length> string 0) - (> (string-pixel-width string buffer) pixels)) - (setq string (substring string 0 (1- (length string))))) - string) - (defun vtable--char-width (table) (string-pixel-width (propertize "x" 'face (vtable-face table)) (vtable-buffer table))) diff --git a/lisp/epa-file.el b/lisp/epa-file.el index 9bf6916ff7a..b2a89907867 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -117,8 +117,12 @@ encryption is used." (let ((error epa-file-error)) (save-window-excursion (kill-buffer)) - (if (nth 3 error) - (user-error "Wrong passphrase: %s" (nth 3 error)) + ;; FIXME: How do we know that slot 3 can hold only a message related + ;; to a wrong passphrase? + (if (error-slot-value error 3) + (user-error "Wrong passphrase: %s" (error-slot-value error 3)) + ;; FIXME: Why does it make sense to add the data fields of ERROR, + ;; shifted by one position? (signal 'file-missing (cons "Opening input file" (cdr error)))))) @@ -136,6 +140,10 @@ encryption is used." error-string) (match-string 1 error-string)))) +(defun epa-file--error-add-context (error context) + "Append CONTEXT to ERROR data by side effect." + (setf (cdr error) (append (cdr error) (list context)))) + (defvar last-coding-system-used) (defun epa-file-insert-file-contents (file &optional visit beg end replace) (barf-if-buffer-read-only) @@ -171,23 +179,24 @@ encryption is used." ;; signal that as a non-file error ;; so that find-file-noselect-1 won't handle it. ;; Borrowed from jka-compr.el. - (if (and (memq 'file-error (get (car error) 'error-conditions)) - (equal (cadr error) "Searching for program")) + (if (and (error-has-type-p error 'file-error) + (equal (error-slot-value error 1) + "Searching for program")) (error "Decryption program `%s' not found" - (nth 3 error))) + (error-slot-value error 3))) (let ((exists (file-exists-p local-file))) (when exists (if-let* ((wrong-password (epa--wrong-password-p context))) ;; Don't display the *error* buffer if we just ;; have a wrong password; let the later error ;; handler notify the user. - (setq error (append error (list wrong-password))) + (epa-file--error-add-context error wrong-password) (epa-display-error context)) ;; When the .gpg file isn't an encrypted file (e.g., ;; it's a keyring.gpg file instead), then gpg will ;; say "Unexpected exit" as the error message. In ;; that case, just display the bytes. - (if (equal (caddr error) "Unexpected; Exit") + (if (equal (error-slot-value error 2) "Unexpected; Exit") (setq string (with-temp-buffer (insert-file-contents-literally local-file) (buffer-string))) @@ -197,8 +206,10 @@ encryption is used." ;; `find-file-noselect-1'. (setq-local epa-file-error error) (add-hook 'find-file-not-found-functions - 'epa-file--find-file-not-found-function + #'epa-file--find-file-not-found-function nil t))) + ;; FIXME: Why does it make sense to add the data fields + ;; of ERROR, shifted by one position? (signal (if exists 'file-error 'file-missing) (cons "Opening input file" (cdr error)))))) (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)! diff --git a/lisp/epa.el b/lisp/epa.el index 8d3315891b4..09208a0a3cc 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -702,7 +702,7 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use." (epg-decrypt-file context decrypt-file plain-file) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Decrypting %s...wrote %s" (file-name-nondirectory decrypt-file) (file-name-nondirectory plain-file)) (if (epg-context-result-for context 'verify) @@ -727,7 +727,7 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use." (epg-verify-file context file plain) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Verifying %s...done" (file-name-nondirectory file)) (if (epg-context-result-for context 'verify) (epa-display-info (epg-verify-result-to-string @@ -798,7 +798,7 @@ If no one is selected, default secret key is used. " (epg-sign-file context file signature mode) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Signing %s...wrote %s" (file-name-nondirectory file) (file-name-nondirectory signature)))) @@ -828,7 +828,7 @@ If no one is selected, symmetric encryption will be performed. "))) (epg-encrypt-file context file recipients cipher) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Encrypting %s...wrote %s" (file-name-nondirectory file) (file-name-nondirectory cipher)))) @@ -870,7 +870,7 @@ For example: (setq plain (epg-decrypt-string context (buffer-substring start end))) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Decrypting...done") (setq plain (decode-coding-string plain @@ -969,7 +969,7 @@ For example: (get-text-property start 'epa-coding-system-used))))) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Verifying...done") (setq plain (decode-coding-string plain @@ -1077,7 +1077,7 @@ If no one is selected, default secret key is used. " mode)) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Signing...done") (delete-region start end) (goto-char start) @@ -1155,7 +1155,7 @@ If no one is selected, symmetric encryption will be performed. ") sign)) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Encrypting...done") (delete-region start end) (goto-char start) @@ -1185,7 +1185,7 @@ If no one is selected, symmetric encryption will be performed. ") (epg-delete-keys context keys allow-secret) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Deleting...done") (apply #'epa--list-keys epa-list-keys-arguments))) @@ -1273,7 +1273,7 @@ If no one is selected, symmetric encryption will be performed. ") (epg-export-keys-to-file context keys file) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Exporting to %s...done" (file-name-nondirectory file)))) ;;;###autoload @@ -1290,7 +1290,7 @@ If no one is selected, default public key is exported. "))) (insert (epg-export-keys-to-string context keys)) (error (epa-display-error context) - (signal (car error) (cdr error)))))) + (signal error))))) (provide 'epa) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 7c0b878e3cf..ea7dbb2e122 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -751,7 +751,7 @@ Returns what was actually sent, or nil if nothing was sent.") ;; here. Maybe `process-send-string' should handle SIGPIPE even ;; in batch mode (bug#66186). (if (process-live-p target) - (signal (car err) (cdr err)) + (signal err) (signal 'eshell-pipe-broken (list target))))) object) diff --git a/lisp/ffap.el b/lisp/ffap.el index 4f77fd8af6e..800437d69c9 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -459,11 +459,12 @@ Returned values: "ffap-machine-p" nil host (or service "discard"))) t) (error - (let ((mesg (car (cdr error)))) + (let ((mesg (error-slot-value error 1))) (cond ;; v18: ((string-match "\\(^Unknown host\\|Name or service not known$\\)" - mesg) nil) + mesg) + nil) ((string-match "not responding$" mesg) mesg) ;; v19: ;; (file-error "Connection failed" "permission denied" @@ -473,12 +474,13 @@ Returned values: ;; (file-error "Connection failed" "address already in use" ;; "ftp.uu.net" "ffap-machine-p") ((equal mesg "connection failed") - (if (string= (downcase (nth 2 error)) "permission denied") + (if (string-equal-ignore-case (error-slot-value error 2) + "permission denied") nil ; host does not exist ;; Other errors mean the host exists: - (nth 2 error))) + (error-slot-value error 2))) ;; Could be "Unknown service": - (t (signal (car error) (cdr error)))))))))))) + (t (signal error))))))))))) ;;; Possibly Remote Resources: diff --git a/lisp/files.el b/lisp/files.el index edbeb43e9b9..f9af75187cb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6276,7 +6276,7 @@ Before and after saving the buffer, this function runs (when save-silently (message nil))) ;; If we failed, restore the buffer's modtime. (error (set-visited-file-modtime old-modtime) - (signal (car err) (cdr err)))) + (signal err))) ;; Since we have created an entirely new file, ;; make sure it gets the right permission bits set. (setq setmodes @@ -6680,7 +6680,7 @@ Return non-nil if DIR is already a directory." (make-directory-internal dir) (error (or (file-directory-p dir) - (signal (car err) (cdr err)))))) + (signal err))))) (defun make-directory (dir &optional parents) "Create the directory DIR and optionally any nonexistent parent dirs. @@ -6753,7 +6753,7 @@ This acts like (apply FN ARGS) except it returns NO-SUCH if it is non-nil and if FN fails due to a missing file or directory." (condition-case err (apply fn args) - (file-missing (or no-such (signal (car err) (cdr err)))))) + (file-missing (or no-such (signal err))))) (defun delete-file (filename &optional trash) "Delete file named FILENAME. If it is a symlink, remove the symlink. @@ -6994,7 +6994,7 @@ into NEWNAME instead." (make-directory (directory-file-name newname) parents) (error (or (file-directory-p newname) - (signal (car err) (cdr err))))))) + (signal err)))))) ;; Copy recursively. (dolist (file @@ -7981,26 +7981,30 @@ default directory. However, if FULL is non-nil, they are absolute." "Rules for finding \"sibling\" files. This is used by the `find-sibling-file' command. -This variable is a list of (MATCH EXPANSION...) elements. +The value of this variable should a list (RULE1 RULE2 ...), where each +RULE has the form (MATCH EXPANSION...). -MATCH is a regular expression that should match a file name that -has a sibling. It can contain sub-expressions that will be used -in EXPANSIONS. +MATCH is a regular expression that should match a file name which might +have a sibling. It can contain sub-expressions that will be used in +EXPANSIONs as \\N and \\& replacements. -EXPANSION is a string that matches file names. For instance, to -define \".h\" files as siblings of any \".c\", you could say: +Each EXPANSION is a string that matches names of files that are to be +considered siblings of a file whose name matches MATCH. For instance, +to define \".h\" files as siblings of any \".c\" with the same basename, +you could use the following RULE element in the list of rules: (\"\\\\([^/]+\\\\)\\\\.c\\\\\\='\" \"\\\\1.h\") -MATCH and EXPANSION can also be fuller paths. For instance, if -you want to define other versions of a project as being sibling -files, you could say something like: +MATCH and EXPANSION can also include leading directories. For instance, +if you want to treat as siblings same-name files in directory trees +corresponding to different versions of Emacs, you could use a RULE like +this: (\"src/emacs/[^/]+/\\\\(.*\\\\)\\\\\\='\" \"src/emacs/.*/\\\\1\\\\\\='\") In this example, if you're in \"src/emacs/emacs-27/lisp/abbrev.el\", -and a \"src/emacs/emacs-28/lisp/abbrev.el\" file exists, it's now -defined as a sibling." +and a \"src/emacs/emacs-28/lisp/abbrev.el\" file exists, the latter file +will be considered a sibling of the former one." :type '(alist :key-type (regexp :tag "Match") :value-type (repeat (string :tag "Expansion"))) :version "29.1") @@ -8045,14 +8049,12 @@ see), and if nil, defaults to `find-sibling-rules'." (let ((start 0)) ;; Expand \\1 forms in the expansions. (while (string-match "\\\\\\([&0-9]+\\)" expansion start) - (let ((index (string-to-number (match-string 1 expansion)))) - (setq start (match-end 0) - expansion - (replace-match - (substring file - (elt match-data (* index 2)) - (elt match-data (1+ (* index 2)))) - t t expansion))))) + (let* ((index (string-to-number (match-string 1 expansion))) + (value (substring file + (elt match-data (* index 2)) + (elt match-data (1+ (* index 2)))))) + (setq start (+ (match-beginning 0) (length value)) + expansion (replace-match value t t expansion))))) ;; Then see which files we have that are matching. (And ;; expand from the end of the file's match, since we might ;; be doing a relative match.) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 56473f81f06..301dec87cf7 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6946,7 +6946,7 @@ not have a face in `gnus-article-boring-faces'." (set-window-hscroll win new-sum-hscroll)))) (set-window-configuration owin) (if err - (signal (car err) (cdr err)) + (signal err) (ding)))))))) (defun gnus-article-read-summary-send-keys () diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 58f72f002fd..2e9adeec23d 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -2086,8 +2086,8 @@ Assume \"size\" key is equal to \"larger\"." (if (< 1 (length (alist-get 'search-group-spec specs))) (apply #'nnheader-message 4 "Search engine for %s improperly configured: %s" - server (cdr err)) - (signal (car err) (cdr err)))))) + server (error-slot-value err 1)) + (signal 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 diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index bc1c7272283..a1e954d5367 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -831,7 +831,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (setq mail-source-password-cache (delq (assoc from mail-source-password-cache) mail-source-password-cache)) - (signal (car err) (cdr err))))))))) + (signal err)))))))) (if result (progn (when (eq authentication 'password) @@ -896,7 +896,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (setq mail-source-password-cache (delq (assoc from mail-source-password-cache) mail-source-password-cache)) - (signal (car err) (cdr err))))))))) + (signal err)))))))) (if result ;; Inform display-time that we have new mail. (setq mail-source-new-mail-available (> result 0)) diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 700a99fe5d8..85b7d3a879c 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -939,7 +939,7 @@ If no one is selected, symmetric encryption will be performed. " mml-secure-secret-key-id-list nil) (error (mml-secure-clear-secret-key-id-list) - (signal (car error) (cdr error)))) + (signal error))) cipher)) (defun mml-secure-sender-sign-query (protocol sender) @@ -1029,7 +1029,7 @@ Returns non-nil if the user has chosen to use SENDER." mml-secure-secret-key-id-list nil) (error (mml-secure-clear-secret-key-id-list) - (signal (car error) (cdr error)))) + (signal error))) (if (epg-context-result-for context 'sign) (setq micalg (epg-new-signature-digest-algorithm (car (epg-context-result-for context 'sign))))) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 652b0804add..750ebc413b6 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -363,14 +363,14 @@ This variable is set by `nnmaildir-request-article'.") (error . ,handler))) (defun nnmaildir--emlink-p (err) - (and (eq (car err) 'file-error) - (string= (downcase (caddr err)) "too many links"))) + (and (error-has-type-p err 'file-error) + (string-equal-ignore-case (error-slot-value err 2) "too many links"))) (defun nnmaildir--enoent-p (err) - (eq (car err) 'file-missing)) + (error-has-type-p err 'file-missing)) (defun nnmaildir--eexist-p (err) - (eq (car err) 'file-already-exists)) + (error-has-type-p err 'file-already-exists)) (defun nnmaildir--new-number (nndir) "Allocate a new article number by atomically creating a file under NNDIR." @@ -410,7 +410,7 @@ This variable is set by `nnmaildir-request-article'.") (unless (equal (file-attribute-inode-number attr) ino-open) (setq number-open number-link number-link 0)))) - (t (signal (car err) (cdr err))))))))) + (t (signal err)))))))) (defun nnmaildir--update-nov (server group article) (let ((nnheader-file-coding-system 'undecided) @@ -1664,7 +1664,7 @@ This variable is set by `nnmaildir-request-article'.") (nnmaildir--mkfile permarkfilenew) (rename-file permarkfilenew permarkfile 'replace) (add-name-to-file permarkfile mfile))) - (t (signal (car err) (cdr err)))))))) + (t (signal err))))))) todo-marks))) (set-action (lambda (article) (funcall add-action article) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index a5727be92a4..46e7abc81eb 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -412,7 +412,7 @@ otherwise return nil." (condition-case err (mm-url-insert url) (error (if (or debug-on-quit debug-on-error) - (signal (car err) (cdr err)) + (signal err) (message "nnrss: Failed to fetch %s" url)))))) (nnheader-remove-cr-followed-by-lf) ;; Decode text according to the encoding attribute. diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index b90a6c8b235..71bac870aca 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -346,8 +346,7 @@ group info." gnus-newsgroup-selection)) ;; Don't swallow gnus-search errors; the user should be made ;; aware of them. - (gnus-search-error - (signal (car err) (cdr err))) + (gnus-search-error (signal err)) (error (gnus-error 3 diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 99fe5cd2f5a..c8c622969c3 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -173,9 +173,9 @@ elisp byte-compiler." "An alist describing how to fontify buffers. Each element should be of the form (PRIORITY FORM FACE), where PRIORITY is an integer, FORM is an arbitrary form to evaluate in the -buffer, and FACE is the face to use for fontification. If the FORM -evaluates to non-nil, then FACE will be put on the buffer name. The -element with the highest PRIORITY takes precedence. +buffer, and FACE is the face (a symbol) to use for fontification. +If the FORM evaluates to non-nil, then FACE will be put on the buffer +name. The element with the highest PRIORITY takes precedence. If you change this variable, you must kill the Ibuffer buffer and recreate it for the change to take effect." @@ -1127,11 +1127,12 @@ a new window in the current frame, splitting vertically." (error ;; Handle a failure (if (or (> (incf attempts) 4) - (and (stringp (cadr err)) - ;; This definitely falls in the - ;; ghetto hack category... - (not (string-match-p "too small" (cadr err))))) - (signal (car err) (cdr err)) + (let ((msg (error-slot-value err 1))) + (and (stringp msg) + ;; This definitely falls in the + ;; ghetto hack category... + (not (string-search "too small" msg))))) + (signal err) (enlarge-window 3)))))) (select-window (next-window)) (switch-to-buffer buf) diff --git a/lisp/info.el b/lisp/info.el index 8d1aadd34c6..368255092a1 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1343,7 +1343,13 @@ is non-nil)." (Info-select-node) (goto-char (point-min)) - (forward-line 1) ; skip header line + ;; Skip the header line or breadcrumbs, unless + ;; 'scroll-conservatively' is set to a large enough value + ;; which could cause us scroll the display to leave that + ;; line outside of the window. The shortest node is 5 + ;; lines, thus 6 is the threshold value. + (if (< scroll-conservatively 6) + (forward-line 1)) ;; (when (> Info-breadcrumbs-depth 0) ; skip breadcrumbs line ;; (forward-line 1)) diff --git a/lisp/international/ja-dic-utl.el b/lisp/international/ja-dic-utl.el index 3f6500669a4..66e402c12db 100644 --- a/lisp/international/ja-dic-utl.el +++ b/lisp/international/ja-dic-utl.el @@ -115,7 +115,7 @@ The library `ja-dic' can't be loaded. This might indicate a problem with your Emacs installation, as LEIM (Libraries of Emacs Input Method) should normally always be installed together with Emacs."))) - (signal (car err) (cdr err))))) + (signal err)))) (let ((vec (make-vector len 0)) (i 0) diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index d78c1d03deb..ac692340e74 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -449,7 +449,7 @@ Defaults to the whole buffer. END can be out of bounds." ;; on-the-fly jit-locking), make sure the fontification ;; will be performed before displaying the block again. (quit (put-text-property start next 'fontified nil) - (signal (car err) (cdr err)))))) + (signal err))))) ;; In case we fontified more than requested, take ;; advantage of the good news. diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index 8258ab32495..c4643fb2d8c 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -471,22 +471,21 @@ There should be no more than seven characters after the final `/'." ;; If the file we wanted to uncompress does not exist, ;; handle that according to VISIT as `insert-file-contents' ;; would, maybe signaling the same error it normally would. - (if (and (eq (car error-code) 'file-missing) - (eq (nth 3 error-code) local-file)) + (if (and (error-has-type-p error-code 'file-missing) + (eq (error-slot-value error-code 3) local-file)) (if visit (setq notfound error-code) - (signal 'file-missing - (cons "Opening input file" - (nthcdr 2 error-code)))) + (setf (error-slot-value error-code 1) + "Opening input file") + (signal error-code)) ;; If the uncompression program can't be found, ;; signal that as a non-file error ;; so that find-file-noselect-1 won't handle it. - (if (and (memq 'file-error (get (car error-code) - 'error-conditions)) + (if (and (error-has-type-p error-code 'file-error) (equal (cadr error-code) "Searching for program")) (error "Uncompression program `%s' not found" - (nth 3 error-code))) - (signal (car error-code) (cdr error-code))))))) + (error-slot-value error-code 3)) + (signal error-code))))))) (and local-copy diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index a54b3d60abc..d84e2340dbd 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -4607,8 +4607,8 @@ The return value is the incremented value of PLACE. If X is specified, it should be an expression that should evaluate to a number. -This macro is considered deprecated in favor of the built-in macro -`incf' that was added in Emacs 31.1.") +This macro is deprecated in favor of the built-in macro `incf' that was +added in Emacs 31.1.") (defvar cl-old-struct-compat-mode nil "Non-nil if Cl-Old-Struct-Compat mode is enabled. See the `cl-old-struct-compat-mode' command @@ -4727,7 +4727,7 @@ penultimate step during initialization. Also propose to install the grammar when `treesit-enabled-modes' is t or contains the mode name.") (when (boundp 'treesit-major-mode-remap-alist) (add-to-list 'auto-mode-alist '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode-maybe)) (add-to-list 'treesit-major-mode-remap-alist '(cmake-mode . cmake-ts-mode))) -(register-definition-prefixes "cmake-ts-mode" '("cmake-ts-mode-")) +(register-definition-prefixes "cmake-ts-mode" '("cmake-ts-")) ;;; Generated autoloads from cmuscheme.el @@ -5466,12 +5466,13 @@ in its body becomes the return value of the `cond*' construct. Non-exit clauses: -If a clause has only one element, or if its first element is t or a -`bind*' form, or if it ends with the keyword `:non-exit', then this -clause never exits the `cond*' construct. Instead, control always falls -through to the next clause (if any). Except for a `bind-and*' clause, -all bindings made in CONDITION for the BODY of the non-exit clause are -passed along to the rest of the clauses in this `cond*' construct. +If the first element of a clause is t or a `bind*' form, or if it has +only one element and that element is a `match*' or `pcase*' form, or if +it ends with the keyword `:non-exit', then this clause never exits the +`cond*' construct. Instead, control always falls through to the next +clause (if any). Except for a `bind-and*' clause, all bindings made in +CONDITION for the BODY of the non-exit clause are passed along to the +rest of the clauses in this `cond*' construct. See `match*' for documentation of the patterns for use in `match*' conditions. @@ -13703,7 +13704,7 @@ lines. ;;; Generated autoloads from progmodes/flymake.el -(push '(flymake 1 4 3) package--builtin-versions) +(push '(flymake 1 4 5) package--builtin-versions) (autoload 'flymake-log "flymake" "Log, at level LEVEL, the message MSG formatted with ARGS. LEVEL is passed to `display-warning', which is used to display @@ -17485,7 +17486,7 @@ this mode runs the hook `html-ts-mode-hook', as the final or penultimate step during initialization. \\{html-ts-mode-map}" t) -(register-definition-prefixes "html-ts-mode" '("html-ts-mode-")) +(register-definition-prefixes "html-ts-mode" '("html-ts-")) ;;; Generated autoloads from htmlfontify.el @@ -19865,7 +19866,7 @@ penultimate step during initialization. \\{java-ts-mode-map}" t) (when (boundp 'treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(java-mode . java-ts-mode))) -(register-definition-prefixes "java-ts-mode" '("java-ts-mode-")) +(register-definition-prefixes "java-ts-mode" '("java-ts-")) ;;; Generated autoloads from cedet/semantic/wisent/javascript.el @@ -21899,7 +21900,7 @@ penultimate step during initialization. \\{mhtml-ts-mode-map}" t) (when (boundp 'treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(mhtml-mode . mhtml-ts-mode))) -(register-definition-prefixes "mhtml-ts-mode" '("mhtml-ts-mode-")) +(register-definition-prefixes "mhtml-ts-mode" '("mhtml-ts-")) ;;; Generated autoloads from midnight.el @@ -26182,8 +26183,12 @@ after OUT-BUFFER-NAME. (autoload 'pp-eval-expression "pp" "Evaluate EXPRESSION and pretty-print its value. Also add the value to the front of the list in the variable `values'. +When called interactively, read an Emacs Lisp expression. +With a prefix argument (when called from Lisp, with optional argument +INSERT-VALUE non-nil), insert the value into the current buffer instead +of displaying it in the echo area or a temporary buffer. -(fn EXPRESSION)" t) +(fn EXPRESSION &optional INSERT-VALUE)" t) (autoload 'pp-macroexpand-expression "pp" "Macroexpand EXPRESSION and pretty-print its value. @@ -30748,8 +30753,8 @@ variable `str' within the skeleton. When this is non-nil, the interactor gets ignored, and this should be a valid skeleton element. When done with skeleton, but before going back to `_'-point, add -a newline (unless `skeleton-end-newline' is nil) and run the hook -`skeleton-end-hook'. +a newline (unless `skeleton-end-newline' is nil or `_'-point is at end +of line), and run the hook `skeleton-end-hook'. SKELETON is made up as (INTERACTOR ELEMENT ...). INTERACTOR may be nil if not needed, a prompt-string or an expression for complex read functions. @@ -30838,6 +30843,8 @@ PROPS-A on added characters, and PROPS-R on removed characters. If non-nil, PREPROC is called with no argument in a buffer that contains a copy of a region, just before preparing it to for `diff'. It can be used to replace chars to try and eliminate some spurious differences. +The two regions can be in different buffers (in which case, BEG1 and BEG2 +need to be markers to indicate the corresponding buffers). (fn BEG1 END1 BEG2 END2 PROPS-C &optional PREPROC PROPS-R PROPS-A)") (autoload 'smerge-ediff "smerge-mode" @@ -32474,6 +32481,7 @@ and `sc-post-hook' is run after the guts of this function.") ;;; Generated autoloads from system-sleep.el + (autoload 'sleep-event-state "system-sleep.el") (defvar system-sleep-event-functions nil "Abnormal hook invoked on system sleep events. Each function is called with one argument EVENT, a sleep event. EVENT @@ -32514,6 +32522,13 @@ Despite this, you should unblock your blocks when your processing is complete. See `with-system-sleep-block' for an easy way to do that. (fn &optional WHY ALLOW-DISPLAY-SLEEP)") +(autoload 'system-sleep-unblock-sleep "system-sleep" +"Unblock the system sleep block associated with TOKEN. +Return non-nil TOKEN was unblocked, or nil if not. +In the unlikely event that unblock fails, the block will be released +when the Emacs process dies. + +(fn TOKEN)") (autoload 'with-system-sleep-block "system-sleep" "Execute the forms in BODY while blocking system sleep. The optional arguments WHY and ALLOW-DISPLAY-SLEEP have the same meaning @@ -34672,7 +34687,7 @@ penultimate step during initialization. \\{toml-ts-mode-map}" t) (when (boundp 'treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(conf-toml-mode . toml-ts-mode))) -(register-definition-prefixes "toml-ts-mode" '("toml-ts-mode-")) +(register-definition-prefixes "toml-ts-mode" '("toml-ts-")) ;;; Generated autoloads from tool-bar.el @@ -35251,6 +35266,7 @@ of `define-treesit-generic-mode'. (fn MODE [DOCSTRING] [KEYWORD-ARGS...] &rest BODY)" nil t) (function-put 'define-treesit-generic-mode 'doc-string-elt 2) +(function-put 'define-treesit-generic-mode 'autoload-macro 'expand) (autoload 'treesit-generic-mode-setup "treesit-x" "Go into the treesit generic mode MODE. @@ -36871,11 +36887,9 @@ Uncommitted changes are included in the diff. When unspecified, UPSTREAM-LOCATION is the outgoing base. For a trunk branch this is always the place \\[vc-push] would push to. -For a topic branch, see whether the branch matches one of -`vc-trunk-branch-regexps' or `vc-topic-branch-regexps', or else query -the backend for an appropriate outgoing base. +For a topic branch, query the backend for an appropriate outgoing base. See `vc-trunk-or-topic-p' regarding the difference between trunk and -topic branches. +topic branches and how Emacs classifies the current branch. When called interactively with a prefix argument, prompt for UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION @@ -36897,11 +36911,9 @@ Uncommitted changes are included in the diff. When unspecified, UPSTREAM-LOCATION is the outgoing base. For a trunk branch this is always the place \\[vc-push] would push to. -For a topic branch, see whether the branch matches one of -`vc-trunk-branch-regexps' or `vc-topic-branch-regexps', or else query -the backend for an appropriate outgoing base. +For a topic branch, query the backend for an appropriate outgoing base. See `vc-trunk-or-topic-p' regarding the difference between trunk and -topic branches. +topic branches and how Emacs classifies the current branch. When called interactively with a prefix argument, prompt for UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION @@ -36923,11 +36935,9 @@ working revision and UPSTREAM-LOCATION. When unspecified, UPSTREAM-LOCATION is the outgoing base. For a trunk branch this is always the place \\[vc-push] would push to. -For a topic branch, see whether the branch matches one of -`vc-trunk-branch-regexps' or `vc-topic-branch-regexps', or else query -the backend for an appropriate outgoing base. +For a topic branch, query the backend for an appropriate outgoing base. See `vc-trunk-or-topic-p' regarding the difference between trunk and -topic branches. +topic branches and how Emacs classifies the current branch. When called interactively with a prefix argument, prompt for UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION @@ -36948,11 +36958,9 @@ working revision and UPSTREAM-LOCATION. When unspecified, UPSTREAM-LOCATION is the outgoing base. For a trunk branch this is always the place \\[vc-push] would push to. -For a topic branch, see whether the branch matches one of -`vc-trunk-branch-regexps' or `vc-topic-branch-regexps', or else query -the backend for an appropriate outgoing base. +For a topic branch, query the backend for an appropriate outgoing base. See `vc-trunk-or-topic-p' regarding the difference between trunk and -topic branches. +topic branches and how Emacs classifies the current branch. When called interactively with a prefix argument, prompt for UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION @@ -37140,7 +37148,7 @@ instead of the working revision, and a number specifying the maximum number of revisions to show; the default is `vc-log-show-limit'. You can also use a numeric prefix argument to specify this. -This is like `vc-root-print-log' but with an alternative prefix argument +This is like `vc-print-root-log' but with an alternative prefix argument that some users might prefer for interactive usage." t) (function-put 'vc-print-root-change-log 'interactive-only 'vc-print-root-log) (autoload 'vc-print-fileset-branch-log "vc" @@ -37238,8 +37246,6 @@ It also signals an error in a Bazaar bound branch. "First pull, and then push the current branch. The push will only be performed if the pull operation was successful. -You must be visiting a version controlled file, or in a `vc-dir' buffer. - On a distributed version control system, this runs a \"pull\" operation on the current branch, prompting for the precise command if required. Optional prefix ARG non-nil forces a prompt @@ -40341,6 +40347,51 @@ This command is intended to be bound to a mouse event. This command is intended to be bound to a mouse event. (fn EVENT)" t) +(autoload 'xref-mouse-mode "xref" +"Minor mode to bind Xref commands invoked using the mouse. + +See `global-xref-mouse-mode' if you want to enable this minor mode in +all buffers. + +This is a minor mode. If called interactively, toggle the `Xref-Mouse +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate the variable `xref-mouse-mode'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(put 'global-xref-mouse-mode 'globalized-minor-mode t) +(defvar global-xref-mouse-mode nil +"Non-nil if Global Xref-Mouse mode is enabled. +See the `global-xref-mouse-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `global-xref-mouse-mode'.") +(custom-autoload 'global-xref-mouse-mode "xref" nil) +(autoload 'global-xref-mouse-mode "xref" +"Toggle Xref-Mouse mode in many buffers. +Specifically, Xref-Mouse mode is enabled in all buffers where +`xref-mouse-mode' would do it. + +With prefix ARG, enable Global Xref-Mouse mode if ARG is positive; +otherwise, disable it. + +If called from Lisp, toggle the mode if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +See `xref-mouse-mode' for more information on Xref-Mouse mode. + +(fn &optional ARG)" t) (autoload 'xref-find-apropos "xref" "Find all meaningful symbols that match PATTERN. The argument has the same meaning as in `apropos'. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 99cfbf140c3..a34e8c3c2a2 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -312,14 +312,14 @@ are also supported; unsupported long options are silently ignored." (invalid-regexp ;; Maybe they wanted a literal file that just happens to ;; use characters special to shell wildcards. - (if (equal (cadr err) "Unmatched [ or [^") + (if (equal (error-slot-value err 1) "Unmatched [ or [^") (progn (setq wildcard-regexp (if (memq ?B switches) "[^~]\\'") file (file-relative-name orig-file)) (ls-lisp-insert-directory file switches (ls-lisp-time-index switches) nil full-directory-p)) - (signal (car err) (cdr err))))))) + (signal err)))))) (defun ls-lisp-insert-directory (file switches time-index wildcard-regexp full-directory-p) diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index ae3b37ea41c..ee009ecfda4 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -655,10 +655,10 @@ Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL t) (error ;; #### kludge kludge kludge kludge kludge kludge kludge !!! - (if (string-equal (nth 1 error) "Unbalanced parentheses") + (if (string-equal (error-slot-value error 1) "Unbalanced parentheses") nil - (while t - (signal (car error) (cdr error))))))) + (while t ;;FIXME: Why? + (signal error)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el index a48b876443b..3961c2a1e25 100644 --- a/lisp/mail/rfc2047.el +++ b/lisp/mail/rfc2047.el @@ -543,7 +543,7 @@ Dynamically bind `rfc2047-encoding-type' to change that." (setq last-encoded nil))))) (error (if (or debug-on-quit debug-on-error) - (signal (car err) (cdr err)) + (signal err) (error "Invalid data for rfc2047 encoding: %s" (replace-regexp-in-string "[ \t\n]+" " " orig-text)))))))) (unless dont-fold diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el index d096176a9b1..70f73018674 100644 --- a/lisp/mail/rfc2231.el +++ b/lisp/mail/rfc2231.el @@ -176,7 +176,7 @@ must never cause a Lisp error." (error (setq parameters nil) (when signal-error - (signal (car err) (cdr err))))) + (signal err)))) ;; Now collect and concatenate continuation parameters. (let ((cparams nil) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 1ac83134dbe..13d0e712821 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4634,7 +4634,7 @@ filter out additional entries (because TABLE might not obey PRED)." (if between (list between)) pattern)) (setq prefix subprefix))) (if (and (null all) firsterror) - (signal (car firsterror) (cdr firsterror)) + (signal firsterror) (list pattern all prefix suffix))))) (defun completion-pcm-all-completions (string table pred point) diff --git a/lisp/mouse.el b/lisp/mouse.el index a6d553b60a1..24fe57cdc50 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2025,7 +2025,7 @@ The region will be defined with mark and point." (pop-mark))))) ;; Cleanup on errors (error (funcall cleanup) - (signal (car err) (cdr err)))))) + (signal err))))) (defun mouse--drag-set-mark-and-point (start click click-count) (let* ((range (mouse-start-end start click click-count)) @@ -2790,7 +2790,7 @@ This must be bound to a button-down mouse event." ;; Clean up in case something went wrong. (error (setq track-mouse old-track-mouse) (setq mouse-fine-grained-tracking old-mouse-fine-grained-tracking) - (signal (car err) (cdr err)))))) + (signal err))))) ;; The drag event must be bound to something but does not need any effect, ;; as everything takes place in `mouse-drag-region-rectangle'. diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index c39d73e0ca9..0503e27a8d1 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4401,10 +4401,13 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (condition-case err (let ((debug-on-error t)) (save-match-data (apply fn args))) - (error (signal (car err) (cdr err)))) + ;; FIXME: In which sense does this catch errors since we + ;; immediately re-throw them? Why do we let-bind `debug-on-error'? + ;; And what does this have to do with process-filters? + (error (signal err))) (ange-ftp-run-real-handler operation args)))) -;;; This sets the mode +;; This sets the mode (add-hook 'find-file-hook 'ange-ftp-set-buffer-mode) ;;; Now say where to find the handlers for particular operations. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 465de028725..0c748e76fcf 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -245,7 +245,7 @@ Otherwise, return result of last form in BODY, or all other errors." (declare (indent 0) (debug t)) `(condition-case err (progn ,@body) - (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) + (dbus-error (when dbus-debug (signal err))))) (defvar dbus-event-error-functions '(dbus-notice-synchronous-call-errors @@ -878,7 +878,7 @@ Example: "AddMatch" rule) (dbus-error (if (not (string-match-p "eavesdrop" rule)) - (signal (car err) (cdr err)) + (signal err) ;; The D-Bus spec says we shall fall back to a rule without eavesdrop. (when dbus-debug (message "Removing eavesdrop from rule %s" rule)) (setq rule (replace-regexp-in-string ",eavesdrop='true'" "" rule t t)) @@ -1234,7 +1234,7 @@ If the HANDLER returns a `dbus-error', it is propagated as return message." ;; Propagate D-Bus error messages. (run-hook-with-args 'dbus-event-error-functions event err) (when dbus-debug - (signal (car err) (cdr err)))))) + (signal err))))) (defun dbus-event-bus-name (event) "Return the bus name the event is coming from. @@ -1666,9 +1666,9 @@ return nil. (condition-case err (dbus-get-property bus service path interface property) (dbus-error - (if (string-equal dbus-error-access-denied (cadr err)) + (if (string-equal dbus-error-access-denied (error-slot-value err 1)) (car args) - (signal (car err) (cdr err)))))) + (signal err))))) (defun dbus-get-all-properties (bus service path interface) "Return all properties of INTERFACE at BUS, SERVICE, PATH. diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index aa8e52bd792..ac212e7a817 100644 --- a/lisp/net/eudc-export.el +++ b/lisp/net/eudc-export.el @@ -187,11 +187,11 @@ LOCATION is used as the phone location for BBDB." (bbdb-parse-phone phone) (bbdb-parse-phone-number phone))) (error - (if (string= "phone number unparsable." (cadr err)) + (if (equal "phone number unparsable." (error-slot-value err 1)) (if (not (y-or-n-p (format "BBDB claims %S to be unparsable--insert anyway? " phone))) (error "Phone number unparsable") (setq phone-list (list (bbdb-string-trim phone)))) - (signal (car err) (cdr err))))) + (signal err)))) (if (= 3 (length phone-list)) (setq phone-list (append phone-list '(nil)))) (apply #'vector location phone-list))) diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 22bebbb0f0c..bb298d11d3c 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -1729,11 +1729,11 @@ See `imap-enable-exchange-bug-workaround'." ;; robust just to check for a BAD response to the ;; attempted fetch. (string-match "The specified message set is invalid" - (cadr data))) + (error-slot-value data 1))) (with-current-buffer (or buffer (current-buffer)) (setq-local imap-enable-exchange-bug-workaround t) (imap-fetch (cdr uids) props receive nouidfetch)) - (signal (car data) (cdr data)))))) + (signal data))))) (defun imap-message-copyuid-1 (mailbox) (if (imap-capability 'UIDPLUS) diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el index 289e867e672..3f805237683 100644 --- a/lisp/net/sasl.el +++ b/lisp/net/sasl.el @@ -50,8 +50,7 @@ (defvar sasl-unique-id-function #'sasl-unique-id-function) -(put 'sasl-error 'error-message "SASL error") -(put 'sasl-error 'error-conditions '(sasl-error error)) +(define-error 'sasl-error "SASL error") (defun sasl-error (datum) (signal 'sasl-error (list datum))) diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index beebe9b4445..f6d2ba229e5 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -2886,7 +2886,7 @@ decode function to perform the actual decoding." ;;;; Soap Envelope parsing -(if (fboundp 'define-error) +(if (fboundp 'define-error) ;Emacs-24.4 (define-error 'soap-error "SOAP error") ;; Support Emacs<24.4 that do not have define-error, so ;; that soap-client can remain unchanged in GNU ELPA. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index f975457d4df..3f947ef1b2c 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -102,14 +102,20 @@ Add the extension of F, if existing." tramp-temp-name-prefix tramp-compat-temporary-file-directory) dir-flag (file-name-extension f t))) +(defalias 'tramp-compat-error-type-p + (if (fboundp 'error-type-p) ;Emacs-31 + #'error-type-p + (lambda (symbol) (get symbol 'error-conditions)))) + ;; `permission-denied' is introduced in Emacs 29.1. (defconst tramp-permission-denied - (if (get 'permission-denied 'error-conditions) 'permission-denied 'file-error) + (if (tramp-compat-error-type-p 'permission-denied) + 'permission-denied 'file-error) "The error symbol for the `permission-denied' error.") (defsubst tramp-compat-permission-denied (vec file) "Emit the `permission-denied' error." - (if (get 'permission-denied 'error-conditions) + (if (tramp-compat-error-type-p 'permission-denied) (tramp-error vec tramp-permission-denied file) (tramp-error vec tramp-permission-denied "Permission denied: %s" file))) @@ -249,8 +255,6 @@ value is the default binding of the variable." ;; ;; * Use `with-environment-variables'. ;; -;; * Use `ensure-list'. -;; ;; * Starting with Emacs 29.1, use `buffer-match-p' and `match-buffers'. ;; ;; * Starting with Emacs 29.1, use `string-split'. @@ -260,6 +264,9 @@ value is the default binding of the variable." ;; kept, for example when the HANDLER propagates the error with ;; `(signal (car err) (cdr err)'. ;; +;; * Starting with Emacs 31.1, use `(signal err)' instead of `(signal +;; (car err) (cdr err)'. +;; ;; * Starting with Emacs 30.1, use '(_ VALUEFORM)' instead of ;; '(VALUEFORM)' in 'if-let*/when-let*/and-let*'. diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el index 7b405061ba8..37628e2f001 100644 --- a/lisp/net/tramp-message.el +++ b/lisp/net/tramp-message.el @@ -398,8 +398,12 @@ FMT-STRING and ARGUMENTS." vec-or-proc 1 "%s" (error-message-string (list signal + ;; FIXME: Looks redundant since `error-message-string' + ;; already uses the `error-message' property of `signal'! (get signal 'error-message) (apply #'format-message fmt-string arguments)))) + ;; FIXME: This doesn't look right: ELisp code should be able to rely on + ;; the "shape" of the list based on the type of the signal. (signal signal (list (substring-no-properties (apply #'format-message fmt-string arguments)))))) diff --git a/lisp/paren.el b/lisp/paren.el index 0a2e47e66a6..1ab3f9a32cf 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -103,7 +103,10 @@ If set to the symbol `child-frame', the context is shown in a child frame at the top-left of the window. You might want to customize the `child-frame-border' face (especially the background color) to give the child frame a distinguished border. -On non-graphical frames, the context is shown in the echo area." +On non-graphical frames, the context is shown in the echo area. + +Note that `blink-matching-paren-highlight-offscreen' can have an +influence on the fontification of the opening offscreen paren." :type '(choice (const :tag "Off" nil) (const :tag "In echo area" t) (const :tag "In overlay" overlay) diff --git a/lisp/play/zone.el b/lisp/play/zone.el index 513ae9b023e..1ba93d73df3 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -341,6 +341,7 @@ buffer is visible, try to recenter it to expose more." ;; Switch in the source buffer into the window (unless (eq (current-buffer) buf) (set-window-buffer win buf nil)) + (select-window win t) ;; Try to scroll the buffer into the window (unless (< (window-end) (point-max)) (let ((scroll-margin 0)) @@ -409,7 +410,8 @@ Based on the settings, the other frames may be similarly adjusted." (dolist (w (if zone-all-windows-in-frame (window-list f 'no-minibuf w1) (list w1))) - (set-window-buffer w z nil)) + (unless (window-dedicated-p w) + (set-window-buffer w z nil))) (modify-frame-parameters f no-cursor) ;; Handle the remaining frames (dolist (f (visible-frame-list)) @@ -423,7 +425,8 @@ Based on the settings, the other frames may be similarly adjusted." (dolist (w (if zone-all-windows-in-frame (window-list f 'no-minibuf w1) (list w1))) - (set-window-buffer w z nil)) + (unless (window-dedicated-p w) + (set-window-buffer w z nil))) (modify-frame-parameters f no-cursor) (set-frame-selected-window f w1 t))) (select-frame prim-frm) diff --git a/lisp/plstore.el b/lisp/plstore.el index 08c9f5a423e..0964e6ccaf6 100644 --- a/lisp/plstore.el +++ b/lisp/plstore.el @@ -432,7 +432,7 @@ accordingly." plstore-passphrase-alist))) (if entry (setcdr entry nil))) - (signal (car error) (cdr error)))) + (signal error))) (plstore--set-secret-alist plstore (car (read-from-string plain))) (plstore--merge-secret plstore) (plstore--set-encrypted-data plstore nil)))) diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 2d0ab0fdeaf..67ebd7a9c06 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -1935,11 +1935,12 @@ COLLAPSE non-nil means collapse the branch." "Prevent cursor from moving beyond the buffer end. Don't let it move into the title lines. See `Electric-command-loop' for a description of STATE and CONDITION." + ;; NOTE: This code looks very much like `electric-buffer-menu-looper'. (cond ((and condition - (not (memq (car condition) - '(buffer-read-only end-of-buffer - beginning-of-buffer)))) - (signal (car condition) (cdr condition))) + (not (or (error-has-type-p condition 'buffer-read-only) + (error-has-type-p condition 'end-of-buffer) + (error-has-type-p condition 'beginning-of-buffer)))) + (signal condition)) ((< (point) (car state)) (goto-char (point-min)) (forward-line 2)) @@ -3879,23 +3880,7 @@ Runs the hook `ebrowse-electric-position-mode-hook'." (kill-buffer buffer))) -(defun ebrowse-electric-position-looper (state condition) - "Prevent moving point on invalid lines. -Called from `Electric-command-loop'. See there for the meaning -of STATE and CONDITION." - (cond ((and condition - (not (memq (car condition) '(buffer-read-only - end-of-buffer - beginning-of-buffer)))) - (signal (car condition) (cdr condition))) - ((< (point) (car state)) - (goto-char (point-min)) - (forward-line 2)) - ((> (point) (cdr state)) - (goto-char (point-max)) - (forward-line -1) - (if (pos-visible-in-window-p (point-max)) - (recenter -1))))) +(defalias 'ebrowse-electric-position-looper #'ebrowse-electric-list-looper) (defun ebrowse-electric-position-undefined () diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index bb58e7d382a..3c3aafcde15 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -620,11 +620,8 @@ non-nil, also annotate the symbol with `cursor-sensor-functions'." (elisp--annotate-symbol-with-help-echo role beg end sym) (put-text-property beg end 'mouse-face `(,face elisp-symbol-at-mouse))) (when (and id (bound-and-true-p cursor-sensor-mode)) - (put-text-property beg (1+ end) 'cursor-sensor-functions - ;; Get a fresh list with SYM hardcoded, - ;; so that the value is distinguishable - ;; from the value in adjacent regions. - (elisp-cursor-sensor beg)))))) + (put-text-property + beg end 'cursor-sensor-functions (elisp-cursor-sensor beg)))))) (defun elisp-fontify-symbols (end) "Fontify symbols from point to END according to their role in the code." @@ -834,7 +831,8 @@ be used instead. (defvar elisp--local-macroenv `((cl-eval-when . ,(lambda (&rest args) `(progn . ,(cdr args)))) (eval-when-compile . ,(lambda (&rest args) `(progn . ,args))) - (eval-and-compile . ,(lambda (&rest args) `(progn . ,args)))) + (eval-and-compile . ,(lambda (&rest args) `(progn . ,args))) + (static-if . ,(lambda (&rest args) `(if . ,args)))) "Environment to use while tentatively expanding macros. This is used to try and avoid the most egregious problems linked to the use of `macroexpand-all' as a way to find the \"underlying raw code\".") @@ -1111,8 +1109,7 @@ functions are annotated with \"\" via the ;; specific completion table in more cases. (is-ignore-error (list t (elisp--completion-local-symbols) - :predicate (lambda (sym) - (get sym 'error-conditions)))) + :predicate #'error-type-p)) ((elisp--expect-function-p beg) (list nil (elisp--completion-local-symbols) :predicate @@ -1186,12 +1183,11 @@ functions are annotated with \"\" via the (forward-sexp 2) (< (point) beg))))) (list t (elisp--completion-local-symbols) - :predicate (lambda (sym) (get sym 'error-conditions)))) + :predicate #'error-type-p)) ;; `ignore-error' with a list CONDITION parameter. ('ignore-error (list t (elisp--completion-local-symbols) - :predicate (lambda (sym) - (get sym 'error-conditions)))) + :predicate #'error-type-p)) ((and (or ?\( 'let 'let* 'cond 'cond* 'bind*) (guard (save-excursion (goto-char (1- beg)) diff --git a/lisp/progmodes/etags-regen.el b/lisp/progmodes/etags-regen.el index 3d3ddc0521f..b9cb75358c0 100644 --- a/lisp/progmodes/etags-regen.el +++ b/lisp/progmodes/etags-regen.el @@ -142,6 +142,21 @@ File extensions to generate the tags for." (string :tag "Glob to ignore")) :version "30.1") +(defun etags-regen-create-on-completion--set (symbol value) + (when (and etags-regen-mode value) + (advice-add 'tags-completion-at-point-function :before + #'etags-regen--maybe-generate)) + (set-default-toplevel-value symbol value)) + +(defcustom etags-regen-create-on-completion nil + "Non-nil to ensure tags are created before completion. + +This applies to the function `tags-completion-at-point-function', which +is used in buffers that have no alternative completion configured." + :type 'boolean + :set #'etags-regen-create-on-completion--set + :version "31.1") + ;;;###autoload (put 'etags-regen-ignores 'safe-local-variable (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) @@ -471,8 +486,9 @@ to countermand the effect of a previous \\[visit-tags-table]." (progn (advice-add 'etags--xref-backend :before #'etags-regen--maybe-generate) - (advice-add 'tags-completion-at-point-function :before - #'etags-regen--maybe-generate)) + (when etags-regen-create-on-completion + (advice-add 'tags-completion-at-point-function :before + #'etags-regen--maybe-generate))) (advice-remove 'etags--xref-backend #'etags-regen--maybe-generate) (advice-remove 'tags-completion-at-point-function #'etags-regen--maybe-generate) (etags-regen--tags-cleanup))) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 3043b04c5ad..993ff1cd6f5 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -63,6 +63,8 @@ ;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is ;; activated or deactivated, `hs-minor-mode-hook' is run with `run-hooks'. ;; +;; To enable indentation-based hiding/showing turn on `hs-indentation-mode'. +;; ;; Additionally, Joseph Eydelnant writes: ;; I enjoy your package hideshow.el Version 5.24 2001/02/13 ;; a lot and I've been looking for the following functionality: @@ -83,28 +85,16 @@ ;; Hideshow provides the following user options: ;; ;; - `hs-hide-comments-when-hiding-all' -;; If non-nil, `hs-hide-all', `hs-cycle' and `hs-hide-level' will hide -;; comments too. ;; - `hs-hide-all-non-comment-function' -;; If non-nil, after calling `hs-hide-all', this function is called -;; with no arguments. ;; - `hs-isearch-open' -;; What kind of hidden blocks to open when doing isearch. ;; - `hs-set-up-overlay' -;; Function called with one arg (an overlay), intended to customize -;; the block hiding appearance. ;; - `hs-display-lines-hidden' -;; Displays the number of hidden lines next to the ellipsis. ;; - `hs-show-indicators' -;; Display indicators to show and toggle the block hiding. ;; - `hs-indicator-type' -;; Which indicator type should be used for the block indicators. ;; - `hs-indicator-maximum-buffer-size' -;; Max buffer size in bytes where the indicators should be enabled. ;; - `hs-allow-nesting' -;; If non-nil, hiding remembers internal blocks. ;; - `hs-cycle-filter' -;; Control where typing a `TAB' cycles the visibility. +;; - `hs-indentation-respect-end-block' ;; ;; The variable `hs-hide-all-non-comment-function' may be useful if you ;; only want to hide some N levels blocks for some languages/files or @@ -340,6 +330,7 @@ If non-nil, `hs-hide-all', `hs-cycle' and `hs-hide-level' will hide comments too." :type 'boolean) +;; This is only intended for backward compatibility (bug#80455) (defcustom hs-hide-block-behavior 'after-bol "How hideshow should hide a block. If set to `after-bol', hide the innermost block to which the current @@ -347,8 +338,8 @@ line belongs. If set to `after-cursor', hide the block after cursor position. -This only has effect in `hs-hide-block' and `hs-toggle-hiding' -commands." +This only has effect in `hs-hide-block', `hs-cycle', `hs-hide-level' and +`hs-toggle-hiding' commands." :type '(choice (const :tag "Hide the block after cursor" after-cursor) @@ -458,10 +449,7 @@ Currently it affects only the command `hs-toggle-hiding' by default, but it can be easily replaced with the command `hs-cycle'." :type `(choice (const :tag "Nowhere" nil) (const :tag "Everywhere on the headline" t) - (const :tag "At block beginning" - ,(lambda () - (pcase-let ((`(,beg ,end) (hs-block-positions))) - (and beg (hs-hideable-region-p beg end))))) + (const :tag "At block beginning" hs-hideable-block-p) (const :tag "At line beginning" bolp) (const :tag "Not at line beginning" ,(lambda () (not (bolp)))) @@ -469,6 +457,18 @@ but it can be easily replaced with the command `hs-cycle'." (function :tag "Custom filter function")) :version "31.1") +;; Used in `hs-indentation-mode' +(defcustom hs-indentation-respect-end-block nil + "If non-nil, the end of the block will not be hidden. +This only has effect if `hs-indentation-mode' is enabled. + +NOTE: For some modes, enabling this may result in hiding wrong parts of +the buffer. If this happens, enable this only for some modes (usually +using `add-hook')." + :type 'boolean + :local t + :version "31.1") + ;;;; Icons (define-icon hs-indicator-hide nil @@ -616,6 +616,9 @@ Note that `mode-line-format' is buffer-local.") ;; Used in `hs-toggle-all' (defvar-local hs--toggle-all-state) +;; Used in `hs-indentation-mode' +(defvar-local hs-indentation--store-vars nil) + ;;;; API variables @@ -788,6 +791,17 @@ Skip \"internal\" overlays if `hs-allow-nesting' is non-nil." (and beg end (< beg (save-excursion (goto-char end) (pos-bol))))) +(defun hs-hideable-block-p (&optional include-comment) + "Return t if block at point is hideable. +If INCLUDE-COMMENT is non-nil, include comments first. + +If there is no block at point, return nil." + (pcase-let ((`(,beg ,end) + (or (and include-comment + (funcall hs-inside-comment-predicate)) + (hs-block-positions)))) + (hs-hideable-region-p beg end))) + (defun hs-already-hidden-p () "Return non-nil if point is in an already-hidden block, otherwise nil." (save-excursion @@ -820,14 +834,13 @@ This is for code block positions only, for comments use (save-match-data (save-excursion (when (funcall hs-looking-at-block-start-predicate) - (let* ((beg (match-end 0)) end) + (let ((beg (match-end 0)) end) ;; `beg' is the point at the block beginning, which may need ;; to be adjusted (when adjust-beg - (setq beg (pos-eol)) - (save-excursion - (when hs-adjust-block-beginning-function - (goto-char (funcall hs-adjust-block-beginning-function beg))))) + (setq beg (if hs-adjust-block-beginning-function + (funcall hs-adjust-block-beginning-function beg) + (pos-eol)))) (goto-char (match-beginning hs-block-start-mdata-select)) (condition-case _ @@ -897,13 +910,9 @@ If INCLUDE-COMMENTS is non-nil, also search for a comment block." (funcall hs-find-next-block-function regexp (pos-eol) include-comments) (save-excursion (goto-char (match-beginning 0)) - (pcase-let ((`(,beg ,end) - (or (and include-comments - (funcall hs-inside-comment-predicate)) - (hs-block-positions)))) - (if (and beg (hs-hideable-region-p beg end)) - (setq exit (point)) - t))))) + (if (hs-hideable-block-p include-comments) + (setq exit (point)) + t)))) (unless exit (goto-char bk-point)) exit)) @@ -930,10 +939,9 @@ Intended to be used in commands." (goto-char pos) t) - ((and (or (funcall hs-looking-at-block-start-predicate) - (and (forward-line 0) - (funcall hs-find-block-beginning-function))) - (apply #'hs-hideable-region-p (hs-block-positions))) + ((and (or (hs-hideable-block-p) + (and (funcall hs-find-block-beginning-function) + (hs-hideable-block-p)))) t)))) (defun hs-hide-level-recursive (arg beg end &optional include-comments func progress) @@ -1268,7 +1276,7 @@ region (point BOUND)." Return point, or nil if original point was not in a block." (let ((here (point)) done) ;; look if current line is block start - (if (funcall hs-looking-at-block-start-predicate) + (if (hs-hideable-block-p) here ;; look backward for the start of a block that contains the cursor (save-excursion @@ -1276,8 +1284,8 @@ Return point, or nil if original point was not in a block." (goto-char (match-beginning 0)) ;; go again if in a comment or a string (or (save-match-data (nth 8 (syntax-ppss))) - (not (setq done (and (<= here (cadr (hs-block-positions))) - (point)))))))) + (not (setq done (pcase-let ((`(_ ,end) (hs-block-positions))) + (and end (<= here end) (point))))))))) (when done (goto-char done))))) ;; This function is not used anymore (Bug#700). @@ -1478,6 +1486,61 @@ only blocks which are that many levels below the level of point." (hs-hide-all)) (setq-local hs--toggle-all-state (not hs--toggle-all-state))) +;;;###autoload +(define-minor-mode hs-indentation-mode + "Toggle indentation-based hiding/showing." + :group 'hideshow + (if hs-indentation-mode + (progn + (setq hs-indentation--store-vars + (buffer-local-set-state + hs-forward-sexp-function + (lambda (_) + (let ((size (current-indentation)) end) + (save-match-data + (save-excursion + (forward-line 1) ; Start from next line + (while (and (not (eobp)) + (re-search-forward hs-block-start-regexp nil t) + (> (current-indentation) size)) + (setq end (point)) + (forward-line 1)))) + (when end (goto-char end) (end-of-line)))) + hs-block-start-regexp (rx (0+ blank) (1+ nonl)) + hs-block-end-regexp nil + hs-adjust-block-end-function + ;; Adjust line to the "end of the block" (Usually this is + ;; the next line after the position by + ;; `hs-forward-sexp-function' with the same indentation + ;; level as the block start) + (if hs-indentation-respect-end-block + (lambda (beg) + (save-excursion + (when (and (not (eobp)) + (forward-line 1) + (not (looking-at-p (rx (0+ blank) eol))) + (= (current-indentation) + (save-excursion + (goto-char beg) + (current-indentation))) + (progn (back-to-indentation) + (not (hs-hideable-block-p)))) + (point)))) + hs-adjust-block-end-function) + ;; Set the other variables to their default values + hs-looking-at-block-start-predicate #'hs-looking-at-block-start-p--default + hs-find-next-block-function #'hs-find-next-block-fn--default + hs-find-block-beginning-function #'hs-find-block-beg-fn--default + hs-c-start-regexp (string-trim-right (regexp-quote comment-start)))) + ;; Refresh indicators (if needed) + (when (and hs-show-indicators hs-minor-mode) + (hs-minor-mode -1) + (hs-minor-mode +1))) + (buffer-local-restore-state hs-indentation--store-vars) + (when (and hs-show-indicators hs-minor-mode) + (hs-minor-mode -1) + (hs-minor-mode +1)))) + ;;;###autoload (define-minor-mode hs-minor-mode "Minor mode to selectively hide/show code and comment blocks. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 44c54a60757..a5e1d8ac023 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -849,7 +849,7 @@ macro as normal text." (search-failed (goto-char saved-point) (unless noerror - (signal (car err) (cdr err))))))) + (signal err)))))) (defun js--re-search-backward-inner (regexp &optional bound count) diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index d5e1dc39790..18800e29aa5 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -995,7 +995,7 @@ directory and makes this the current buffer's default directory." (progn (cd (car inferior-octave-output-list)) t) - (error (unless noerror (signal (car err) (cdr err)))))) + (error (unless noerror (signal err))))) (defcustom inferior-octave-minimal-columns 80 "The minimal column width for the inferior Octave process." diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index f4d2c499d7a..ebf8df9f795 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1738,9 +1738,10 @@ This command is intended to be bound to a mouse event." ;; ;; TODO: Add some kind of hovering indication that a identifier under ;; the mouse cursor has a definition we could jump to. - "C-" #'xref-find-definitions-at-mouse - "C-" #'xref-find-definitions-at-mouse - "C-" #'xref-find-definitions-at-mouse) + + ;; Don't run `mouse-buffer-menu' on the down event. + "C-" #'ignore + "C-" #'xref-find-definitions-at-mouse) ;;;###autoload (define-minor-mode xref-mouse-mode @@ -1754,11 +1755,6 @@ all buffers." xref-mouse-mode xref-mouse-mode :version "31.1") -;; ;;;##autoload -;; (add-to-list -;; 'emulation-mode-map-alists ;since we are "emulating" other conventions -;; `((xref-mouse-mode . ,xref-mouse-mode-map))) - (declare-function apropos-parse-pattern "apropos" (pattern &optional do-all)) ;;;###autoload diff --git a/lisp/savehist.el b/lisp/savehist.el index 03f0889ef58..8f46adbeb95 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -235,7 +235,7 @@ Be careful to do it while preserving the current history data." ;; effectively destroy the user's data at the next save. (setq savehist-mode nil) (savehist-uninstall) - (signal (car errvar) (cdr errvar)))) + (signal errvar))) ;; In case we're loading the file late, there was info in the history ;; variables that may have been overwritten by the info extracted from diff --git a/lisp/simple.el b/lisp/simple.el index b0669d674ee..ff7ffafa3a1 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3397,7 +3397,7 @@ Go to the history element by the absolute history position HIST-POS." The same as `command-error-default-function' but display error messages at the end of the minibuffer using `minibuffer-message' to not obscure the minibuffer contents." - (if (memq 'minibuffer-quit (get (car data) 'error-conditions)) + (if (error-has-type-p data 'minibuffer-quit) (ding t) (discard-input) (ding)) @@ -9528,7 +9528,7 @@ This highlighting uses the `blink-matching-paren-offscreen' face." :group 'paren-blinking) (defface blink-matching-paren-offscreen - '((t :foreground "green")) + '((t :inherit show-paren-match)) "Face for showing in the echo area matched open paren that is off-screen. This face is used only when `blink-matching-paren-highlight-offscreen' is non-nil." @@ -9689,21 +9689,12 @@ face if `blink-matching-paren-highlight-offscreen' is non-nil." (lambda (region) (buffer-substring (car region) (cdr region))) regions - "...")) - (openparen-next-char-idx (1+ openparen-idx))) - (concat - (substring line-string - 0 openparen-idx) - (let ((matched-offscreen-openparen - (substring line-string - openparen-idx openparen-next-char-idx))) - (if blink-matching-paren-highlight-offscreen - (propertize - (substring-no-properties matched-offscreen-openparen) - 'face 'blink-matching-paren-offscreen) - matched-offscreen-openparen)) - (substring line-string - openparen-next-char-idx)))))) + "..."))) + (when blink-matching-paren-highlight-offscreen + (add-face-text-property openparen-idx (1+ openparen-idx) + 'blink-matching-paren-offscreen + nil line-string)) + line-string)))) (defvar blink-paren-function 'blink-matching-open "Function called, if non-nil, whenever a close parenthesis is inserted. diff --git a/lisp/startup.el b/lisp/startup.el index 9c1eafdae07..adaea013604 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1123,15 +1123,12 @@ init-file, or to a default value if loading is not possible." (display-warning 'initialization (format-message "\ -An error occurred while loading `%s':\n\n%s%s%s\n\n\ +An error occurred while loading `%s':\n\n%s\n\n\ To ensure normal operation, you should investigate and remove the cause of the error in your initialization file. Start Emacs with the `--debug-init' option to view a complete error backtrace." user-init-file - (get (car error) 'error-message) - (if (cdr error) ": " "") - (mapconcat (lambda (s) (prin1-to-string s t)) - (cdr error) ", ")) + (error-message-string error)) :warning) (setq init-file-had-error t)))))) @@ -1591,17 +1588,7 @@ please check its value") ;; If there was an error, print the error message and exit. (error (princ - (if (eq (car error) 'error) - (apply #'concat (cdr error)) - (if (memq 'file-error (get (car error) 'error-conditions)) - (format "%s: %s" - (nth 1 error) - (mapconcat (lambda (obj) (prin1-to-string obj t)) - (cdr (cdr error)) ", ")) - (format "%s: %s" - (get (car error) 'error-message) - (mapconcat (lambda (obj) (prin1-to-string obj t)) - (cdr error) ", ")))) + (error-message-string error) 'external-debugging-output) (terpri 'external-debugging-output) (setq initial-window-system nil) diff --git a/lisp/subr.el b/lisp/subr.el index 69b25c7baca..a1d718ca5b7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -568,8 +568,36 @@ Defaults to `error'." (cons parent (get parent 'error-conditions))))) (put name 'error-conditions (delete-dups (copy-sequence (cons name conditions)))) + ;; FIXME: Make `error-message-string' more flexible, e.g. allow + ;; the message to be specified by a `format' string or a function. (when message (put name 'error-message message)))) +(defun error-type-p (symbol) + "Return non-nil if SYMBOL is a condition type." + (get symbol 'error-conditions)) + +(defun error--p (object) + "Return non-nil if OBJECT looks like a valid error descriptor." + (let ((type (car-safe object))) + (and type (symbolp type) (listp (cdr object)) + (error-type-p type)))) + +(defalias 'error-type #'car + "Return the symbol which represents the type of ERROR. +\n(fn ERROR)") + +(defun error-has-type-p (error condition) + "Return non-nil if ERROR is of type CONDITION (or a subtype of it)." + (unless (error--p error) + (signal 'wrong-type-argument (list #'error--p error))) + (or (eq condition t) + (memq condition (get (car error) 'error-conditions)))) + +(defalias 'error-slot-value #'elt + "Access the SLOT of object ERROR. +Slots are specified by position, and slot 0 is the error symbol. +\n(fn ERROR SLOT)") + ;; We put this here instead of in frame.el so that it's defined even on ;; systems where frame.el isn't loaded. (defun frame-configuration-p (object) @@ -1198,7 +1226,8 @@ with (member-if (lambda (x) (foo (bar x))) items)" (declare (compiler-macro (lambda (_) - `(drop-while (lambda (x) (not (funcall ,pred x))) ,list)))) + (let ((x (make-symbol "x"))) + `(drop-while (lambda (,x) (not (funcall ,pred ,x))) ,list))))) (drop-while (lambda (x) (not (funcall pred x))) list)) ;; This is good to have for improved readability in certain uses, but @@ -7795,6 +7824,18 @@ not a list, return a one-element list containing OBJECT." object (list object))) +(defun ensure-proper-list (object) + "Return OBJECT as a list. +If OBJECT is already a proper list, return OBJECT itself. If it's not a +proper list, return a one-element list containing OBJECT. + +`ensure-list' is usually preferable because that function runs in +constant time, but this one has to traverse the whole of OBJECT." + (declare (side-effect-free error-free)) + (if (proper-list-p object) + object + (list object))) + (defmacro with-delayed-message (args &rest body) "Like `progn', but display MESSAGE if BODY takes longer than TIMEOUT seconds. The MESSAGE form will be evaluated immediately, but the resulting diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 4cc090bca94..ad749557987 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -3137,10 +3137,7 @@ files will be visited." (interactive (find-file-read-args "Find file read-only in other tab: " (confirm-nonexistent-file-or-buffer))) - (find-file--read-only (lambda (filename wildcards) - (window-buffer - (find-file-other-tab filename wildcards))) - filename wildcards)) + (find-file--read-only #'find-file-other-tab filename wildcards)) (defun other-tab-prefix () "Display the buffer of the next command in a new tab. diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 8cad7472089..e7400e81e00 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -879,7 +879,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;; tar data. Rather than show a mysterious empty buffer, let's ;; revert to fundamental-mode. (fundamental-mode) - (signal (car err) (cdr err))))) + (signal err)))) (autoload 'woman-tar-extract-file "woman" "In tar mode, run the WoMan man-page browser on this file." t) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 734eeaedaa2..028bba86d2c 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -404,10 +404,12 @@ like \"Some." (defun flyspell-generic-progmode-verify () "Used for `flyspell-generic-check-word-predicate' in programming modes." - (unless (eql (point) (point-min)) - ;; (point) is next char after the word. Must check one char before. - (let ((f (get-text-property (1- (point)) 'face))) - (memq f flyspell-prog-text-faces)))) + (cl-flet ((has-prog-face (pos) (memq (get-text-property pos 'face) + flyspell-prog-text-faces))) + ;; Point might be in front of, inside, or behind the misspelled word + (or (has-prog-face (point)) ; check char after point + (and (not (eql (point) (point-min))) + (has-prog-face (1- (point))))))) ; check char before point ;;;###autoload (defun flyspell-prog-mode () diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 9385207f767..86a4b1d006e 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1874,7 +1874,7 @@ Mark is left at original location." (progn (latex-backward-sexp-1) (1+ arg))))) (scan-error (goto-char pos) - (signal (car err) (cdr err)))))) + (signal err))))) (defun latex-syntax-after () "Like (char-syntax (char-after)) but aware of multi-char elements." diff --git a/lisp/transient.el b/lisp/transient.el index a7e2e5daa23..e77fef1f98a 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -64,7 +64,7 @@ ,(macroexp-progn body)) ((debug error) (transient--emergency-exit ,id) - (signal (car err) (cdr err))))) + (signal err)))) (defun transient--exit-and-debug (&rest args) (transient--emergency-exit :debugger) diff --git a/lisp/type-break.el b/lisp/type-break.el index 440a7136f1d..d71b41da531 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -1025,7 +1025,7 @@ With optional non-nil ALL, force redisplay of all mode-lines." (setq continue nil) (and (get-buffer "*Life*") (kill-buffer "*Life*")) - (condition-case () + (condition-case err (progn (life 3) ;; wait for user to return @@ -1033,7 +1033,7 @@ With optional non-nil ALL, force redisplay of all mode-lines." (type-break-catch-up-event) (kill-buffer "*Life*")) (life-extinct - (message "%s" (get 'life-extinct 'error-message)) + (message "%s" (error-message-string err)) ;; restart demo (setq continue t)) (quit diff --git a/lisp/use-package/use-package-core.el b/lisp/use-package/use-package-core.el index 39b8f6969f4..75ac7ada8a7 100644 --- a/lisp/use-package/use-package-core.el +++ b/lisp/use-package/use-package-core.el @@ -1796,7 +1796,7 @@ node `(use-package) Creating an extension'." (pcase arg ((or 'nil 't) (list name)) ; guess name ((pred symbolp) (list arg)) ; use this name - ((pred stringp) (list name arg)) ; version string + guess name + ((pred stringp) (list name (list :url arg))) ; URL + guess name (`(,(pred keywordp) . ,(pred listp)) ; list + guess name (use-package-normalize--vc-arg (cons name arg))) (`(,(pred symbolp) . ,(or (pred listp) ; list/version string + name diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 559310ff770..8a432a7f618 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -535,18 +535,46 @@ use the face `diff-removed' for removed lines, and the face (group (any "<-")) (group (zero-or-more nonl) "\n"))) +(defvar-local diff--git-preamble-overlay nil) +(defvar-local diff--git-footer-overlay nil) + (defun diff--git-preamble-end () - (save-excursion - (goto-char (point-min)) - (re-search-forward "^diff --git .+ .+$" nil t) - (forward-line 2) - (point))) + (unless (and diff--git-preamble-overlay + (overlay-buffer diff--git-preamble-overlay)) + (save-excursion + (goto-char (point-min)) + (let ((found (re-search-forward "^diff --git .+ .+$" nil 'move))) + (forward-line 2) + (if diff--git-preamble-overlay + (move-overlay diff--git-preamble-overlay (point-min) (point)) + (let ((ol (make-overlay (point-min) (point)))) + (overlay-put ol 'modification-hooks + (lambda (&rest _) (delete-overlay ol))) + (overlay-put ol 'evaporate t) + (setq diff--git-preamble-overlay ol))) + (overlay-put diff--git-preamble-overlay 'diff--found found)))) + (if (not (overlay-get diff--git-preamble-overlay 'diff--found)) + (point-min) + (overlay-end diff--git-preamble-overlay))) (defun diff--git-footer-start () - (save-excursion - (goto-char (point-max)) - (re-search-backward "^-- $" nil t) - (point))) + (unless (and diff--git-footer-overlay + (overlay-buffer diff--git-footer-overlay)) + (save-excursion + (goto-char (point-max)) + (let ((found (re-search-backward "\n-- $" nil 'move))) + (if diff--git-footer-overlay + (move-overlay diff--git-footer-overlay + (match-beginning 0) (point-max)) + (let ((ol (make-overlay (match-beginning 0) (point-max) nil t t))) + (overlay-put ol 'modification-hooks + (lambda (&rest _) (delete-overlay ol))) + (overlay-put ol 'evaporate t) + (setq diff--git-footer-overlay ol))) + (overlay-put diff--git-footer-overlay 'diff--found found)))) + (if (not (overlay-get diff--git-footer-overlay 'diff--found)) + (point-max) + (1+ (overlay-start diff--git-footer-overlay)))) (defun diff--indicator-matcher-helper (limit regexp) "Fontify added/removed lines from point to LIMIT using REGEXP. @@ -981,7 +1009,7 @@ data such as \"Index: ...\" and such." ;; File starts *after* the starting point: we really weren't in ;; a file diff but elsewhere. (goto-char orig) - (signal (car err) (cdr err))))) + (signal err)))) (defun diff-file-kill (&optional delete) "Kill current file's hunks. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 91be4fa5b66..bdbb021626f 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1137,49 +1137,41 @@ Its appearance is controlled by the face `smerge-refine-shadow-cursor'." The presence of the shadow cursor depends on the variable `smerge-refine-shadow-cursor'.") -(defun smerge--refine-prepare-regions ( beg1 end1 beg2 end2 - preproc props-c props-r props-a) - (let* ((file1 (make-temp-file "diff1")) - (file2 (make-temp-file "diff2")) - (smerge--refine-long-words - (if smerge-refine-weight-hack (make-hash-table :test #'equal))) - - ;; Cover the two regions with one `smerge--refine-region' overlay each. - (ol1 (make-overlay beg1 end1 (if (markerp beg1) (marker-buffer beg1)) - ;; Make it shrink rather than spread when editing. - 'front-advance nil)) - (ol2 (make-overlay beg2 end2 (if (markerp beg2) (marker-buffer beg2)) - ;; Make it shrink rather than spread when editing. - 'front-advance nil)) - (common-props - (let ((props '((evaporate . t) (smerge--refine-region . t) - (cursor-sensor-functions - smerge--refine-shadow-cursor)))) - (dolist (prop (or props-a props-c)) - (when (and (not (memq (car prop) '(face font-lock-face))) - (member prop (or props-r props-c)) - (or (not (and props-c props-a props-r)) - (member prop props-c))) - ;; This PROP is shared among all those overlays. - ;; Better keep it also for the `smerge--refine-region' - ;; overlays, so the client package recognizes them as - ;; being part of the refinement (e.g. it will hopefully - ;; delete them like the others). - (push prop props))) - props))) - +(defun smerge--refine-set-overlay-props (ol1 ol2 props-c props-r props-a) + (let ((common-props + (let ((props '((evaporate . t) (smerge--refine-region . t) + (cursor-sensor-functions + smerge--refine-shadow-cursor)))) + (dolist (prop (or props-a props-c)) + (when (and (not (memq (car prop) '(face font-lock-face))) + (member prop (or props-r props-c)) + (or (not (and props-c props-a props-r)) + (member prop props-c))) + ;; This PROP is shared among all those overlays. + ;; Better keep it also for the `smerge--refine-region' + ;; overlays, so the client package recognizes them as + ;; being part of the refinement (e.g. it will hopefully + ;; delete them like the others). + (push prop props))) + props))) (when smerge-refine-shadow-cursor (cursor-sensor-mode 1)) (dolist (prop common-props) (overlay-put ol1 (car prop) (cdr prop)) - (overlay-put ol2 (car prop) (cdr prop))) + (overlay-put ol2 (car prop) (cdr prop))))) + +(defun smerge--refine-prepare-regions (ol1 ol2 preproc) + (let* ((file1 (make-temp-file "diff1")) + (file2 (make-temp-file "diff2")) + (smerge--refine-long-words + (if smerge-refine-weight-hack (make-hash-table :test #'equal)))) (let ((write-region-inhibit-fsync t)) ; Don't fsync temp files (Bug#12747). ;; Chop up regions into smaller elements and save into files. (smerge--refine-chopup-region ol1 file1 preproc) (smerge--refine-chopup-region ol2 file2 preproc)) - `(,file1 ,ol1 ,file2 ,ol2))) + `(,file1 ,file2))) ;;;###autoload (defun smerge-refine-regions (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a) @@ -1199,9 +1191,15 @@ used to replace chars to try and eliminate some spurious differences. The two regions can be in different buffers (in which case, BEG1 and BEG2 need to be markers to indicate the corresponding buffers)." (pcase-let* - ((`(,file1 ,ol1 ,file2 ,ol2) - (smerge--refine-prepare-regions beg1 end1 beg2 end2 - preproc props-c props-r props-a))) + ;; Cover the two regions with one `smerge--refine-region' overlay each. + ((ol1 (make-overlay beg1 end1 (if (markerp beg1) (marker-buffer beg1)) + ;; Make it shrink rather than spread when editing. + 'front-advance nil)) + (ol2 (make-overlay beg2 end2 (if (markerp beg2) (marker-buffer beg2)) + ;; Make it shrink rather than spread when editing. + 'front-advance nil)) + (`(,file1 ,file2) (smerge--refine-prepare-regions ol1 ol2 preproc))) + (smerge--refine-set-overlay-props ol1 ol2 props-c props-r props-a) ;; Call diff on those files. (with-temp-buffer @@ -1480,7 +1478,7 @@ region, or with a numeric prefix. By default it uses a numeric prefix of 1." ;; conflicts instead! (condition-case err (smerge-match-conflict) - (error (if (not (markerp otherpos)) (signal (car err) (cdr err)) + (error (if (not (markerp otherpos)) (signal err) (goto-char (prog1 otherpos (setq otherpos (point-marker)))) (smerge-match-conflict)))) (let ((beg (match-beginning 0)) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 0d8e1dd0350..37d2bc3612f 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2045,7 +2045,7 @@ After check-out, runs the normal hook `vc-checkout-hook'." (when t (let ((buf (get-file-buffer file))) (when buf (with-current-buffer buf (read-only-mode -1))))) - (signal (car err) (cdr err)))) + (signal err))) `((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit) nil) 'up-to-date @@ -3581,8 +3581,8 @@ BACKEND is the VC backend." (condition-case err (vc-call-backend backend 'root default-directory) (vc-not-supported - (unless (eq (cadr err) 'root) - (signal (car err) (cdr err))) + (unless (eq (error-slot-value err 1) 'root) + (signal err)) nil)))) ;;;###autoload @@ -4695,7 +4695,7 @@ tip revision are merged into the working file." (and-let* ((fileset (vc-deduce-fileset 'not-state-changing 'allow-unregistered))) (vc-find-backend-function (car fileset) 'pull))) - (signal (car ret) (cdr ret)))) + (signal ret))) (:success (setq backend (car ret) files (cadr ret) fn (vc-find-backend-function backend 'pull)))) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 2e89d2ae977..9eb88eb35d0 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -904,7 +904,12 @@ of the list is negated if it begins with `not'. For example: (c-mode c++-mode) means that `whitespace-mode' is turned on for buffers in C and -C++ modes only." +C++ modes only. + +Global `whitespace-mode' will not automatically turn on in internal +buffers (with name starting from space) and special buffers (with name +starting from \"*\"), except \"*scratch*\" buffer. Use +`whitespace-global-mode-buffers' to customize this behavior." :type '(choice :tag "Global Modes" (const :tag "None" nil) (const :tag "All" t) @@ -914,6 +919,12 @@ C++ modes only." (repeat :inline t (symbol :tag "Mode"))))) +(defcustom whitespace-global-mode-buffers (list (regexp-quote "*scratch*")) + "Buffer name regexps where global `whitespace-mode' can be auto-enabled. +The value is a list of regexps. Set this custom option when you need +`whitespace-mode' in special buffers like *Org Src*." + :type '(list (regexp :tag "Regexp matching buffer name")) + :version "31.1") (defcustom whitespace-action nil "Specify which action is taken when a buffer is visited or written. @@ -1042,7 +1053,10 @@ See also `whitespace-newline' and `whitespace-display-mappings'." ;; ...the buffer is not special (name starts with *) (or (not (eq (aref (buffer-name) 0) ?*)) ;; except the scratch buffer. - (string= (buffer-name) "*scratch*")))) + (seq-find + (lambda (re) + (string-match-p re (buffer-name))) + whitespace-global-mode-buffers)))) "Predicate to decide which buffers obey `global-whitespace-mode'. This function is called with no argument and should return non-nil if the current buffer should obey `global-whitespace-mode'. diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 2930cc195ef..67c475d563a 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -529,9 +529,10 @@ enable, ?l to disable)." (condition-case err (send-string-to-terminal enable terminal) ;; FIXME: This should use a dedicated error signal. - (error (if (equal (cadr err) "Terminal is currently suspended") + (error (if (equal (error-slot-value err 1) + "Terminal is currently suspended") nil ; The sequence will be sent upon resume. - (signal (car err) (cdr err))))) + (signal err)))) (push enable (terminal-parameter nil 'tty-mode-set-strings)) (push disable (terminal-parameter nil 'tty-mode-reset-strings)) (set-terminal-parameter terminal 'xterm-mouse-mode t) @@ -553,9 +554,10 @@ enable, ?l to disable)." (send-string-to-terminal xterm-mouse-tracking-disable-sequence terminal) ;; FIXME: This should use a dedicated error signal. - (error (if (equal (cadr err) "Terminal is currently suspended") + (error (if (equal (error-slot-value err 1) + "Terminal is currently suspended") nil - (signal (car err) (cdr err))))) + (signal err)))) (setf (terminal-parameter nil 'tty-mode-set-strings) (remq xterm-mouse-tracking-enable-sequence (terminal-parameter nil 'tty-mode-set-strings))) diff --git a/src/character.c b/src/character.c index 95af6c3eb0c..6347617d508 100644 --- a/src/character.c +++ b/src/character.c @@ -637,8 +637,8 @@ str_as_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t nbytes, c = BYTE8_TO_CHAR (c); to += CHAR_STRING (c, to); } + chars++; } - chars++; } while (p < endp) { diff --git a/src/charset.c b/src/charset.c index ed912f7b8be..041f350cf8e 100644 --- a/src/charset.c +++ b/src/charset.c @@ -61,16 +61,8 @@ along with GNU Emacs. If not, see . */ charset symbols, and values are vectors of charset attributes. */ Lisp_Object Vcharset_hash_table; -/* Table of struct charset. */ -struct charset *charset_table; -int charset_table_size; -int charset_table_used; - -/* Table of attribute vectors. charset_attributes_table[id] contains - the attribute vector for the charset at charset_table[id]. - - This is a separate vector to simplify GC. */ -Lisp_Object charset_attributes_table; +/* The table of all charsets. */ +struct charset_table charset_table; /* Special charsets corresponding to symbols. */ int charset_ascii; @@ -1129,50 +1121,44 @@ usage: (define-charset-internal ...) */) else { hash_put (hash_table, args[charset_arg_name], attrs, hash_code); - if (charset_table_used == charset_table_size) + if (charset_table.used == charset_table.size) { /* Ensure that charset IDs fit into 'int' as well as into the restriction imposed by fixnums. Although the 'int' restriction could be removed, too much other code would need altering; for example, the IDs are stuffed into struct coding_system.charbuf[i] entries, which are 'int'. */ - int old_size = charset_table_size; + int old_size = charset_table.size; ptrdiff_t new_size = old_size; struct charset *new_table = xpalloc (0, &new_size, 1, min (INT_MAX, MOST_POSITIVE_FIXNUM), - sizeof *charset_table); - memcpy (new_table, charset_table, + sizeof *charset_table.start); + memcpy (new_table, charset_table.start, old_size * sizeof *new_table); - charset_table = new_table; - charset_table_size = new_size; + xfree (charset_table.start); + charset_table.start = new_table; + charset_table.size = new_size; Lisp_Object new_attr_table = make_vector (new_size, Qnil); for (size_t i = 0; i < old_size; i++) ASET (new_attr_table, i, - AREF (charset_attributes_table, i)); - charset_attributes_table = new_attr_table; - /* FIXME: This leaks memory, as the old charset_table becomes - unreachable. If the old charset table is charset_table_init - then this leak is intentional; otherwise, it's unclear. - If the latter memory leak is intentional, a - comment should be added to explain this. If not, the old - charset_table should be freed, by passing it as the 1st argument - to xpalloc and removing the memcpy. */ + AREF (charset_table.attributes_table, i)); + charset_table.attributes_table = new_attr_table; } - id = charset_table_used++; + id = charset_table.used++; new_definition_p = 1; } ASET (attrs, charset_id, make_fixnum (id)); charset.id = id; - charset_table[id] = charset; - ASET (charset_attributes_table, id, attrs); - eassert (ASIZE (charset_attributes_table) == charset_table_size); + charset_table.start[id] = charset; + ASET (charset_table.attributes_table, id, attrs); + eassert (ASIZE (charset_table.attributes_table) == charset_table.size); if (charset.method == CHARSET_METHOD_MAP) { load_charset (&charset, 0); - charset_table[id] = charset; + charset_table.start[id] = charset; } if (charset.iso_final >= 0) @@ -1567,7 +1553,7 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) from_byte = CHAR_TO_BYTE (from); - charsets = make_nil_vector (charset_table_used); + charsets = make_nil_vector (charset_table.used); while (1) { find_charsets_in_text (BYTE_POS_ADDR (from_byte), stop - from, @@ -1583,9 +1569,9 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) } val = Qnil; - for (i = charset_table_used - 1; i >= 0; i--) + for (i = charset_table.used - 1; i >= 0; i--) if (!NILP (AREF (charsets, i))) - val = Fcons (CHARSET_NAME (charset_table + i), val); + val = Fcons (CHARSET_NAME (charset_table.start + i), val); return val; } @@ -1600,14 +1586,14 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) { CHECK_STRING (str); - Lisp_Object charsets = make_nil_vector (charset_table_used); + Lisp_Object charsets = make_nil_vector (charset_table.used); find_charsets_in_text (SDATA (str), SCHARS (str), SBYTES (str), charsets, table, STRING_MULTIBYTE (str)); Lisp_Object val = Qnil; - for (int i = charset_table_used - 1; i >= 0; i--) + for (int i = charset_table.used - 1; i >= 0; i--) if (!NILP (AREF (charsets, i))) - val = Fcons (CHARSET_NAME (charset_table + i), val); + val = Fcons (CHARSET_NAME (charset_table.start + i), val); return val; } @@ -2118,28 +2104,30 @@ DIMENSION, CHARS, and FINAL-CHAR. */) return (id >= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id)) : Qnil); } -/* Shrink charset_table to charset_table_used. */ +/* Shrink charset_table to charset_table.used. */ static void shrink_charset_table (void) { - eassert (charset_table_size >= charset_table_used); - eassert (ASIZE (charset_attributes_table) == charset_table_size); + eassert (charset_table.size >= charset_table.used); + eassert (ASIZE (charset_table.attributes_table) + == charset_table.size); - struct charset *old = charset_table; - size_t nbytes = charset_table_used * sizeof *old; - struct charset *new = xmalloc (nbytes); - memcpy (new, old, nbytes); - charset_table = new; - xfree (old); + if (charset_table.size > charset_table.used) + { + eassert (!pdumper_object_p (charset_table.start)); + charset_table.start + = xnrealloc (charset_table.start, charset_table.used, + sizeof *charset_table.start); - Lisp_Object new_attr_table = make_vector (charset_table_used, Qnil); - for (size_t i = 0; i < charset_table_used; i++) - ASET (new_attr_table, i, AREF (charset_attributes_table, i)); - charset_attributes_table = new_attr_table; + charset_table.attributes_table + = Fvector (charset_table.used, + xvector_contents (charset_table.attributes_table)); - charset_table_size = charset_table_used; - - eassert (ASIZE (charset_attributes_table) == charset_table_size); + charset_table.size = charset_table.used; + } + eassert (charset_table.size == charset_table.used); + eassert (ASIZE (charset_table.attributes_table) + == charset_table.size); } DEFUN ("clear-charset-maps", Fclear_charset_maps, Sclear_charset_maps, @@ -2409,16 +2397,17 @@ syms_of_charset (void) staticpro (&Vcharset_hash_table); Vcharset_hash_table = CALLN (Fmake_hash_table, QCtest, Qeq); - charset_table_size = CHARSET_TABLE_INIT_SIZE; - PDUMPER_REMEMBER_SCALAR (charset_table_size); - charset_table - = xmalloc (charset_table_size * sizeof *charset_table); - charset_table_used = 0; - PDUMPER_REMEMBER_SCALAR (charset_table_used); + charset_table.size = CHARSET_TABLE_INIT_SIZE; + PDUMPER_REMEMBER_SCALAR (charset_table.size); + charset_table.start + = xmalloc (charset_table.size * sizeof *charset_table.start); + charset_table.used = 0; + PDUMPER_REMEMBER_SCALAR (charset_table.used); - charset_attributes_table = make_vector (charset_table_size, Qnil); - staticpro (&charset_attributes_table); + charset_table.attributes_table + = make_vector (charset_table.size, Qnil); + staticpro (&charset_table.attributes_table); defsubr (&Scharsetp); defsubr (&Smap_charset_chars); defsubr (&Sdefine_charset_internal); diff --git a/src/charset.h b/src/charset.h index bf14b15beba..e0ffa992506 100644 --- a/src/charset.h +++ b/src/charset.h @@ -243,14 +243,28 @@ struct charset vectors. */ extern Lisp_Object Vcharset_hash_table; -/* Table of struct charset. */ -extern struct charset *charset_table; -extern int charset_table_size; -extern int charset_table_used; +/* A charset_table is an array of struct charset along with a + Lisp_Vector of charset attributes. -extern Lisp_Object charset_attributes_table; + The charset_table.start field either points to xmalloced memory or to + the dump (i.e. pdumper_object_p (charset_table.start) can be true). -#define CHARSET_FROM_ID(id) (charset_table + (id)) + charset_table.attributes_table[id] contains the attribute vector for + the charset at charset_table.start[id]. + + We keep the attributes in a separate vector because that is + convenient for the GC. (We probably need to revise this decision, if + we ever expose struct charset as a Lisp level type.) */ +struct charset_table +{ + struct charset *start; + int size, used; + Lisp_Object attributes_table; +}; + +extern struct charset_table charset_table; + +#define CHARSET_FROM_ID(id) (charset_table.start + (id)) extern Lisp_Object Vcharset_ordered_list; extern Lisp_Object Vcharset_non_preferred_head; @@ -290,8 +304,10 @@ extern int emacs_mule_charset[256]; INLINE Lisp_Object charset_attributes_getter (struct charset *charset) { - eassert (ASIZE (charset_attributes_table) == charset_table_size); - return AREF (charset_attributes_table, charset->id); + eassert (ASIZE (charset_table.attributes_table) == charset_table.size); + Lisp_Object attrs = AREF (charset_table.attributes_table, charset->id); + eassert (XFIXNUM (CHARSET_ATTR_ID (attrs)) == charset->id); + return attrs; } /* Return the attribute vector of CHARSET. */ diff --git a/src/conf_post.h b/src/conf_post.h index 826face9f74..f2cd8d6b04e 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -175,13 +175,6 @@ extern void _DebPrint (const char *fmt, ...); #endif #endif -#ifdef emacs /* Don't do this for lib-src. */ -/* Tell regex.c to use a type compatible with Emacs. */ -#define RE_TRANSLATE_TYPE Lisp_Object -#define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C) -#define RE_TRANSLATE_P(TBL) (!BASE_EQ (TBL, make_fixnum (0))) -#endif - /* Tell time_rz.c to use Emacs's getter and setter for TZ. Only Emacs uses time_rz so this is OK. */ #define getenv_TZ emacs_getenv_TZ diff --git a/src/data.c b/src/data.c index 2d00f9e67c9..16d5381ad8b 100644 --- a/src/data.c +++ b/src/data.c @@ -773,6 +773,7 @@ DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, doc: /* Empty out the value cell of SYMBOL, making it void as a variable. Return SYMBOL. +When applied to a variable alias, it undoes the `defvaralias'. If a variable is void, trying to evaluate the variable signals a `void-variable' error, instead of returning a value. For more @@ -784,7 +785,13 @@ See also `fmakunbound'. */) CHECK_SYMBOL (symbol); if (SYMBOL_CONSTANT_P (symbol)) xsignal1 (Qsetting_constant, symbol); - Fset (symbol, Qunbound); + if (XSYMBOL (symbol)->u.s.redirect == SYMBOL_VARALIAS) + { + XSYMBOL (symbol)->u.s.redirect = SYMBOL_PLAINVAL; + SET_SYMBOL_VAL (XSYMBOL (symbol), Qunbound); + } + else + Fset (symbol, Qunbound); return symbol; } diff --git a/src/emacs-module.c b/src/emacs-module.c index 3527352cec8..f471f3a1978 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -19,7 +19,7 @@ along with GNU Emacs. If not, see . */ /* The public module API is defined in the header emacs-module.h. The -configure script generates emacs-module.h from emacs-module.h.in and +configure script generates emacs-module.h from emacs-module.in.h and the version-specific environment fragments in module-env-*.h. If you want to change the module API, please abide to the following diff --git a/src/emacs-module.h.in b/src/emacs-module.in.h similarity index 100% rename from src/emacs-module.h.in rename to src/emacs-module.in.h diff --git a/src/eval.c b/src/eval.c index f2ef7e3a767..78a21bf6657 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1902,10 +1902,15 @@ probably_quit (void) unbind_to (gc_count, Qnil); } -DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, +DEFUN ("signal", Fsignal, Ssignal, 1, 2, 0, doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. This function does not return. +When signaling a new error, the DATA argument is mandatory. +When re-signaling an error to propagate it to further handlers, +DATA has to be omitted and the first argument has to be the whole +error descriptor. + When `noninteractive' is non-nil (in particular, in batch mode), an unhandled error calls `kill-emacs', which terminates the Emacs session with a non-zero exit code. @@ -1973,13 +1978,14 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable) /* FIXME: 'handler-bind' makes `signal-hook-function' obsolete? */ /* FIXME: Here we still "split" the error object into its error-symbol and its error-data? */ - calln (Vsignal_hook_function, error_symbol, data); + calln (Vsignal_hook_function, real_error_symbol, + NILP (data) && CONSP (error) ? XCDR (error) : data); unbind_to (count, Qnil); } conditions = Fget (real_error_symbol, Qerror_conditions); if (NILP (conditions)) - signal_error ("Invalid error symbol", error_symbol); + signal_error ("Invalid error symbol", real_error_symbol); /* Remember from where signal was called. Skip over the frame for `signal' itself. If a frame for `error' follows, skip that, diff --git a/src/fileio.c b/src/fileio.c index c50259239a0..2d62bb21c17 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -286,8 +286,7 @@ void report_file_errno (char const *string, Lisp_Object name, int errorno) { Lisp_Object data = get_file_errno_data (string, name, errorno); - - xsignal (Fcar (data), Fcdr (data)); + xsignal (data, Qnil); } /* Signal a file-access failure that set errno. STRING describes the diff --git a/src/fns.c b/src/fns.c index 5ca32bb7954..09734a5b7be 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1366,8 +1366,8 @@ DEFUN ("string-make-multibyte", Fstring_make_multibyte, Sstring_make_multibyte, 1, 1, 0, doc: /* Return the multibyte equivalent of STRING. If STRING is unibyte and contains non-ASCII characters, the function -`unibyte-char-to-multibyte' is used to convert each unibyte character -to a multibyte character. In this case, the returned string is a +converts each unibyte character to an eight-bit raw byte in its +multibyte representation. In this case, the returned string is a newly created string with no text properties. If STRING is multibyte or entirely ASCII, it is returned unchanged. In particular, when STRING is unibyte and entirely ASCII, the returned string is unibyte. @@ -1406,9 +1406,9 @@ DEFUN ("string-as-unibyte", Fstring_as_unibyte, Sstring_as_unibyte, 1, 1, 0, doc: /* Return a unibyte string with the same individual bytes as STRING. If STRING is unibyte, the result is STRING itself. -Otherwise it is a newly created string, with no text properties. -If STRING is multibyte and contains a character of charset -`eight-bit', it is converted to the corresponding single byte. */) +Otherwise it is a newly created unibyte string, with no text properties, +whose bytes are identical to those of STRING, except that any character +of charset `eight-bit' is converted to the corresponding single byte. */) (Lisp_Object string) { CHECK_STRING (string); @@ -7671,8 +7671,12 @@ this variable. */); use_file_dialog = true; DEFVAR_BOOL ("use-short-answers", use_short_answers, - doc: /* Non-nil means `yes-or-no-p' uses shorter answers "y" or "n". + doc: /* Non-nil means `yes-or-no-p' accepts single-key answers "y" or "n". When non-nil, `yes-or-no-p' will use `y-or-n-p' to read the answer. +This means the user will be able to press just one key to answer, whereas +by default the user needs to type the full \"yes\" or \"no\" response +and then press RET. + We recommend against setting this variable non-nil, because `yes-or-no-p' is intended to be used when users are expected not to respond too quickly, but to take their time and perhaps think about the answer. diff --git a/src/macros.c b/src/macros.c index 5a720222553..50524e00ad2 100644 --- a/src/macros.c +++ b/src/macros.c @@ -35,7 +35,9 @@ EMACS_INT executing_kbd_macro_iterations; /* This is the macro that was executing. This is not bound at each level, - so after an error, it describes the innermost interrupted macro. */ + so after an error, it describes the innermost interrupted macro. + We use it only as a kind of flag; it could be a simple bool, but we + keep the string/vector around to aid debugging. */ Lisp_Object executing_kbd_macro; diff --git a/src/macros.h b/src/macros.h index 00ce4d12f9b..f81b8266418 100644 --- a/src/macros.h +++ b/src/macros.h @@ -28,10 +28,6 @@ along with GNU Emacs. If not, see . */ extern EMACS_INT executing_kbd_macro_iterations; -/* This is the macro that was executing. - This is not bound at each level, - so after an error, it describes the innermost interrupted macro. */ - extern Lisp_Object executing_kbd_macro; /* Finish defining the current keyboard macro. */ diff --git a/src/nsterm.m b/src/nsterm.m index dd1bf3056ab..5e4e2466461 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -9411,6 +9411,7 @@ - (BOOL) performDragOperation: (id ) sender XSETFRAME (ie.frame_or_window, *emacsframe); kbd_buffer_store_event (&ie); + ns_send_appdefined (-1); return YES; } diff --git a/src/pdumper.c b/src/pdumper.c index 9045bd2340f..8f22b814070 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -3470,10 +3470,10 @@ dump_charset (struct dump_context *ctx, int cs_i) /* We can't change the alignment here, because ctx->offset is what will be used for the whole array. */ eassert (ctx->offset % alignof (struct charset) == 0); - const struct charset *cs = charset_table + cs_i; + const struct charset *cs = charset_table.start + cs_i; struct charset out; dump_object_start_1 (ctx, &out, sizeof (out)); - if (cs_i < charset_table_used) /* Don't look at uninitialized data. */ + if (cs_i < charset_table.used) /* Don't look at uninitialized data. */ { DUMP_FIELD_COPY (&out, cs, id); DUMP_FIELD_COPY (&out, cs, dimension); @@ -3500,7 +3500,7 @@ dump_charset (struct dump_context *ctx, int cs_i) DUMP_FIELD_COPY (&out, cs, code_offset); } dump_off offset = dump_object_finish_1 (ctx, &out, sizeof (out)); - if (cs_i < charset_table_used && cs->code_space_mask) + if (cs_i < charset_table.used && cs->code_space_mask) dump_remember_cold_op (ctx, COLD_OP_CHARSET, Fcons (dump_off_to_lisp (cs_i), dump_off_to_lisp (offset))); @@ -3514,13 +3514,13 @@ dump_charset_table (struct dump_context *ctx) ctx->flags.pack_objects = true; dump_align_output (ctx, alignof (struct charset)); # ifdef HAVE_MPS - dump_igc_start_obj (ctx, IGC_OBJ_DUMPED_BYTES, charset_table); + dump_igc_start_obj (ctx, IGC_OBJ_DUMPED_BYTES, charset_table.start); # endif dump_off offset = ctx->offset; if (dump_set_referrer (ctx)) ctx->current_referrer = build_string ("charset_table"); - eassert (charset_table_size == charset_table_used); - for (int i = 0; i < charset_table_size; ++i) + eassert (charset_table.size == charset_table.used); + for (int i = 0; i < charset_table.size; ++i) dump_charset (ctx, i); dump_clear_referrer (ctx); dump_emacs_reloc_to_dump_ptr_raw (ctx, &charset_table, offset); @@ -3701,7 +3701,7 @@ dump_cold_charset (struct dump_context *ctx, Lisp_Object data) dump_off_to_lisp (code_space_mask_offset), dump_off_to_lisp (here))); #endif - struct charset *cs = charset_table + cs_i; + struct charset *cs = charset_table.start + cs_i; dump_write (ctx, cs->code_space_mask, 256); } @@ -3714,7 +3714,8 @@ dump_cold_charsets (struct dump_context *ctx, Lisp_Object *cold_queue, Lisp_Object data) { dump_align_output (ctx, DUMP_ALIGNMENT); - dump_igc_start_obj (ctx, IGC_OBJ_DUMPED_CODE_SPACE_MASKS, charset_table); + dump_igc_start_obj (ctx, IGC_OBJ_DUMPED_CODE_SPACE_MASKS, + charset_table.start); eassert (!ctx->header.code_space_masks); ctx->header.code_space_masks = ctx->offset; for (;;) @@ -6013,13 +6014,13 @@ dump_do_dump_relocation (const uintptr_t dump_base, { /* Copy the charset table out of the dump. */ struct charset *old = dump_ptr (dump_base, reloc_offset); - eassert (old == charset_table); - eassert (charset_table_size == charset_table_used); - eassert (charset_table_size > 0); - size_t nbytes = charset_table_size * sizeof *old; + eassert (old == charset_table.start); + eassert (charset_table.size == charset_table.used); + eassert (charset_table.size > 0); + size_t nbytes = charset_table.size * sizeof *old; struct charset *new = xmalloc (nbytes); memcpy (new, old, nbytes); - charset_table = new; + charset_table.start = new; } break; #endif diff --git a/src/term.c b/src/term.c index 8f480148c94..afc36be434e 100644 --- a/src/term.c +++ b/src/term.c @@ -3162,9 +3162,13 @@ mouse_get_xy (int *x, int *y) struct frame *sf = SELECTED_FRAME (); if (f == sf || frame_ancestor_p (sf, f)) { - int mx = XFIXNUM (XCAR (XCDR (mouse))); - int my = XFIXNUM (XCDR (XCDR (mouse))); - root_xy (f, mx, my, x, y); + Lisp_Object lmx = XCAR (XCDR (mouse)), lmy = XCDR (XCDR (mouse)); + if (FIXNUMP (lmx) && FIXNUMP (lmy)) + { + int mx = XFIXNUM (lmx); + int my = XFIXNUM (lmy); + root_xy (f, mx, my, x, y); + } } } @@ -3904,7 +3908,7 @@ tty_menu_show (struct frame *f, int x, int y, int menuflags, if (menu_items_n_panes == 0) return Qnil; - if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) + if (menu_items_used <= MENU_ITEMS_PANE_LENGTH || !VECTORP (menu_items)) { *error_name = "Empty menu"; return Qnil; @@ -4091,6 +4095,9 @@ tty_menu_show (struct frame *f, int x, int y, int menuflags, status = tty_menu_activate (menu, &pane, &selidx, x, y, &datap, tty_menu_help_callback, menuflags & MENU_KBD_NAVIGATION); + if (status == TTYM_SUCCESS && !VECTORP (menu_items)) + status = TTYM_IA_SELECT; + entry = pane_prefix = Qnil; switch (status) diff --git a/src/widget.c b/src/widget.c index 373c255d6da..7d40e8250a9 100644 --- a/src/widget.c +++ b/src/widget.c @@ -396,7 +396,9 @@ EmacsFrameRealize (Widget widget, XtValueMask *mask, attrs->event_mask = (STANDARD_EVENT_SET | PropertyChangeMask | SubstructureNotifyMask); + attrs->bit_gravity = NorthWestGravity; *mask |= CWEventMask; + *mask |= CWBitGravity; XtCreateWindow (widget, InputOutput, (Visual *) CopyFromParent, *mask, attrs); /* Some ConfigureNotify events does not end up in EmacsFrameResize so diff --git a/src/window.c b/src/window.c index 9be1b8dd33c..8ed4cb38819 100644 --- a/src/window.c +++ b/src/window.c @@ -860,7 +860,7 @@ zero if WINDOW was created after that. */) } DEFUN ("window-total-height", Fwindow_total_height, Swindow_total_height, 0, 2, 0, - doc: /* Return the height of window WINDOW in lines. + doc: /* Return the height of window WINDOW in canonical lines. WINDOW must be a valid window and defaults to the selected one. The return value includes the heights of WINDOW's mode and header line @@ -868,17 +868,17 @@ and its bottom divider, if any. If WINDOW is an internal window, the total height is the height of the screen areas spanned by its children. If WINDOW's pixel height is not an integral multiple of its frame's -character height, the number of lines occupied by WINDOW is rounded -internally. This is done in a way such that, if WINDOW is a parent -window, the sum of the total heights of all its children internally -equals the total height of WINDOW. +canonical character height, the number of lines occupied by WINDOW is +rounded internally. This is done in a way such that, if WINDOW is a +parent window, the sum of the total heights of all its children +internally equals the total height of WINDOW. If the optional argument ROUND is `ceiling', return the smallest integer -larger than WINDOW's pixel height divided by the character height of -WINDOW's frame. ROUND `floor' means to return the largest integer -smaller than WINDOW's pixel height divided by the character height of -WINDOW's frame. Any other value of ROUND means to return the internal -total height of WINDOW. */) +larger than WINDOW's pixel height divided by the canonical character +height of WINDOW's frame. ROUND `floor' means to return the largest +integer smaller than WINDOW's pixel height divided by the canonical +character height of WINDOW's frame. Any other value of ROUND means to +return the internal total height of WINDOW. */) (Lisp_Object window, Lisp_Object round) { struct window *w = decode_valid_window (window); @@ -896,7 +896,7 @@ total height of WINDOW. */) } DEFUN ("window-total-width", Fwindow_total_width, Swindow_total_width, 0, 2, 0, - doc: /* Return the total width of window WINDOW in columns. + doc: /* Return the total width of window WINDOW in canonical columns. WINDOW must be a valid window and defaults to the selected one. The return value includes the widths of WINDOW's fringes, margins, @@ -905,17 +905,17 @@ window, the total width is the width of the screen areas spanned by its children. If WINDOW's pixel width is not an integral multiple of its frame's -character width, the number of lines occupied by WINDOW is rounded -internally. This is done in a way such that, if WINDOW is a parent -window, the sum of the total widths of all its children internally -equals the total width of WINDOW. +canonical character width, the number of lines occupied by WINDOW is +rounded internally. This is done in a way such that, if WINDOW is a +parent window, the sum of the total widths of all its children +internally equals the total width of WINDOW. If the optional argument ROUND is `ceiling', return the smallest integer -larger than WINDOW's pixel width divided by the character width of -WINDOW's frame. ROUND `floor' means to return the largest integer -smaller than WINDOW's pixel width divided by the character width of -WINDOW's frame. Any other value of ROUND means to return the internal -total width of WINDOW. */) +larger than WINDOW's pixel width divided by the canonical character +width of WINDOW's frame. ROUND `floor' means to return the largest +integer smaller than WINDOW's pixel width divided by the canonical +character width of WINDOW's frame. Any other value of ROUND means to +return the internal total width of WINDOW. */) (Lisp_Object window, Lisp_Object round) { struct window *w = decode_valid_window (window); @@ -1146,8 +1146,8 @@ marginal areas, or scroll bars. The optional argument PIXELWISE defines the units to use for the width. If nil, return the largest integer smaller than WINDOW's pixel -width in units of the character width of WINDOW's frame. If PIXELWISE -is `remap' and the default face is remapped (see +width in units of the canonical character width of WINDOW's frame. +If PIXELWISE is `remap' and the default face is remapped (see `face-remapping-alist'), use the remapped face to determine the character width. For any other non-nil value, return the width in pixels. @@ -1171,8 +1171,8 @@ horizontal divider. The optional argument PIXELWISE defines the units to use for the height. If nil, return the largest integer smaller than WINDOW's -pixel height in units of the character height of WINDOW's frame. If -PIXELWISE is `remap' and the default face is remapped (see +pixel height in units of the canonical character height of WINDOW's +frame. If PIXELWISE is `remap' and the default face is remapped (see `face-remapping-alist'), use the remapped face to determine the character height. For any other non-nil value, return the height in pixels. */) diff --git a/src/xfns.c b/src/xfns.c index 7de967033b1..6de3f42b2ae 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -4492,7 +4492,7 @@ x_window (struct frame *f) attributes.background_pixel = FRAME_BACKGROUND_PIXEL (f); attributes.border_pixel = f->output_data.x->border_pixel; - attributes.bit_gravity = StaticGravity; + attributes.bit_gravity = NorthWestGravity; attributes.backing_store = NotUseful; attributes.save_under = True; attributes.event_mask = STANDARD_EVENT_SET; diff --git a/src/xterm.c b/src/xterm.c index 692554aa938..9d080cc944a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -8317,6 +8317,14 @@ x_update_frame_user_time_window (struct frame *f) output->user_time_window = x_create_special_window (dpyinfo, FRAME_X_WINDOW (f)); + if (FRAME_NO_FOCUS_ON_MAP (f)) + /* If the user time is zero, which is the case with + `no-focus-on-map', then preserve that value by copying + it to the new user time window. */ + XChangeProperty (dpyinfo->display, output->user_time_window, + dpyinfo->Xatom_net_wm_user_time, XA_CARDINAL, 32, + PropModeReplace, (unsigned char *) &(Time) {0}, 1); + XDeleteProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), dpyinfo->Xatom_net_wm_user_time); XChangeProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), @@ -29255,14 +29263,15 @@ x_make_frame_visible (struct frame *f) remember if it can leave `user_time_window' unset or not. */ if (output->user_time_window != None) { - if (dpyinfo->last_user_time) + if (!dpyinfo->last_user_time) + XDeleteProperty (dpyinfo->display, output->user_time_window, + dpyinfo->Xatom_net_wm_user_time); + /* Don't overwrite a zero user time for `no-focus-on-map'. */ + else if (!FRAME_NO_FOCUS_ON_MAP (f)) XChangeProperty (dpyinfo->display, output->user_time_window, dpyinfo->Xatom_net_wm_user_time, XA_CARDINAL, 32, PropModeReplace, (unsigned char *) &dpyinfo->last_user_time, 1); - else - XDeleteProperty (dpyinfo->display, output->user_time_window, - dpyinfo->Xatom_net_wm_user_time); } #endif diff --git a/test/infra/android/test-controller.el b/test/infra/android/test-controller.el index 07c6f0e5ba0..34a0e9bfe33 100644 --- a/test/infra/android/test-controller.el +++ b/test/infra/android/test-controller.el @@ -1910,7 +1910,7 @@ this machine and an SSH daemon be executing on the host)." (with-demoted-errors "Winding up failed connection: %S" (ats-adb "-s" device "forward" "--remove" (format "tcp:%d" host-port))) - (signal (car err) (cdr err)))))))))) + (signal err))))))))) diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el index 43a441918a5..235a67c8649 100644 --- a/test/lisp/arc-mode-tests.el +++ b/test/lisp/arc-mode-tests.el @@ -113,9 +113,10 @@ member MEMBER. Then the test finds ARCHIVE and ensures that function ;; turn the most likely error into a nice ;; and self-explaining symbol that can be ;; compared in a `should' - (if (string= (cadr err) "Buffer format not recognized") + (if (equal (error-slot-value err 1) + "Buffer format not recognized") 'signature-not-recognized - (signal (car err) (cdr err)))))) + (signal err))))) (should (eq type (quote ,type))))) (when buffer (kill-buffer buffer)) (dolist (file (list member archive)) diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 8a0ce146fbb..dfdfbafc5fa 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -203,7 +203,7 @@ It is checked for buffer-local `auto-revert-notify-watch-descriptor'." (tramp-dissect-file-name auto-revert--test-rootdir) t 'keep-password) (condition-case err (funcall (ert-test-body ert-test)) - (error (message "%s" err) (signal (car err) (cdr err))))))) + (error (message "%S" err) (signal err)))))) (defmacro with-auto-revert-test (&rest body) (declare (debug t)) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index c93dfad0a0d..61e909437c7 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -120,8 +120,7 @@ back to the top level.") (eval-buffer) ,@body (when edebug-tests-failure-in-post-command - (signal (car edebug-tests-failure-in-post-command) - (cdr edebug-tests-failure-in-post-command)))) + (signal edebug-tests-failure-in-post-command))) (unload-feature 'edebug-test-code) (with-current-buffer (find-file-noselect edebug-tests-temp-file) (set-buffer-modified-p nil)) @@ -246,7 +245,7 @@ keyboard macro." (funcall thunk) (error (setq edebug-tests-failure-in-post-command err) - (signal (car err) (cdr err))))) + (signal err)))) (setq edebug-tests-kbd-macro-index executing-kbd-macro-index)))) (defvar edebug-tests-func nil diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el index ed4c9fcf978..c4e93e16005 100644 --- a/test/lisp/emacs-lisp/pp-tests.el +++ b/test/lisp/emacs-lisp/pp-tests.el @@ -82,7 +82,7 @@ (invalid-read-syntax (message "Invalid fill result with i=%d:\n%s" i (buffer-string)) - (signal (car err) (cdr err)) + (signal err) )))))))) (ert-deftest pp-tests--bug76715 () diff --git a/test/lisp/emacs-lisp/vtable-tests.el b/test/lisp/emacs-lisp/vtable-tests.el index 0e9be8371a7..e3bcfe9dc78 100644 --- a/test/lisp/emacs-lisp/vtable-tests.el +++ b/test/lisp/emacs-lisp/vtable-tests.el @@ -130,25 +130,4 @@ (should (= (count-lines (point-min) (point-max)) 3)) (should (not (string= line-2 line-2-new)))))))) -(ert-deftest test-vtable--limit-string-with-face-remapped-buffer () - (with-temp-buffer - (let ((text (propertize "XXXXX" - 'face 'variable-pitch))) - (face-remap-add-relative 'default :height 1.5) - ;; TODO: Remove the pre-31 test, eventually. - (cond ((eval-when-compile (< emacs-major-version 31)) - (let* ((x-width (string-pixel-width (substring text 0 1))) - (char-limit 2) - (pixel-limit (* char-limit x-width))) - (should (eq - char-limit - (length (vtable--limit-string text pixel-limit)))))) - (t - (let* ((x-width (string-pixel-width (substring text 0 1) (current-buffer))) - (char-limit 2) - (pixel-limit (* char-limit x-width))) - (should (eq - char-limit - (length (vtable--limit-string text pixel-limit (current-buffer))))))))))) - ;;; vtable-tests.el ends here diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el index fce3c2bc048..52d1e8850ca 100644 --- a/test/lisp/proced-tests.el +++ b/test/lisp/proced-tests.el @@ -61,7 +61,7 @@ (proced--move-to-column "%CPU") (condition-case err (>= (proced--cpu-at-point) cpu) - (ert-test-skipped (signal (car err) (cdr err))) + (ert-test-skipped (signal err)) (error (ert-fail (list err (proced--assert-process-valid-cpu-refinement-explainer cpu)))))) diff --git a/test/lisp/progmodes/hideshow-tests.el b/test/lisp/progmodes/hideshow-tests.el index b410a548aa0..b740c40182b 100644 --- a/test/lisp/progmodes/hideshow-tests.el +++ b/test/lisp/progmodes/hideshow-tests.el @@ -26,6 +26,7 @@ ;; Dependencies for testing: (require 'cc-mode) +(require 'sh-script) (defmacro hideshow-tests-with-temp-buffer (mode contents &rest body) @@ -475,6 +476,35 @@ def test1 (): (beginning-of-line) (should-not (hs-block-positions))))) +(ert-deftest hideshow-check-indentation-folding () + "Check indentation-based folding with and without end of the block respected." + (let ((contents " +if [1] + then 2 +fi")) + (hideshow-tests-with-temp-buffer + sh-mode + contents + (hs-indentation-mode t) + (hideshow-tests-look-at "if") + (beginning-of-line) + (hs-hide-block) + (should (string= + (hideshow-tests-visible-string) + " +if [1] +fi")) + (hs-show-all) + ;; End of the block respected + (hs-indentation-mode nil) ; Reset variables + (setq-local hs-indentation-respect-end-block t) + (hs-indentation-mode t) + (hs-hide-block) + (should (string= + (hideshow-tests-visible-string) + " +if [1]fi"))))) + (provide 'hideshow-tests) ;;; hideshow-tests.el ends here diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index ea483d0d1dc..12697b2d68e 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -737,16 +737,15 @@ See bug#35036." (goto-char (point-max)) ;; We use a keyboard macro because it adds undo events in the same ;; way as if a user were involved. - (kmacro-call-macro nil nil nil - [left - ;; Delete "c" - backspace - left left left - ;; Delete "a" - backspace - ;; C-/ or undo - 67108911 - ]) + (funcall (kmacro [left + ;; Delete "c" + backspace + left left left + ;; Delete "a" + backspace + ;; C-/ or undo + ?\C-/ + ])) (point))) (defun undo-test-point-after-forward-kill () @@ -756,13 +755,11 @@ See bug#35036." (insert "kill word forward") ;; Move to word "word". (goto-char 6) - (kmacro-call-macro nil nil nil - [ - ;; kill-word - C-delete - ;; undo - 67108911 - ]) + (funcall (kmacro [;; kill-word + C-delete + ;; undo + ?\C-/ + ])) (point))) (ert-deftest undo-point-in-wrong-place () diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 5cdc30e8965..3d4f524d630 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1463,6 +1463,27 @@ final or penultimate step during initialization.")) (t x) (:success (1+ x))) '(error ""))))) +(ert-deftest subr-error-API () + (should (error-type-p 'error)) + (should (error-type-p 'wrong-type-argument)) + (should-not (error-type-p 'car)) + + (let ((error-err (condition-case err (error "Foo") (error err))) + (wta-err (condition-case err (car 5) (error err)))) + (should (error-has-type-p error-err 't)) + (should-not (error-has-type-p error-err 'wrong-type-argument)) + (should (error-has-type-p wta-err 'error)) + (should (error-has-type-p wta-err 'wrong-type-argument)) + (should-not (error-has-type-p wta-err 'wrong-number-of-arguments)) + + (should (equal "Foo" (error-slot-value error-err 1))) + (should (equal 'listp (error-slot-value wta-err 1))) + (should (equal 5 (error-slot-value wta-err 2))) + + (should (equal wta-err (condition-case err (car 5) (error err)))) + (should-not (eq wta-err (condition-case err (car 5) (error err)))) + (should (eq wta-err (condition-case err (signal wta-err) (error err)))))) + (ert-deftest subr--subst-char-in-string () ;; Cross-validate `subst-char-in-string' with `string-replace', ;; which should produce the same results when there are no properties. @@ -1694,6 +1715,18 @@ final or penultimate step during initialization.")) (should (equal (funcall (subr--identity #'any) #'minusp ls) '(-1 -2 -3))) (should (equal (funcall (subr--identity #'any) #'stringp ls) nil)))) +(defun subr-tests--any-memql (x xs) + "Like `memql', but exercising the `compiler-macro' of `any'. +The argument names are important." + (any (lambda (y) (eql x y)) xs)) + +(ert-deftest subr-any-compiler-macro () + "Test `compiler-macro' of `any'." + (let ((xs (number-sequence 0 4))) + (dotimes (x (1+ (length xs))) + (should (eq (subr-tests--any-memql x xs) + (memql x xs)))))) + (ert-deftest total-line-spacing () (progn (let ((line-spacing 10)) diff --git a/test/lisp/use-package/use-package-tests.el b/test/lisp/use-package/use-package-tests.el index 0ae06b9f93f..57ab98e012b 100644 --- a/test/lisp/use-package/use-package-tests.el +++ b/test/lisp/use-package/use-package-tests.el @@ -2031,10 +2031,8 @@ (should (eq tried-to-install 'some-pkg))))) (ert-deftest use-package-test-normalize/:vc () - (should (equal '(foo "version-string") - (use-package-normalize/:vc 'foo :vc '("version-string")))) - (should (equal '(bar "version-string") - (use-package-normalize/:vc 'foo :vc '((bar . "version-string"))))) + (should (equal '(foo (:url "url")) + (use-package-normalize/:vc 'foo :vc '("url")))) (should (equal '(foo (:url "bar") "baz") (use-package-normalize/:vc 'foo :vc '((:url "bar" :rev "baz"))))) (should (equal '(foo) diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el index e93ee72210d..96fa3d65c05 100644 --- a/test/lisp/vc/vc-git-tests.el +++ b/test/lisp/vc/vc-git-tests.el @@ -111,7 +111,7 @@ If the exit status is non-zero, log the command output and re-throw." (apply 'vc-git-command t 0 nil args) (t (message "Error running Git: %s" err) (message "(buffer-string:\n%s\n)" (buffer-string)) - (signal (car err) (cdr err)))) + (signal err))) (buffer-string))) (defun vc-git-test--start-branch () diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index ca79a340a46..a64bee00de2 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -236,10 +236,9 @@ For backends which don't support it, `vc-not-supported' is signaled." (defmacro vc-test--run-maybe-unsupported-function (func &rest args) "Run FUNC with ARGS as arguments. Catch the `vc-not-supported' error." - `(condition-case err + `(condition-case nil (funcall ,func ,@args) - (vc-not-supported 'vc-not-supported) - (t (signal (car err) (cdr err))))) + (vc-not-supported 'vc-not-supported))) (defun vc-test--register (backend) "Register and unregister a file. diff --git a/test/src/charset-tests.el b/test/src/charset-tests.el index 4af1627d10b..ff7af4fc5c2 100644 --- a/test/src/charset-tests.el +++ b/test/src/charset-tests.el @@ -146,6 +146,16 @@ (let ((sorted (sort-charsets (list b a)))) (should (equal sorted (list a b)))))) +(ert-deftest charset-tests-define-charset () + (eval '(define-charset 'charset-tests-cs-1 + "Only used for testing" + :short-name "CTCS1" + :long-name "Charset-Tests-Charset-1" + :code-space [33 126 33 126] + :code-offset #x28083A + :unify-map "CNS-F")) + (should (charsetp 'charset-tests-cs-1))) + (provide 'charset-tests) ;;; charset-tests.el ends here diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el index 795039cd9cb..9284edd8b26 100644 --- a/test/src/filelock-tests.el +++ b/test/src/filelock-tests.el @@ -137,8 +137,7 @@ the case)." ;; Errors from `unlock-buffer' should call ;; `userlock--handle-unlock-error' (bug#46397). - (cl-letf (((symbol-function 'userlock--handle-unlock-error) - (lambda (err) (signal (car err) (cdr err))))) + (cl-letf (((symbol-function 'userlock--handle-unlock-error) #'signal)) (should (equal '(file-error "Unlocking file") (seq-subseq (should-error (unlock-buffer)) 0 2)))))) @@ -160,8 +159,7 @@ the case)." ;; File errors from unlocking files should call ;; `userlock--handle-unlock-error' (bug#46397). (cl-letf (((symbol-function 'yes-or-no-p) #'always) - ((symbol-function 'userlock--handle-unlock-error) - (lambda (err) (signal (car err) (cdr err))))) + ((symbol-function 'userlock--handle-unlock-error) #'signal)) (should (equal '(file-error "Unlocking file") (seq-subseq (should-error (kill-buffer)) 0 2)))))) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 2cc5b37b187..55657a23fa9 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -546,7 +546,7 @@ See Bug#30460." ;; all `file-error' signals. (and ,message (not (string-equal (caddr ,err) ,message)) - (signal (car ,err) (cdr ,err)))))))) + (signal ,err))))))) (defmacro process-tests--with-buffers (var &rest body) "Bind VAR to nil and evaluate BODY.