diff --git a/admin/coccinelle/arrayelts.cocci b/admin/coccinelle/arrayelts.cocci new file mode 100644 index 00000000000..5376a94bd85 --- /dev/null +++ b/admin/coccinelle/arrayelts.cocci @@ -0,0 +1,21 @@ +// Use the ARRAYELTS macro where possible. +@@ +type T; +T[] E; +@@ +- (sizeof (E) / sizeof (E[...])) ++ ARRAYELTS (E) + +@@ +type T; +T[] E; +@@ +- (sizeof (E) / sizeof (T)) ++ ARRAYELTS (E) + +@@ +type T; +T[] E; +@@ +- (sizeof (E) / sizeof (*E)) ++ ARRAYELTS (E) diff --git a/admin/coccinelle/listn.cocci b/admin/coccinelle/listn.cocci new file mode 100644 index 00000000000..df1d6dafdf2 --- /dev/null +++ b/admin/coccinelle/listn.cocci @@ -0,0 +1,7 @@ +// Prefer 'list (...)' to 'listn (N, ...)' +@@ +constant n; +@@ +- listn (n, ++ list ( + ...) diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 2eab5ab8b9c..ae433961df3 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -41,11 +41,11 @@ GNULIB_MODULES=' free-posix fstatat fsusage fsync futimens getline getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog ieee754-h ignore-value intprops largefile libgmp lstat - manywarnings memmem-simple mempcpy memrchr memset_explicit + malloc-gnu manywarnings memmem-simple mempcpy memrchr memset_explicit minmax mkostemp mktime nanosleep nproc nstrftime pathmax pipe2 pselect pthread_sigmask - qcopy-acl readlink readlinkat regex + qcopy-acl readlink readlinkat realloc-posix regex sig2str sigdescr_np socklen stat-time std-gnu11 stdc_bit_width stdc_count_ones stdc_trailing_zeros stdckdint-h stddef-h stdio-h diff --git a/autogen.sh b/autogen.sh index 00c20c73263..b46d1e6c90a 100755 --- a/autogen.sh +++ b/autogen.sh @@ -115,7 +115,7 @@ do_check=true do_autoconf=false do_git=false -for arg; do +for arg in "$@"; do case $arg in --help) exec echo "$0: usage: $0 [--no-check] [target...] diff --git a/configure.ac b/configure.ac index e8d29734071..fcc9549a616 100644 --- a/configure.ac +++ b/configure.ac @@ -2019,6 +2019,8 @@ ARCH_INDEPENDENT_CONFIG_FILES([src/verbose.mk]) dnl Some other nice autoconf tests. AC_PROG_INSTALL +dnl use "gawk" where possible +AC_PROG_AWK dnl These are commented out, since gl_EARLY and/or Autoconf already does them. dnl AC_PROG_MKDIR_P dnl if test "x$RANLIB" = x; then @@ -2091,8 +2093,10 @@ AC_CACHE_CHECK([for 'find' args to delete a file], [emacs_cv_find_delete], [if touch conftest.tmp && find conftest.tmp -delete 2>/dev/null && test ! -f conftest.tmp - then emacs_cv_find_delete="-delete" - else emacs_cv_find_delete="-exec rm -f {} +" + then emacs_cv_find_delete="-delete" # GNU 'find' + elif find . -prune -name x -exec echo {} + 2>/dev/null + then emacs_cv_find_delete="-exec rm -f {} +" # POSIX 'find' + else emacs_cv_find_delete="-exec rm -f {} + -o -exec true {} +" # AIX 7.3 fi]) FIND_DELETE=$emacs_cv_find_delete AC_SUBST([FIND_DELETE]) diff --git a/cross/Makefile.in b/cross/Makefile.in index a10d0f5421d..94a28a755bc 100644 --- a/cross/Makefile.in +++ b/cross/Makefile.in @@ -182,9 +182,7 @@ $(LIBSRC_BINARIES) &: src/verbose.mk $(top_builddir)/$@ lib/libgnu.a \ .PHONY: clean maintainer-clean distclean clean: - for dir in $(CLEAN_SUBDIRS); do \ - find $$dir -type f $(FIND_DELETE); \ - done + find $(CLEAN_SUBDIRS) -type f $(FIND_DELETE) rm -rf lib/config.h lib-src/config.h # ndk-build won't have been generated in a non-Android build. if test -f ndk-build/Makefile; then \ @@ -193,8 +191,6 @@ clean: maintainer-clean distclean bootstrap-clean: clean # Remove links created by configure. - for dir in $(CLEAN_SUBDIRS); do \ - find $$dir -type l $(FIND_DELETE); \ - done + find $(CLEAN_SUBDIRS) -type l $(FIND_DELETE) rm -rf lib/Makefile lib/gnulib.mk ndk-build/Makefile rm -rf ndk-build/ndk-build.mk Makefile diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 9fe8b4b9e21..39514145a1e 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -184,7 +184,7 @@ occurs within the body, the form simply returns @code{nil} without even evaluating its argument. The @var{modes} list allows specifying which modes the command is -meant to be used in. See @ref{Command Modes} for more details about +meant to be used in. @xref{Command Modes}, for more details about the effect of specifying @var{modes}, and when to use it. By convention, you should put the @code{interactive} form in the diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index 09c05fa18c6..d257bb3a462 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -1221,8 +1221,8 @@ the value is acceptable. Specify how to decide whether an inline value matches the type. The corresponding value, @var{function}, should be a function that accepts two arguments, a widget and an inline value; it should return -non-@code{nil} if the value is acceptable. See @ref{Splicing into -Lists} for more information about inline values. +non-@code{nil} if the value is acceptable. @xref{Splicing into +Lists}, for more information about inline values. @item :validate @var{function} Specify a validation function for input. @var{function} takes a diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 0effe48e9a3..e234db6fce5 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -85,8 +85,8 @@ start using it. To debug a Lisp program with Edebug, you must first @dfn{instrument} the Lisp code that you want to debug. A simple way to do this is to first move point into the definition of a function or macro and then do -@kbd{C-u C-M-x} (@code{eval-defun} with a prefix argument). See -@ref{Instrumenting}, for alternative ways to instrument code. +@kbd{C-u C-M-x} (@code{eval-defun} with a prefix argument). +@xref{Instrumenting}, for alternative ways to instrument code. Once a function is instrumented, any call to the function activates Edebug. Depending on which Edebug execution mode you have selected, @@ -1369,8 +1369,8 @@ specifications and the backquote example. @cindex preventing backtracking No argument is matched but backtracking through the gate is disabled while matching the remainder of the specifications at this level. This -is primarily used to generate more specific syntax error messages. See -@ref{Backtracking}, for more details. Also see the @code{let} example. +is primarily used to generate more specific syntax error messages. +@xref{Backtracking}, for more details. Also see the @code{let} example. @item &error @code{&error} should be followed by a string, an error message, in the diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index a0d0e489ad0..7470716a587 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -774,8 +774,7 @@ As a rule, the inner frame is subdivided into the frame's root window rule: A @dfn{minibuffer-less frame} contains a root window only and does not contain a minibuffer window. A @dfn{minibuffer-only frame} contains only a minibuffer window which also serves as that frame's root window. -See @ref{Initial Parameters} for how to create such frame -configurations. +@xref{Initial Parameters}, for how to create such frame configurations. @item Text Area @cindex text area diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index bad3c926b27..7f881bae7f5 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -90,7 +90,7 @@ fundamental part of Lisp (e.g., @code{car}), or because it provides a low-level interface to operating system services, or because it needs to run fast. Unlike functions defined in Lisp, primitives can be modified or added only by changing the C sources and recompiling -Emacs. See @ref{Writing Emacs Primitives}. +Emacs. @xref{Writing Emacs Primitives}. @item special form A primitive that is like a function but does not evaluate all of its @@ -754,7 +754,7 @@ to find the source code because generating a function dynamically usually looks very different from the usual static calls to @code{defun}. You can make the job of finding the code that generates such functions easier by using the @code{definition-name} -or @code{definition-type} property, @pxref{Standard Properties}. +or @code{find-function-type-alist} property, @pxref{Standard Properties}. @cindex override existing functions @cindex redefine existing functions @@ -2976,56 +2976,56 @@ elsewhere, but we provide cross references here. @table @code @item apply -See @ref{Calling Functions}. +@xref{Calling Functions}. @item autoload -See @ref{Autoload}. +@xref{Autoload}. @item call-interactively -See @ref{Interactive Call}. +@xref{Interactive Call}. @item called-interactively-p -See @ref{Distinguish Interactive}. +@xref{Distinguish Interactive}. @item commandp -See @ref{Interactive Call}. +@xref{Interactive Call}. @item documentation -See @ref{Accessing Documentation}. +@xref{Accessing Documentation}. @item eval -See @ref{Eval}. +@xref{Eval}. @item funcall -See @ref{Calling Functions}. +@xref{Calling Functions}. @item function -See @ref{Anonymous Functions}. +@xref{Anonymous Functions}. @item ignore -See @ref{Calling Functions}. +@xref{Calling Functions}. @item indirect-function -See @ref{Function Indirection}. +@xref{Function Indirection}. @item interactive -See @ref{Using Interactive}. +@xref{Using Interactive}. @item interactive-p -See @ref{Distinguish Interactive}. +@xref{Distinguish Interactive}. @item mapatoms -See @ref{Creating Symbols}. +@xref{Creating Symbols}. @item mapcar -See @ref{Mapping Functions}. +@xref{Mapping Functions}. @item map-char-table -See @ref{Char-Tables}. +@xref{Char-Tables}. @item mapconcat -See @ref{Mapping Functions}. +@xref{Mapping Functions}. @item undefined -See @ref{Functions for Key Lookup}. +@xref{Functions for Key Lookup}. @end table diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 185fa3c60bc..83abbde5ea8 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1154,9 +1154,9 @@ one-dimensional array containing their values. The first Lisp-level argument is the Lisp function to call, and the rest are the arguments to pass to it. - The C functions @code{call0}, @code{call1}, @code{call2}, and so on, -provide handy ways to call a Lisp function conveniently with a fixed -number of arguments. They work by calling @code{Ffuncall}. + The C macro @code{calln} is a convenient way to call a Lisp function +without having to specify the number of arguments. It works by calling +@code{Ffuncall}. @file{eval.c} is a very good file to look through for examples; @file{lisp.h} contains the definitions for some important macros and diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 7095942d7b2..eaba29a33e3 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1046,8 +1046,8 @@ When more than one minor mode keymap is active, the earlier one in minor modes so that they don't interfere with each other. If you do this properly, the order will not matter. -See @ref{Keymaps and Minor Modes}, for more information about minor -modes. See also @code{minor-mode-key-binding} (@pxref{Functions for Key +@xref{Keymaps and Minor Modes}, for more information about minor modes. +See also @code{minor-mode-key-binding} (@pxref{Functions for Key Lookup}). @end defvar @@ -1204,7 +1204,7 @@ and @var{command} is its binding. @xref{What Is a Function}. @cindex string in keymap The array (either a string or a vector) is a keyboard macro. The events used so far in the lookup form a complete key, and the array is its -binding. See @ref{Keyboard Macros}, for more information. +binding. @xref{Keyboard Macros}, for more information. @item @var{keymap} @cindex keymap in keymap diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index d8e7e6c2e76..ecd34b95294 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1890,7 +1890,7 @@ The function to add prefixes and suffixes to completions. @end table @noindent -See @ref{Programmed Completion}, for a complete list of metadata entries. +@xref{Programmed Completion}, for a complete list of metadata entries. @end defopt @defvar completion-extra-properties diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 31ae373f6f3..9b92093f629 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2518,8 +2518,7 @@ idleness. Here's an example: @cindex terminal input This section describes functions and variables for recording or -manipulating terminal input. See @ref{Display}, for related -functions. +manipulating terminal input. @xref{Display}, for related functions. @menu * Input Modes:: Options for how input is processed. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index ba7fbca2de9..bd8b0b1f561 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1539,22 +1539,35 @@ the specific error. You can use @code{treesit-query-validate} to validate and debug the query. @end defun -@defun treesit-query-language query -This function returns the language of @var{query}. -@end defun +@findex treesit-query-language +@findex treesit-query-expand +@findex treesit-pattern-expand +@findex treesit-query-valid-p +There are some additional functions for queries: +@code{treesit-query-language} returns the language of a query; +@code{treesit-query-valid-p} checks whether a query is valid; +@code{treesit-query-expand} converts a s-expression query into the +string format; and @code{treesit-pattern-expand} converts a pattern. -@defun treesit-query-expand query -This function converts the s-expression @var{query} into the string -format. -@end defun +@findex treesit-query-first-valid +Tree-sitter grammars change overtime. To support multiple possible +versions of a grammar, a Lisp program can use +@code{treesit-query-first-valid} to pick the right query to use. For +example, if a grammar has a @code{(defun)} node in one version, and +later renamed it to @code{(function_definition)}, a Lisp program can use -@defun treesit-pattern-expand pattern -This function converts the s-expression @var{pattern} into the string -format. -@end defun +@example +@group +(treesit-query-first-valid 'lang + '((defun) @@defun) + '((function_definition) @@defun)) +@end group +@end example -For more details, read the tree-sitter project's documentation about -pattern-matching, which can be found at +to support both versions of the grammar. + +For more details, consider reading the tree-sitter project's +documentation about pattern-matching. The documentation can be found at @uref{https://tree-sitter.github.io/tree-sitter/using-parsers#pattern-matching-with-queries}. @node User-defined Things diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index da0c1abd348..93025574893 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -478,8 +478,9 @@ a raw byte. @code{clear-string}: @defun clear-string string -This makes @var{string} a unibyte string and clears its contents to -null characters. It may also change @var{string}'s length. +This makes @var{string} a unibyte string, clears its contents to null +characters, and removes all text properties. It may also change +@var{string}'s length. @end defun @need 2000 diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 508ee13a244..dc6509c1ae3 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -536,9 +536,9 @@ Do not set them directly; they are managed by @code{defcustom} and related functions. @xref{Variable Definitions}. @cindex @code{definition-name} (symbol property) -@cindex @code{definition-type} (symbol property) +@cindex @code{find-function-type-alist} (symbol property) @item definition-name -@itemx definition-type +@itemx find-function-type-alist These properties help find the definition of a symbol in the source code when it might be hard to find the definition by textual search of the source file. @@ -560,19 +560,22 @@ symbol. In some cases, the definition cannot be found by looking for the definition of another symbol. For example, a test file might use a -macro to generate calls to @code{ert-deftest} -(@pxref{,,,ert, ERT: Emacs Lisp Regression Testing}) where the code -is boiler plate and only varying data need to be passed in. -In such cases, the @code{definition-type} property of the symbol can -be a symbol that has an entry in @code{find-function-regexp-alist} -telling how to find the definition of symbols of this type. +macro to generate calls to @code{ert-deftest} (@pxref{How to Write +Tests,,,ert, ERT: Emacs Lisp Regression Testing}) where the code is +boiler plate and only varying data need to be passed in. In such cases, +the @code{find-function-type-alist} property of the symbol can be an +alist that augments @code{find-function-regexp-alist} telling how to +find the definition of symbols of this type. In the example of a macro defining calls to @code{ert-deftest}, -the macro could put the property @code{definition-type} on each -test defined. The file defining the macro would also define a -definition-finding function or regexp and add it to -@code{find-function-regexp-alist} after that variable is loaded. -Here is an example using a function to find the definition: +the macro could put the property @code{find-function-type-alist} on each +test defined, associating @code{ert--test} (the internal type of ERT +tests) with the name of a regexp or function that can find the correct +macro call. The file defining the macro would also have to provide that +definition-finding function or regexp. +Here is an example using a function to find the definition. +The example updates the property using convenience function +@code{find-function-update-type-alist}. @example @group @@ -581,29 +584,19 @@ Here is an example using a function to find the definition: (declare (debug (&rest sexp))) (let ((test-name (intern (concat ...)))) `(progn - (put ',test-name 'definition-type 'foo-test-type) - (ert-deftest ,test-name () - ,(concat "Test foo with " ...) - ...)))) + (find-function-update-type-alist + ',test-name 'ert--test 'foo-find-test-def-function) + (ert-deftest ,test-name () + ,(concat "Test foo with " ...) + ...)))) @end group @group (defun foo-find-test-def-function (test-name) "Search for the `define-foo-test' call defining TEST-NAME. Return non-nil if the definition is found." - (save-match-data - (let ((regexp ...)) - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward regexp nil t))))) -@end group - -@group -(with-eval-after-load "find-func" - (add-to-list - 'find-function-regexp-alist - '(foo-test-type . foo-find-test-def-function))) + (let ((regexp ...)) + (re-search-forward regexp nil t))) @end group @end example diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 2d24436d214..91ebd6cf233 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -6019,8 +6019,8 @@ a different underlying transport strategy (for details on how to subclass, see @ref{Inheritance,Inheritance,,eieio}.). Users of the application-building interface can then instantiate objects of this concrete class (using the @code{make-instance} function) and connect -to JSONRPC endpoints using that strategy. See @ref{Process-based -JSONRPC connections} for a built-in transport implementation. +to JSONRPC endpoints using that strategy. @xref{Process-based +JSONRPC connections}, for a built-in transport implementation. This API has mandatory and optional parts. diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index c2fba3cba8d..1bf52886971 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -228,7 +228,7 @@ definition automatically. Avoid constructing the names in the macro itself, since that would confuse these tools. If your macro cannot be written in this style, the macro can still help these tools find the defining call by putting the property -@code{definition-name} or @code{definition-type} on the name. +@code{definition-name} or @code{find-function-type-alist} on the name. @xref{Standard Properties}. @item diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index a2bb1834477..5710971a9fa 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1117,7 +1117,7 @@ cell). will use dynamic binding, even for new bindings such as a @code{let} binding. Depending on how the variable is declared, it can be special globally, for a single file, or for a portion of a file. -@xref{Dynamic Binding} for details. +@xref{Dynamic Binding}, for further details. @node Dynamic Binding @subsection Dynamic Binding diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 0635ab7ac05..d4fbcabc1f1 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -30811,7 +30811,7 @@ embedded in a @TeX{} or @LaTeX{} document its plain version will be invisible in the final printed copy. Certain major modes have different delimiters to ensure that the ``plain'' version will be in a comment for those modes, also. -See @ref{Customizing Embedded Mode} to see how to change the ``plain'' +@xref{Customizing Embedded Mode}, to see how to change the ``plain'' formula delimiters. There are several notations which Calc's parser for ``big'' @@ -35323,8 +35323,8 @@ also be reset by putting the appropriate lines in your .emacs file; Some of the customizable variables are regular expressions. A regular expression is basically a pattern that Calc can search for. -See @ref{Regexp Search,, Regular Expression Search, emacs, The GNU Emacs Manual} -to see how regular expressions work. +@xref{Regexp Search,, Regular Expression Search, emacs, The GNU Emacs +Manual}, to see how regular expressions work. @defvar calc-settings-file The variable @code{calc-settings-file} holds the file name in @@ -35341,7 +35341,7 @@ value will be @code{"~/.calc.el"}. @end defvar @defvar calc-gnuplot-name -See @ref{Graphics}.@* +@xref{Graphics}.@* The variable @code{calc-gnuplot-name} should be the name of the GNUPLOT program (a string). If you have GNUPLOT installed on your system but Calc is unable to find it, you may need to set this @@ -35352,7 +35352,7 @@ The default value of @code{calc-gnuplot-name} is @code{"gnuplot"}. @defvar calc-gnuplot-plot-command @defvarx calc-gnuplot-print-command -See @ref{Devices, ,Graphical Devices}.@* +@xref{Devices, ,Graphical Devices}.@* The variables @code{calc-gnuplot-plot-command} and @code{calc-gnuplot-print-command} represent system commands to display and print the output of GNUPLOT, respectively. These may be @@ -35367,7 +35367,7 @@ and the default value of @code{calc-gnuplot-print-command} is @end defvar @defvar calc-language-alist -See @ref{Basic Embedded Mode}.@* +@xref{Basic Embedded Mode}.@* The variable @code{calc-language-alist} controls the languages that Calc will associate with major modes. When Calc embedded mode is enabled, it will try to use the current major mode to @@ -35396,7 +35396,7 @@ The default value of @code{calc-language-alist} is @defvar calc-embedded-announce-formula @defvarx calc-embedded-announce-formula-alist -See @ref{Customizing Embedded Mode}.@* +@xref{Customizing Embedded Mode}.@* The variable @code{calc-embedded-announce-formula} helps determine what formulas @kbd{C-x * a} will activate in a buffer. It is a regular expression, and when activating embedded formulas with @@ -35434,7 +35434,7 @@ and @code{calc-embedded-open-close-mode-alist}. @defvar calc-embedded-open-formula @defvarx calc-embedded-close-formula @defvarx calc-embedded-open-close-formula-alist -See @ref{Customizing Embedded Mode}.@* +@xref{Customizing Embedded Mode}.@* The variables @code{calc-embedded-open-formula} and @code{calc-embedded-close-formula} control the region that Calc will activate as a formula when Embedded mode is entered with @kbd{C-x * e}. @@ -35471,7 +35471,7 @@ It consists of a list of lists of the form @defvar calc-embedded-word-regexp @defvarx calc-embedded-word-regexp-alist -See @ref{Customizing Embedded Mode}.@* +@xref{Customizing Embedded Mode}.@* The variable @code{calc-embedded-word-regexp} determines the expression that Calc will activate when Embedded mode is entered with @kbd{C-x * w}. It is a regular expressions. @@ -35490,7 +35490,7 @@ It consists of a list of lists of the form @defvar calc-embedded-open-plain @defvarx calc-embedded-close-plain @defvarx calc-embedded-open-close-plain-alist -See @ref{Customizing Embedded Mode}.@* +@xref{Customizing Embedded Mode}.@* The variables @code{calc-embedded-open-plain} and @code{calc-embedded-open-plain} are used to delimit ``plain'' formulas. Note that these are actual strings, not regular @@ -35531,7 +35531,7 @@ and @code{calc-embedded-open-close-mode-alist}. @defvar calc-embedded-open-new-formula @defvarx calc-embedded-close-new-formula @defvarx calc-embedded-open-close-new-formula-alist -See @ref{Customizing Embedded Mode}.@* +@xref{Customizing Embedded Mode}.@* The variables @code{calc-embedded-open-new-formula} and @code{calc-embedded-close-new-formula} are strings which are inserted before and after a new formula when you type @kbd{C-x * f}. @@ -35559,7 +35559,7 @@ It consists of a list of lists of the form @defvar calc-embedded-open-mode @defvarx calc-embedded-close-mode @defvarx calc-embedded-open-close-mode-alist -See @ref{Customizing Embedded Mode}.@* +@xref{Customizing Embedded Mode}.@* The variables @code{calc-embedded-open-mode} and @code{calc-embedded-close-mode} are strings which Calc will place before and after any mode annotations that it inserts. Calc never scans for @@ -35600,7 +35600,7 @@ and @code{calc-embedded-open-close-plain-alist}. @defvar calc-lu-power-reference @defvarx calc-lu-field-reference -See @ref{Logarithmic Units}.@* +@xref{Logarithmic Units}.@* The variables @code{calc-lu-power-reference} and @code{calc-lu-field-reference} are unit expressions (written as strings) which Calc will use as reference quantities for logarithmic @@ -35612,7 +35612,7 @@ and the default value of @code{calc-lu-field-reference} is @end defvar @defvar calc-note-threshold -See @ref{Musical Notes}.@* +@xref{Musical Notes}.@* The variable @code{calc-note-threshold} is a number (written as a string) which determines how close (in cents) a frequency needs to be to a note to be recognized as that note. @@ -35623,7 +35623,7 @@ The default value of @code{calc-note-threshold} is 1. @defvar calc-highlight-selections-with-faces @defvarx calc-selected-face @defvarx calc-nonselected-face -See @ref{Displaying Selections}.@* +@xref{Displaying Selections}.@* The variable @code{calc-highlight-selections-with-faces} determines how selected sub-formulas are distinguished. If @code{calc-highlight-selections-with-faces} is @code{nil}, then @@ -35671,7 +35671,7 @@ be preserved. The default value of @code{calc-undo-length} is @expr{100}. @end defvar @defvar calc-gregorian-switch -See @ref{Date Forms}.@* +@xref{Date Forms}.@* The variable @code{calc-gregorian-switch} is either a list of integers @code{(@var{YEAR} @var{MONTH} @var{DAY})} or @code{nil}. If it is @code{nil}, then Calc's date forms always represent Gregorian dates. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index b46eb80055a..f98a21743ac 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -925,7 +925,7 @@ behavior prior to version 5.32.}, set @code{c-defun-tactic} to These functions are analogous to the Emacs built-in commands @code{beginning-of-defun} and @code{end-of-defun}, except they eliminate the constraint that the top-level opening brace of the defun -must be in column zero. See @ref{Defuns,,,@emacsman{}, +must be in column zero. @xref{Defuns,,,@emacsman{}, @emacsmantitle{}}, for more information. @item @kbd{C-M-a} (AWK Mode) (@code{c-awk-beginning-of-defun}) @@ -1485,8 +1485,8 @@ Sometimes @ccmode{} inserts an auto-newline where you don't want one, such as after a @samp{@}} when you're about to type a @samp{;}. Hungry deletion can help here (@pxref{Hungry WS Deletion}), or you can activate an appropriate @dfn{clean-up}, which will remove the excess -whitespace after you've typed the @samp{;}. See @ref{Clean-ups} for a -full description. See also @ref{Electric Keys} for a summary of +whitespace after you've typed the @samp{;}. @xref{Clean-ups}, for a +full description. See also @ref{Electric Keys}, for a summary of clean-ups listed by key. @@ -2420,7 +2420,7 @@ Mode and Java Mode buffers, you could do it like this: @end group @end example -See @ref{CC Hooks} for more details on the use of @ccmode{} hooks. +@xref{CC Hooks}, for more details on the use of @ccmode{} hooks. @item Styles A @ccmode{} @dfn{style} is a coherent collection of customizations @@ -2438,7 +2438,7 @@ in your @file{.emacs} file: (other . "free-group-style"))) @end example -See @ref{Styles} for fuller details on using @ccmode{} styles and how +@xref{Styles}, for fuller details on using @ccmode{} styles and how to create them. @item File Local Variable setting @@ -3312,7 +3312,7 @@ different ways, depending on the character just typed: an alist. This element specifies where to put newlines: this is any combination of before and after the brace or colon. If no alist element is found, newlines are inserted both before and after a brace, -but none are inserted around a colon. See @ref{Hanging Braces} and +but none are inserted around a colon. @xref{Hanging Braces}, and @ref{Hanging Colons}. @item Semicolons and Commas diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index c8aac971ec7..0e03afc98ff 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -524,7 +524,7 @@ find where a test was defined only if the test was loaded from a file. If the test definition is generated by a macro, the macro may want to help ERT find the defining call to the macro by putting the property -@code{definition-type} on the test name. +@code{find-function-type-alist} on the test name. @xref{Standard Properties,,,elisp, GNU Emacs Lisp Reference Manual}. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 41ec75a5ed2..8a497ebb228 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -18252,7 +18252,8 @@ inherited. This section describes a special mail back end called @code{nndiary}, and its companion library @code{gnus-diary}. It is ``special'' in the sense that it is not meant to be one of the standard alternatives for -reading mail with Gnus. See @ref{Choosing a Mail Back End} for that. +reading mail with Gnus. (@xref{Choosing a Mail Back End}, for +description of the standard mail back ends.) Instead, it is used to treat @emph{some} of your mails in a special way, namely, as event reminders. diff --git a/doc/misc/htmlfontify.texi b/doc/misc/htmlfontify.texi index fd9b9435123..5d51c2dd518 100644 --- a/doc/misc/htmlfontify.texi +++ b/doc/misc/htmlfontify.texi @@ -141,7 +141,7 @@ and hyperlinks as appropriate. (htmlfontify-run-etags @var{srcdir}) @end lisp -Load the etags cache for @var{srcdir}. See @ref{hfy-load-tags-cache}. +Load the etags cache for @var{srcdir}. @xref{hfy-load-tags-cache}. @item htmlfontify-copy-and-link-dir @findex htmlfontify-copy-and-link-dir @@ -828,7 +828,7 @@ If @var{class} is @code{nil}, then you just get whatever @code{face-attr-construct} returns; i.e., the current specification in effect for @var{face}. -See @ref{hfy-display-class} for details of valid values for @var{class}. +@xref{hfy-display-class}, for details of valid values for @var{class}. @item hfy-face-at @findex hfy-face-at @@ -1069,7 +1069,7 @@ Each tag hash entry then contains entries of the form: i.e., an alist mapping (relative) file paths to line and character offsets. -See @ref{hfy-load-tags-cache}. +@xref{hfy-load-tags-cache}. @item hfy-tags-rmap @vindex hfy-tags-rmap diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi index 0db01faf3d1..0e10e2078a4 100644 --- a/doc/misc/idlwave.texi +++ b/doc/misc/idlwave.texi @@ -2546,8 +2546,8 @@ commands: In addition to these standard @file{comint} commands, @code{idlwave-shell-mode} provides many of the same commands which simplify writing IDL code available in IDLWAVE buffers. This includes -abbreviations, online help, and completion. See @ref{Routine Info} and -@ref{Online Help} and @ref{Completion} for more information on these +abbreviations, online help, and completion. @xref{Routine Info}, and +@ref{Online Help}, and @ref{Completion}, for more information on these commands. @cindex Completion, in the shell diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi index 5f99acaf7d8..12b4ea41810 100644 --- a/doc/misc/smtpmail.texi +++ b/doc/misc/smtpmail.texi @@ -225,7 +225,8 @@ send mail via a server and the SMTP server reports back that it requires authentication, Emacs (version 24.1 and later) prompts you for the user name and password to use, and then offers to save the information. By default, Emacs stores authentication information in a -file @file{~/.authinfo}. +file @file{~/.authinfo}, but this can be changed by customizing +@code{auth-sources} (@pxref{Authentication, Persisting Authinfo,,emacs}). @vindex smtpmail-servers-requiring-authorization Some SMTP servers may bandwidth-limit (or deny) requests from clients diff --git a/doc/misc/srecode.texi b/doc/misc/srecode.texi index e8c0958c252..8e075da8c07 100644 --- a/doc/misc/srecode.texi +++ b/doc/misc/srecode.texi @@ -121,7 +121,7 @@ or add into a language hook function to force it on (which is the default) or pass in @code{-1} to force it off. -See @ref{SRecode Minor Mode} for more on using the minor mode. +@xref{SRecode Minor Mode}, for more on using the minor mode. Use the menu to insert templates into the current file. @@ -169,7 +169,7 @@ Each template file you write is dedicated to a single major mode. In it, you can write templates within the same context and with the same name as core templates. You can force your templates to override the core templates for a particular major mode by setting the -priority. See @ref{Special Variables}. +priority. @xref{Special Variables}. To get going quickly, open a new @file{.srt} file. It will start in the @srecode{} template writing mode. Use the @srecode{} minor mode @@ -237,8 +237,8 @@ used in macros in a template. Variables are what allows a generic template such as a function to be made specific, such as a function named foo. The value of a variable can be one of three things; a string, a list of more dictionaries, or a special -@code{srecode-dictionary-compound-value} object subclass. See -@ref{Variables} for more. +@code{srecode-dictionary-compound-value} object subclass. +@xref{Variables}, for more about this. @section Template Insertion The template insertion layer involves extensions to the basic template @@ -589,8 +589,8 @@ A variable can also have a compound value. This means the value of the variable is an @EIEIO{} object, which is a subclass of @code{srecode-dictionary-compound-value}. -New compound variables can only be setup from Lisp code. See -@ref{Compound Dictionary Values} for details on setting up compound +New compound variables can only be setup from Lisp code. +@xref{Compound Dictionary Values}, for details on setting up compound variables from Lisp. @node Templates @@ -707,7 +707,7 @@ major mode. Template macros occur in the template text. The default escape characters are ``@{@{`` and ``@}@}'', though they can be changed -in the top-level variables. See @ref{Variables}. +in the top-level variables. @xref{Variables}. Thus, if you have the template code that looks like this: diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 45ecf18b06e..3fef196219d 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -853,8 +853,8 @@ as the @option{rsh} method. Instead of connecting to a remote host, @command{su} program allows editing as another user. The host can be either @samp{localhost} or -the host returned by the function @command{(system-name)}. See -@ref{Multi-hops} for an exception to this behavior. +the host returned by the function @command{(system-name)}. +@xref{Multi-hops}, for an exception to this behavior. @cindex method @option{androidsu} @cindex @option{androidsu} method @@ -907,7 +907,7 @@ This is an optional method, @pxref{Optional methods}. The @command{sg} program allows editing as different group. The host can be either @samp{localhost} or the host returned by the function @command{(system-name)}. The user name must be specified, but it -denotes a group name. See @ref{Multi-hops} for an exception to this +denotes a group name. @xref{Multi-hops}, for an exception to this behavior. @cindex method @option{sshx} @@ -1566,7 +1566,7 @@ remote file name, it is ignored. Access via @option{rclone} is slow. If you have an alternative method for accessing the system storage, you should use it. -@ref{GVFS-based methods} for example, methods @option{gdrive} and +For example, see @ref{GVFS-based methods}, methods @option{gdrive} and @option{nextcloud}. @cindex method @option{sshfs} @@ -2390,7 +2390,7 @@ to a remote home directory, like @option{adb}, @option{rclone} and The temporary directory on the remote host. If not specified, the default value is @t{"/data/local/tmp"} for the @option{adb} method, @t{"/C$/Temp"} for the @option{smb} method, and @t{"/tmp"} otherwise. -@ref{Temporary directory}. +@xref{Temporary directory}. @item @t{"posix"} @@ -2535,8 +2535,8 @@ connection information}. If you want, for example, use @end lisp This works only for connection methods which allow overriding the -remote login shell, like @option{sshx} or @option{plink}. See -@ref{Inline methods} and @ref{External methods} for connection methods +remote login shell, like @option{sshx} or @option{plink}. +@xref{Inline methods}, and @ref{External methods}, for connection methods which support this. @vindex tramp-sh-extra-args @@ -5445,8 +5445,8 @@ as value of the @env{TERM} environment variable. If you want to use another value for @env{TERM}, change @code{tramp-terminal-type} and this line accordingly. -Alternatively, you can set the remote login shell explicitly. See -@ref{Remote shell setup} for discussion of this technique, +Alternatively, you can set the remote login shell explicitly. +@xref{Remote shell setup}, for discussion of this technique, When using fish shell on remote hosts, disable fancy formatting by adding the following to @file{~/.config/fish/config.fish}: diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index 2f2e4cf7edd..fb8b6da145c 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -789,7 +789,7 @@ used to draw the line. This user option may be overridden if @code{:mode-line-format} is passed when creating a new prefix with @code{transient-define-prefix}. -Otherwise this can be any mode-line format. See @ref{Mode Line Format,,,elisp,}, for details. +Otherwise this can be any mode-line format. @xref{Mode Line Format,,,elisp,}, for details. @end defopt @defopt transient-semantic-coloring @@ -1089,14 +1089,14 @@ enabled. One benefit of the Transient interface is that it remembers history not only on a global level (``this command was invoked using these arguments, and previously it was invoked using those other arguments''), but also remembers the values of individual arguments -independently. See @ref{Using History}. +independently. @xref{Using History}. After a transient prefix command is invoked, @kbd{C-h @var{KEY}} can be used to show the documentation for the infix or suffix command that @kbd{@var{KEY}} is bound to (see @ref{Getting Help for Suffix Commands}), and infixes and suffixes can be removed from the transient using @kbd{C-x l @var{KEY}}. Infixes and suffixes that are disabled by default can be enabled the same way. -See @ref{Enabling and Disabling Suffixes}. +@xref{Enabling and Disabling Suffixes}. Transient ships with support for a few different types of specialized infix commands. A command that sets a command line option, for example, @@ -1444,7 +1444,7 @@ guessed based on the long argument. If the argument ends with @samp{=} Finally, details can be specified using optional @var{KEYWORD}-@var{VALUE} pairs. Each keyword has to be a keyword symbol, either @code{:class} or a keyword -argument supported by the constructor of that class. See @ref{Suffix Slots}. +argument supported by the constructor of that class. @xref{Suffix Slots}. @node Defining Suffix and Infix Commands @section Defining Suffix and Infix Commands @@ -1726,8 +1726,8 @@ means that all outer prefixes are exited at once. @item The behavior for non-suffixes can be set for a particular prefix, by the prefix's @code{transient-non-suffix} slot to a boolean, a suitable -pre-command function, or a shorthand for such a function. See -@ref{Pre-commands for Non-Suffixes}. +pre-command function, or a shorthand for such a function. +@xref{Pre-commands for Non-Suffixes}. @item The common behavior for the suffixes of a particular prefix can be @@ -2424,7 +2424,7 @@ secondary value, called a ``scope''. See @code{transient-define-prefix}. @code{transient-suffix}, @code{transient-non-suffix} and @code{transient-switch-frame} play a part when determining whether the currently active transient prefix command remains active/transient when a suffix or arbitrary -non-suffix command is invoked. See @ref{Transient State}. +non-suffix command is invoked. @xref{Transient State}. @item @code{refresh-suffixes} Normally suffix objects and keymaps are only setup @@ -2760,7 +2760,7 @@ currently cannot be invoked. By default these predicates run when the prefix command is invoked, but this can be changes, using the @code{refresh-suffixes} prefix slot. -See @ref{Prefix Slots}. +@xref{Prefix Slots}. One more slot is shared between group and suffix classes, @code{level}. Like the slots documented above, it is a predicate, but it is used for a diff --git a/doc/misc/wisent.texi b/doc/misc/wisent.texi index a92f61fd6c7..6c700779ba7 100644 --- a/doc/misc/wisent.texi +++ b/doc/misc/wisent.texi @@ -446,8 +446,8 @@ matching the empty string, for which the default action is to return @section Example @cindex grammar example -Here is an example to parse simple infix arithmetic expressions. See -@ref{Infix Calc, , , bison}, in the Bison manual for details. +Here is an example to parse simple infix arithmetic expressions. +@xref{Infix Calc, , , bison}, in the Bison manual for details. @lisp @group @@ -570,7 +570,7 @@ must be @dfn{LALR(1)}. @cindex look-ahead token A grammar is @acronym{LALR(1)} if it is possible to tell how to parse any portion of an input string with just a single token of look-ahead: -the @dfn{look-ahead token}. See @ref{Language and Grammar, , , +the @dfn{look-ahead token}. @xref{Language and Grammar, , , bison}, in the Bison manual for more information. @cindex grammar compilation @@ -643,7 +643,7 @@ When either a shift or a reduction would be valid at the same state. Such conflicts are resolved by choosing to shift, unless otherwise directed by operator precedence declarations. -See @ref{Shift/Reduce , , , bison}, in the Bison manual for more +@xref{Shift/Reduce , , , bison}, in the Bison manual for more information. @cindex reduce/reduce conflicts @@ -654,8 +654,8 @@ grammar. Such conflicts are resolved by choosing to use the rule that appears first in the grammar, but it is very risky to rely on this. Every -reduce/reduce conflict must be studied and usually eliminated. See -@ref{Reduce/Reduce , , , bison}, in the Bison manual for more +reduce/reduce conflict must be studied and usually eliminated. +@xref{Reduce/Reduce , , , bison}, in the Bison manual for more information. @end table @@ -701,7 +701,7 @@ reports are separated from each other by a line like this: @end example where @var{source-file} is the name of the Emacs Lisp file from which -the grammar was read. See @ref{Understanding the automaton}, for +the grammar was read. @xref{Understanding the automaton}, for details on the verbose report. @table @strong @@ -1312,7 +1312,7 @@ value of the variable @code{wisent-recovering} is non-@code{nil}. @cindex error recovery The error recovery mechanism of the Wisent's parser conforms to the -one Bison uses. See @ref{Error Recovery, , , bison}, in the Bison +one Bison uses. @xref{Error Recovery, , , bison}, in the Bison manual for details. @cindex error token diff --git a/etc/NEWS b/etc/NEWS index 2f04204ad94..0b849dec450 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -90,6 +90,15 @@ If you have been using these variables in Lisp code (for example, in font-lock rules), simply quote the symbol, to use the face directly instead of its now-obsolete variable. +** Network Security Manager (NSM) is now more strict. + +*** NSM warns about TLS 1.1 by default. +It has been deprecated by RFC8996, published in 2021. + +*** NSM warns about DHE key exchange by default. +Emacs now warns about ephemeral Diffie-Hellman key exchanges also when +'network-security-level' is customized to its default 'medium' value. + ** Etags +++ @@ -277,12 +286,13 @@ The Tifinagh script is used to write the Berber languages. *** New input methods for Northern Iroquoian languages. Input methods are now implemented for Haudenosaunee languages in the Northern Iroquoian language family: 'mohawk-postfix' (Mohawk -[Kanien’kéha / Onkwehonwehnéha]), 'oneida-postfix' (Oneida -[Onʌyote’a·ká· / Ukwehuwehnéha]), 'cayuga-postfix' (Cayuga -[Gayogo̱ho:nǫhnéha:ˀ]), 'onondaga-postfix' (Onondaga [Onųdaʔgegáʔ]), and -'seneca-postfix' (Seneca [Onödowá’ga:’]). Additionally, there is a -general-purpose 'haudenosaunee-postfix' input method to facilitate -writing in the orthographies of the five languages simultaneously. +[Kanien’kéha / Kanyen’kéha / Onkwehonwehnéha]), 'oneida-postfix' (Oneida +[Onʌyote’a·ká· / Onyota’a:ká: / Ukwehuwehnéha]), 'cayuga-postfix' +(Cayuga [Gayogo̱ho:nǫhnéha:ˀ]), 'onondaga-postfix' (Onondaga +[Onųdaʔgegáʔ]), and 'seneca-postfix' (Seneca [Onödowá’ga:’]). +Additionally, there is a general-purpose 'haudenosaunee-postfix' input +method to facilitate writing in the orthographies of the five languages +simultaneously. --- ** 'visual-wrap-prefix-mode' now supports variable-pitch fonts. @@ -332,6 +342,11 @@ modal editing packages. * Changes in Specialized Modes and Packages in Emacs 31.1 +--- +** ASM mode +*** 'asm-mode-set-comment-hook' is obsolete. +You can now set `asm-comment-char' from 'asm-mode-hook' instead. + --- ** Ibuffer *** New column 'recency' in Ibuffer display. @@ -377,6 +392,9 @@ Emacs 25.1), and gnudoit (obsolete since Emacs 25.1). *** 'cl-labels' now also accepts '(FUNC EXP)' bindings, like 'cl-flet'. Such bindings make it possible to compute which function to bind to FUNC. +--- +*** 'cl-block' names are now lexically scoped, as documented. + ** Whitespace --- @@ -1166,11 +1184,14 @@ It offers a more concise way to create a completion table with metadata. ** 'all-completions' and 'unintern' no longer support old calling conventions. +++ -** New symbol property 'definition-type' used by 'find-function' and friends. +** New symbol property 'find-function-type-alist' used by 'find-function' etc. Macros that define an object in a way that makes the object's name and -the macro call site defining the object hard to associate can put the -property 'definition-type' on the object's name to provide instructions -for finding the definition. +the macro call site defining the object hard to associate can add an +entry to the property 'find-function-type-alist' on the object's name to +provide instructions for finding the definition. + +New convenience function 'find-function-update-type-alist' offers a +concise way to update a symbol's 'find-function-type-alist' property. * Changes in Emacs 31.1 on Non-Free Operating Systems diff --git a/etc/NEWS.30 b/etc/NEWS.30 index 31a0c4938ad..ce5290171a1 100644 --- a/etc/NEWS.30 +++ b/etc/NEWS.30 @@ -172,17 +172,17 @@ the default one. It is reimplemented in native code, reducing GC churn. To undo this change, set 'fast-read-process-output' to nil. +++ -** The Network Security Manager now warns about 3DES by default. +** Network Security Manager now warns about 3DES by default. This cypher is no longer recommended owing to a major vulnerability disclosed in 2016, and its small 112 bit key size. Emacs now warns about its use also when 'network-security-level' is set to 'medium' (the default). See 'network-security-protocol-checks'. --- -** The Network Security Manager now warns about <2048 bits in DH key exchange. -Emacs used to warn for Diffie-Hellman key exchanges with prime numbers -smaller than 1024 bits. Since more servers now support it, this -number has been bumped to 2048 bits. +** Network Security Manager now warns about <2048 bits in DH key exchange. +Emacs used to warn for ephemeral Diffie-Hellman (DHE) key exchanges with +prime numbers smaller than 1024 bits. Since more servers now support +it, this number has been bumped to 2048 bits. +++ ** URL now never sends user email addresses in HTTP requests. diff --git a/etc/symbol-releases.eld b/etc/symbol-releases.eld index de1eaad6bd1..0609dd1467f 100644 --- a/etc/symbol-releases.eld +++ b/etc/symbol-releases.eld @@ -14,6 +14,7 @@ ("26.1" fun and-let*) ("26.1" fun if-let*) ("24.4" fun set-transient-map) + ("22.1" fun clear-string) ("22.1" fun version=) ("22.1" fun version<) ("22.1" fun version<=) diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h index 5f06c4fe10f..ac61c0865a4 100644 --- a/lib/fcntl.in.h +++ b/lib/fcntl.in.h @@ -369,8 +369,12 @@ _GL_WARN_ON_USE (openat, "openat is not portable - " # define O_RSYNC 0 #endif +#if defined O_SEARCH && defined O_PATH && O_SEARCH == O_PATH +# undef O_SEARCH /* musl mistakenly #defines O_SEARCH to O_PATH. */ +#endif + #ifndef O_SEARCH -# define O_SEARCH O_RDONLY /* This is often close enough in older systems. */ +# define O_SEARCH O_RDONLY /* Often close enough in non-POSIX systems. */ #endif #ifndef O_SYNC diff --git a/lib/file-has-acl.c b/lib/file-has-acl.c index 35dcc19f169..c02cfee842b 100644 --- a/lib/file-has-acl.c +++ b/lib/file-has-acl.c @@ -99,6 +99,37 @@ enum { ACE4_IDENTIFIER_GROUP = 0x00000040 }; +/* AI indicates XATTR may be present but wasn't accessible. + This is the case when [l]listxattr failed with E2BIG, + or is not supported (!acl_errno_valid()), or failed with EACCES + which in Linux kernel 6.12 NFS can mean merely that we lack read access. +*/ + +static bool +aclinfo_may_indicate_xattr (struct aclinfo const *ai) +{ + return ai->size < 0 && (!acl_errno_valid (ai->u.err) + || ai->u.err == EACCES || ai->u.err == E2BIG); +} + +/* Does NAME have XATTR? */ + +static bool +has_xattr (char const *xattr, struct aclinfo const *ai, + MAYBE_UNUSED char const *restrict name, MAYBE_UNUSED int flags) +{ + if (ai && aclinfo_has_xattr (ai, xattr)) + return true; + else if (!ai || aclinfo_may_indicate_xattr (ai)) + { + int ret = ((flags & ACL_SYMLINK_FOLLOW ? getxattr : lgetxattr) + (name, xattr, NULL, 0)); + if (0 <= ret || (errno == ERANGE || errno == E2BIG)) + return true; + } + return false; +} + /* Does AI's xattr set contain XATTR? */ bool @@ -176,11 +207,13 @@ get_aclinfo (char const *name, struct aclinfo *ai, int flags) } } - if (0 < ai->size && flags & ACL_GET_SCONTEXT) + /* A security context can exist only if extended attributes do. */ + if (flags & ACL_GET_SCONTEXT + && (0 < ai->size || aclinfo_may_indicate_xattr (ai))) { if (is_smack_enabled ()) { - if (aclinfo_has_xattr (ai, XATTR_NAME_SMACK)) + if (ai->size < 0 || aclinfo_has_xattr (ai, XATTR_NAME_SMACK)) { ssize_t r = smack_new_label_from_path (name, "security.SMACK64", flags & ACL_SYMLINK_FOLLOW, @@ -191,7 +224,7 @@ get_aclinfo (char const *name, struct aclinfo *ai, int flags) else { # if USE_SELINUX_SELINUX_H - if (aclinfo_has_xattr (ai, XATTR_NAME_SELINUX)) + if (ai->size < 0 || aclinfo_has_xattr (ai, XATTR_NAME_SELINUX)) { ssize_t r = ((flags & ACL_SYMLINK_FOLLOW ? getfilecon : lgetfilecon) @@ -352,7 +385,7 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, int initial_errno = errno; get_aclinfo (name, ai, flags); - if (ai->size <= 0) + if (!aclinfo_may_indicate_xattr (ai) && ai->size <= 0) { errno = ai->size < 0 ? ai->u.err : initial_errno; return ai->size; @@ -363,11 +396,11 @@ file_has_aclinfo (MAYBE_UNUSED char const *restrict name, In earlier Fedora the two types of ACLs were mutually exclusive. Attempt to work correctly on both kinds of systems. */ - if (!aclinfo_has_xattr (ai, XATTR_NAME_NFSV4_ACL)) + if (!has_xattr (XATTR_NAME_NFSV4_ACL, ai, name, flags)) return - (aclinfo_has_xattr (ai, XATTR_NAME_POSIX_ACL_ACCESS) + (has_xattr (XATTR_NAME_POSIX_ACL_ACCESS, ai, name, flags) || ((d_type == DT_DIR || d_type == DT_UNKNOWN) - && aclinfo_has_xattr (ai, XATTR_NAME_POSIX_ACL_DEFAULT))); + && has_xattr (XATTR_NAME_POSIX_ACL_DEFAULT, ai, name, flags))); /* A buffer large enough to hold any trivial NFSv4 ACL. The max length of a trivial NFSv4 ACL is 6 words for owner, diff --git a/lib/getopt-pfx-core.h b/lib/getopt-pfx-core.h index 391c7af8e71..7c5ea094683 100644 --- a/lib/getopt-pfx-core.h +++ b/lib/getopt-pfx-core.h @@ -37,6 +37,9 @@ # if defined _AIX || defined __hpux || defined __sun || defined __QNX__ # include # endif +# if defined MUSL_LIBC || (defined __FreeBSD__ || defined __DragonFly__) || defined __NetBSD__ || defined __OpenBSD__ || (defined __APPLE__ && defined __MACH__) || defined _AIX || defined __sun || defined __minix || defined __HAIKU__ +# include +# endif # ifndef __GETOPT_ID # define __GETOPT_CONCAT(x, y) x ## y diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index a42e77e99b8..22d102b1d86 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -132,6 +132,7 @@ # largefile \ # libgmp \ # lstat \ +# malloc-gnu \ # manywarnings \ # memmem-simple \ # mempcpy \ @@ -150,6 +151,7 @@ # qcopy-acl \ # readlink \ # readlinkat \ +# realloc-posix \ # regex \ # sig2str \ # sigdescr_np \ @@ -489,6 +491,8 @@ GL_GNULIB_MBSSPN = @GL_GNULIB_MBSSPN@ GL_GNULIB_MBSSTR = @GL_GNULIB_MBSSTR@ GL_GNULIB_MBSTOK_R = @GL_GNULIB_MBSTOK_R@ GL_GNULIB_MBSTOWCS = @GL_GNULIB_MBSTOWCS@ +GL_GNULIB_MBS_ENDSWITH = @GL_GNULIB_MBS_ENDSWITH@ +GL_GNULIB_MBS_STARTSWITH = @GL_GNULIB_MBS_STARTSWITH@ GL_GNULIB_MBTOWC = @GL_GNULIB_MBTOWC@ GL_GNULIB_MDA_ACCESS = @GL_GNULIB_MDA_ACCESS@ GL_GNULIB_MDA_CHDIR = @GL_GNULIB_MDA_CHDIR@ @@ -642,6 +646,8 @@ GL_GNULIB_STRTOUL = @GL_GNULIB_STRTOUL@ GL_GNULIB_STRTOULL = @GL_GNULIB_STRTOULL@ GL_GNULIB_STRTOUMAX = @GL_GNULIB_STRTOUMAX@ GL_GNULIB_STRVERSCMP = @GL_GNULIB_STRVERSCMP@ +GL_GNULIB_STR_ENDSWITH = @GL_GNULIB_STR_ENDSWITH@ +GL_GNULIB_STR_STARTSWITH = @GL_GNULIB_STR_STARTSWITH@ GL_GNULIB_SYMLINK = @GL_GNULIB_SYMLINK@ GL_GNULIB_SYMLINKAT = @GL_GNULIB_SYMLINKAT@ GL_GNULIB_SYSTEM_POSIX = @GL_GNULIB_SYSTEM_POSIX@ @@ -725,6 +731,8 @@ HAVE_ALLOCA_H = @HAVE_ALLOCA_H@ HAVE_ALPHASORT = @HAVE_ALPHASORT@ HAVE_ATOLL = @HAVE_ATOLL@ HAVE_BE_APP = @HAVE_BE_APP@ +HAVE_BLKCNT_T = @HAVE_BLKCNT_T@ +HAVE_BLKSIZE_T = @HAVE_BLKSIZE_T@ HAVE_C99_STDINT_H = @HAVE_C99_STDINT_H@ HAVE_CANONICALIZE_FILE_NAME = @HAVE_CANONICALIZE_FILE_NAME@ HAVE_CHOWN = @HAVE_CHOWN@ @@ -1472,14 +1480,12 @@ gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7_CONDITION = @gl_GNULIB_ENABLE gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b_CONDITION = @gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b_CONDITION@ gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31_CONDITION = @gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31_CONDITION@ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_CONDITION = @gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_CONDITION@ -gl_GNULIB_ENABLED_61bcaca76b3e6f9ae55d57a1c3193bc4_CONDITION = @gl_GNULIB_ENABLED_61bcaca76b3e6f9ae55d57a1c3193bc4_CONDITION@ gl_GNULIB_ENABLED_8444034ea779b88768865bb60b4fb8c9_CONDITION = @gl_GNULIB_ENABLED_8444034ea779b88768865bb60b4fb8c9_CONDITION@ gl_GNULIB_ENABLED_925677f0343de64b89a9f0c790b4104c_CONDITION = @gl_GNULIB_ENABLED_925677f0343de64b89a9f0c790b4104c_CONDITION@ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_CONDITION = @gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_CONDITION@ gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_CONDITION = @gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_CONDITION@ gl_GNULIB_ENABLED_cloexec_CONDITION = @gl_GNULIB_ENABLED_cloexec_CONDITION@ gl_GNULIB_ENABLED_dirfd_CONDITION = @gl_GNULIB_ENABLED_dirfd_CONDITION@ -gl_GNULIB_ENABLED_e80bf6f757095d2e5fc94dafb8f8fc8b_CONDITION = @gl_GNULIB_ENABLED_e80bf6f757095d2e5fc94dafb8f8fc8b_CONDITION@ gl_GNULIB_ENABLED_endian_CONDITION = @gl_GNULIB_ENABLED_endian_CONDITION@ gl_GNULIB_ENABLED_euidaccess_CONDITION = @gl_GNULIB_ENABLED_euidaccess_CONDITION@ gl_GNULIB_ENABLED_fd38c7e463b54744b77b98aeafb4fa7c_CONDITION = @gl_GNULIB_ENABLED_fd38c7e463b54744b77b98aeafb4fa7c_CONDITION@ @@ -2612,17 +2618,17 @@ ifneq (,$(GL_GENERATE_GMP_H_CONDITION)) ifneq (,$(GL_GENERATE_MINI_GMP_H_CONDITION)) # Build gmp.h as a wrapper for mini-gmp.h when using mini-gmp. gmp.h: $(top_builddir)/config.status - echo '#include "mini-gmp.h"' > $@-t - echo '#if GNULIB_LIBGMP_MPQ' >> $@-t - echo '# include "mini-mpq.h"' >> $@-t - echo '#endif' >> $@-t - mv $@-t $@ + $(gl_V_at)echo '#include "mini-gmp.h"' > $@-t + $(AM_V_at)echo '#if GNULIB_LIBGMP_MPQ' >> $@-t + $(AM_V_at)echo '# include "mini-mpq.h"' >> $@-t + $(AM_V_at)echo '#endif' >> $@-t + $(AM_V_at)mv $@-t $@ endif ifneq (,$(GL_GENERATE_GMP_GMP_H_CONDITION)) # Build gmp.h as a wrapper for gmp/gmp.h. gmp.h: $(top_builddir)/config.status - echo '#include ' > $@-t - mv $@-t $@ + $(gl_V_at)echo '#include ' > $@-t + $(AM_V_at)mv $@-t $@ endif else gmp.h: $(top_builddir)/config.status @@ -2682,9 +2688,7 @@ endif ## begin gnulib module malloc-gnu ifeq (,$(OMIT_GNULIB_MODULE_malloc-gnu)) -ifneq (,$(gl_GNULIB_ENABLED_e80bf6f757095d2e5fc94dafb8f8fc8b_CONDITION)) -endif EXTRA_DIST += malloc.c EXTRA_libgnu_a_SOURCES += malloc.c @@ -2927,12 +2931,10 @@ endif ## begin gnulib module realloc-posix ifeq (,$(OMIT_GNULIB_MODULE_realloc-posix)) -ifneq (,$(gl_GNULIB_ENABLED_61bcaca76b3e6f9ae55d57a1c3193bc4_CONDITION)) ifneq (,$(GL_COND_OBJ_REALLOC_POSIX_CONDITION)) libgnu_a_SOURCES += realloc.c endif -endif endif ## end gnulib module realloc-posix @@ -3655,6 +3657,8 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's/@''GNULIB_MBSSPN''@/$(GL_GNULIB_MBSSPN)/g' \ -e 's/@''GNULIB_MBSSEP''@/$(GL_GNULIB_MBSSEP)/g' \ -e 's/@''GNULIB_MBSTOK_R''@/$(GL_GNULIB_MBSTOK_R)/g' \ + -e 's/@''GNULIB_MBS_ENDSWITH''@/$(GL_GNULIB_MBS_ENDSWITH)/g' \ + -e 's/@''GNULIB_MBS_STARTSWITH''@/$(GL_GNULIB_MBS_STARTSWITH)/g' \ -e 's/@''GNULIB_MEMCHR''@/$(GL_GNULIB_MEMCHR)/g' \ -e 's/@''GNULIB_MEMMEM''@/$(GL_GNULIB_MEMMEM)/g' \ -e 's/@''GNULIB_MEMPCPY''@/$(GL_GNULIB_MEMPCPY)/g' \ @@ -3673,6 +3677,8 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's/@''GNULIB_STRSTR''@/$(GL_GNULIB_STRSTR)/g' \ -e 's/@''GNULIB_STRCASESTR''@/$(GL_GNULIB_STRCASESTR)/g' \ -e 's/@''GNULIB_STRTOK_R''@/$(GL_GNULIB_STRTOK_R)/g' \ + -e 's/@''GNULIB_STR_ENDSWITH''@/$(GL_GNULIB_STR_ENDSWITH)/g' \ + -e 's/@''GNULIB_STR_STARTSWITH''@/$(GL_GNULIB_STR_STARTSWITH)/g' \ -e 's/@''GNULIB_STRERROR''@/$(GL_GNULIB_STRERROR)/g' \ -e 's/@''GNULIB_STRERROR_R''@/$(GL_GNULIB_STRERROR_R)/g' \ -e 's/@''GNULIB_STRERRORNAME_NP''@/$(GL_GNULIB_STRERRORNAME_NP)/g' \ @@ -3985,6 +3991,8 @@ sys/types.h: sys_types.in.h $(top_builddir)/config.status -e 's|@''WINDOWS_64_BIT_OFF_T''@|$(WINDOWS_64_BIT_OFF_T)|g' \ -e 's|@''HAVE_OFF64_T''@|$(HAVE_OFF64_T)|g' \ -e 's|@''WINDOWS_STAT_INODES''@|$(WINDOWS_STAT_INODES)|g' \ + -e 's|@''HAVE_BLKSIZE_T''@|$(HAVE_BLKSIZE_T)|g' \ + -e 's|@''HAVE_BLKCNT_T''@|$(HAVE_BLKCNT_T)|g' \ $(srcdir)/sys_types.in.h > $@-t $(AM_V_at)mv $@-t $@ MOSTLYCLEANFILES += sys/types.h sys/types.h-t diff --git a/lib/mktime-internal.h b/lib/mktime-internal.h index 1da98b43732..215be914c2f 100644 --- a/lib/mktime-internal.h +++ b/lib/mktime-internal.h @@ -19,6 +19,9 @@ #ifndef _LIBC # include +# define __libc_lock_lock(lock) ((void) 0) +# define __libc_lock_unlock(lock) ((void) 0) +# define __tzset_unlocked() tzset () #endif /* mktime_offset_t is a signed type wide enough to hold a UTC offset @@ -73,6 +76,8 @@ typedef int mktime_offset_t; /* Subroutine of mktime. Return the time_t representation of TP and normalize TP, given that a struct tm * maps to a time_t. If LOCAL, the mapping is performed by localtime_r, otherwise by gmtime_r. - Record next guess for localtime-gmtime offset in *OFFSET. */ + Record next guess for localtime-gmtime offset in *OFFSET. + + If _LIBC, the caller must lock __tzset_lock. */ extern __time64_t __mktime_internal (struct tm *tp, bool local, mktime_offset_t *offset) attribute_hidden; diff --git a/lib/mktime.c b/lib/mktime.c index 74403e4530e..4218fca69b1 100644 --- a/lib/mktime.c +++ b/lib/mktime.c @@ -62,6 +62,9 @@ # define NEED_MKTIME_WORKING 0 #endif +#ifdef _LIBC +# include +#endif #include "mktime-internal.h" #if !defined _LIBC && (NEED_MKTIME_WORKING || NEED_MKTIME_WINDOWS) @@ -98,8 +101,8 @@ my_tzset (void) tzset (); # endif } -# undef __tzset -# define __tzset() my_tzset () +# undef tzset +# define tzset() my_tzset () #endif #if defined _LIBC || NEED_MKTIME_WORKING || NEED_MKTIME_INTERNAL @@ -250,6 +253,7 @@ tm_diff (long_int year, long_int yday, int hour, int min, int sec, tp->tm_hour, tp->tm_min, tp->tm_sec); } +#ifndef _LIBC /* Convert T to a struct tm value in *TM. Use localtime64_r if LOCAL, otherwise gmtime64_r. T must be in range for __time64_t. Return TM if successful, NULL (setting errno) on failure. */ @@ -262,8 +266,8 @@ convert_time (long_int t, bool local, struct tm *tm) else return __gmtime64_r (&x, tm); } -/* Call it __tzconvert to sync with other parts of glibc. */ -#define __tz_convert convert_time +# define __tz_convert convert_time +#endif /* Convert *T to a broken down time in *TP (as if by localtime if LOCAL, otherwise as if by gmtime). If *T is out of range for @@ -320,7 +324,9 @@ ranged_convert (bool local, long_int *t, struct tm *tp) If *OFFSET's guess is correct, only one reverse mapping call is needed. If successful, set *TP to the canonicalized struct tm; otherwise leave *TP alone, return ((time_t) -1) and set errno. - This function is external because it is used also by timegm.c. */ + This function is external because it is used also by timegm.c. + + If _LIBC, the caller must lock __tzset_lock. */ __time64_t __mktime_internal (struct tm *tp, bool local, mktime_offset_t *offset) { @@ -349,12 +355,10 @@ __mktime_internal (struct tm *tp, bool local, mktime_offset_t *offset) int mday = tp->tm_mday; int mon = tp->tm_mon; int year_requested = tp->tm_year; + int isdst = tp->tm_isdst; - /* Ignore any tm_isdst request for timegm. */ - int isdst = local ? tp->tm_isdst : 0; - - /* 1 if the previous probe was DST. */ - int dst2 = 0; + /* True if the previous probe was DST. */ + bool dst2 = false; /* Ensure that mon is in range, and set year accordingly. */ int mon_remainder = mon % 12; @@ -443,13 +447,10 @@ __mktime_internal (struct tm *tp, bool local, mktime_offset_t *offset) Heuristic: probe the adjacent timestamps in both directions, looking for the desired isdst. If none is found within a - reasonable duration bound, assume a one-hour DST difference. + reasonable duration bound, ignore the disagreement. This should work for all real time zone histories in the tz database. */ - /* +1 if we wanted standard time but got DST, -1 if the reverse. */ - int dst_difference = (isdst == 0) - (tm.tm_isdst == 0); - /* Distance between probes when looking for a DST boundary. In tzdata2003a, the shortest period of DST is 601200 seconds (e.g., America/Recife starting 2000-10-08 01:00), and the @@ -459,21 +460,17 @@ __mktime_internal (struct tm *tp, bool local, mktime_offset_t *offset) periods when probing. */ int stride = 601200; - /* In TZDB 2021e, the longest period of DST (or of non-DST), in - which the DST (or adjacent DST) difference is not one hour, - is 457243209 seconds: e.g., America/Cambridge_Bay with leap - seconds, starting 1965-10-31 00:00 in a switch from - double-daylight time (-05) to standard time (-07), and - continuing to 1980-04-27 02:00 in a switch from standard time - (-07) to daylight time (-06). */ - int duration_max = 457243209; - - /* Search in both directions, so the maximum distance is half - the duration; add the stride to avoid off-by-1 problems. */ - int delta_bound = duration_max / 2 + stride; + /* Do not probe too far away from the requested time, + by striding until at least a year has passed, but then giving up. + This helps avoid unexpected results in (for example) Asia/Kolkata, + for which today's users expect to see no DST even though it + did observe DST long ago. */ + int year_seconds_bound = 366 * 24 * 60 * 60 + 1; + int delta_bound = year_seconds_bound + stride; int delta, direction; + /* Search in both directions, closest first. */ for (delta = stride; delta < delta_bound; delta += stride) for (direction = -1; direction <= 1; direction += 2) { @@ -503,13 +500,8 @@ __mktime_internal (struct tm *tp, bool local, mktime_offset_t *offset) } } - /* No unusual DST offset was found nearby. Assume one-hour DST. */ - t += 60 * 60 * dst_difference; - if (mktime_min <= t && t <= mktime_max && __tz_convert (t, local, &tm)) - goto offset_found; - - __set_errno (EOVERFLOW); - return -1; + /* No probe with the requested tm_isdst was found nearby. + Ignore the requested tm_isdst. */ } offset_found: @@ -548,17 +540,19 @@ __mktime_internal (struct tm *tp, bool local, mktime_offset_t *offset) __time64_t __mktime64 (struct tm *tp) { - /* POSIX.1 requires mktime to set external variables like 'tzname' - as though tzset had been called. */ - __tzset (); + __libc_lock_lock (__tzset_lock); + __tzset_unlocked (); # if defined _LIBC || NEED_MKTIME_WORKING static mktime_offset_t localtime_offset; - return __mktime_internal (tp, true, &localtime_offset); + __time64_t result = __mktime_internal (tp, true, &localtime_offset); # else # undef mktime - return mktime (tp); + __time64_t result = mktime (tp); # endif + + __libc_lock_unlock (__tzset_lock); + return result; } #endif /* _LIBC || NEED_MKTIME_WORKING || NEED_MKTIME_WINDOWS */ diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h deleted file mode 100644 index 49172ccc9dd..00000000000 --- a/lib/stdalign.in.h +++ /dev/null @@ -1,49 +0,0 @@ -/* A substitute for ISO C11 . - - Copyright 2011-2025 Free Software Foundation, Inc. - - This file is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 2.1 of the - License, or (at your option) any later version. - - This file is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see . */ - -/* Written by Paul Eggert and Bruno Haible. */ - -/* Define two obsolescent C11 macros, assuming alignas and alignof are - either keywords or alignasof-defined macros. */ - -#ifndef _@GUARD_PREFIX@_STDALIGN_H - -#if __GNUC__ >= 3 -@PRAGMA_SYSTEM_HEADER@ -#endif -@PRAGMA_COLUMNS@ - -/* We need to include the system's when it exists, because it might - define 'alignof' as a macro when it's not a keyword or compiler built-in. */ -#if @HAVE_STDALIGN_H@ -/* The include_next requires a split double-inclusion guard. */ -# @INCLUDE_NEXT@ @NEXT_STDALIGN_H@ -#endif - -#ifndef _@GUARD_PREFIX@_STDALIGN_H -#define _@GUARD_PREFIX@_STDALIGN_H - -#if (defined alignas \ - || (defined __STDC_VERSION__ && 202311 <= __STDC_VERSION__) \ - || (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) -# define __alignas_is_defined 1 -#endif - -#define __alignof_is_defined 1 - -#endif /* _@GUARD_PREFIX@_STDALIGN_H */ -#endif /* _@GUARD_PREFIX@_STDALIGN_H */ diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index f8e2a6ce344..bd82086ff37 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -62,8 +62,9 @@ /* NetBSD 5.0 mis-defines NULL. */ #include -/* MirBSD 10 defines WEXITSTATUS in , not in . */ -#if @GNULIB_SYSTEM_POSIX@ && !defined WEXITSTATUS +/* MirBSD 10 defines WEXITSTATUS in , not in . + glibc 2.40 defines WCOREDUMP in , not in . */ +#if @GNULIB_SYSTEM_POSIX@ && !(defined WEXITSTATUS && defined WCOREDUMP) # include #endif diff --git a/lib/string.in.h b/lib/string.in.h index 1bae32ad465..ce488299006 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -1077,6 +1077,22 @@ _GL_WARN_ON_USE (strtok_r, "strtok_r is unportable - " /* The following functions are not specified by POSIX. They are gnulib extensions. */ +#if @GNULIB_STR_STARTSWITH@ +/* Returns true if STRING starts with PREFIX. + Returns false otherwise. */ +_GL_EXTERN_C bool str_startswith (const char *string, const char *prefix) + _GL_ATTRIBUTE_PURE + _GL_ARG_NONNULL ((1, 2)); +#endif + +#if @GNULIB_STR_ENDSWITH@ +/* Returns true if STRING ends with SUFFIX. + Returns false otherwise. */ +_GL_EXTERN_C bool str_endswith (const char *string, const char *prefix) + _GL_ATTRIBUTE_PURE + _GL_ARG_NONNULL ((1, 2)); +#endif + #if @GNULIB_MBSLEN@ /* Return the number of multibyte characters in the character string STRING. This considers multibyte characters, unlike strlen, which counts bytes. */ @@ -1301,6 +1317,26 @@ _GL_EXTERN_C char * mbstok_r (char *restrict string, const char *delim, _GL_ARG_NONNULL ((2, 3)); #endif +#if @GNULIB_MBS_STARTSWITH@ +/* Returns true if STRING starts with PREFIX. + Returns false otherwise. */ +_GL_EXTERN_C bool mbs_startswith (const char *string, const char *prefix) + _GL_ATTRIBUTE_PURE + _GL_ARG_NONNULL ((1, 2)); +/* No extra code is needed for multibyte locales for this function. */ +# define mbs_startswith str_startswith +#endif + +#if @GNULIB_MBS_ENDSWITH@ +/* Returns true if STRING ends with SUFFIX. + Returns false otherwise. + Unlike str_endswith(), this function works correctly in multibyte locales. + */ +_GL_EXTERN_C bool mbs_endswith (const char *string, const char *suffix) + _GL_ATTRIBUTE_PURE + _GL_ARG_NONNULL ((1, 2)); +#endif + /* Map any int, typically from errno, into an error message. */ #if @GNULIB_STRERROR@ # if @REPLACE_STRERROR@ diff --git a/lib/sys_select.in.h b/lib/sys_select.in.h index fd3e28fd8e0..a06725020d2 100644 --- a/lib/sys_select.in.h +++ b/lib/sys_select.in.h @@ -165,12 +165,18 @@ #if @HAVE_WINSOCK2_H@ +/* Define type 'suseconds_t'. */ +# if !GNULIB_defined_suseconds_t +typedef int suseconds_t; +# define GNULIB_defined_suseconds_t 1 +# endif + # if !GNULIB_defined_rpl_fd_isset /* Re-define FD_ISSET to avoid a WSA call while we are not using network sockets. */ static int -rpl_fd_isset (SOCKET fd, fd_set * set) +rpl_fd_isset (SOCKET fd, const fd_set * set) { u_int i; if (set == NULL) diff --git a/lib/sys_types.in.h b/lib/sys_types.in.h index ed9e9506a10..acf9b2f7546 100644 --- a/lib/sys_types.in.h +++ b/lib/sys_types.in.h @@ -117,6 +117,22 @@ typedef unsigned long long int rpl_ino_t; # include #endif +/* Define blksize_t, required by POSIX:2024. */ +#if !@HAVE_BLKSIZE_T@ +# if !defined GNULIB_defined_blksize_t +typedef int blksize_t; +# define GNULIB_defined_blksize_t 1 +# endif +#endif + +/* Define blkcnt_t, required by POSIX:2024. */ +#if !@HAVE_BLKCNT_T@ +# if !defined GNULIB_defined_blkcnt_t +typedef long long blkcnt_t; +# define GNULIB_defined_blkcnt_t 1 +# endif +#endif + #endif /* _@GUARD_PREFIX@_SYS_TYPES_H */ #endif /* _@GUARD_PREFIX@_SYS_TYPES_H */ #endif /* __need_XXX */ diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 0048330e790..215377635f7 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1256,33 +1256,34 @@ Useful for example to unhide text in `outline-mode'.") (defun bookmark--jump-via (bookmark-name-or-record display-function) "Handle BOOKMARK-NAME-OR-RECORD, then call DISPLAY-FUNCTION. -DISPLAY-FUNCTION is called with the current buffer as argument. +DISPLAY-FUNCTION is called with the new buffer as argument. After calling DISPLAY-FUNCTION, set window point to the point specified by BOOKMARK-NAME-OR-RECORD, if necessary, run `bookmark-after-jump-hook', and then show any annotations for this bookmark." - (bookmark-handle-bookmark bookmark-name-or-record) - ;; Store `point' now, because `display-function' might change it. - (let ((point (point))) - (save-current-buffer - (funcall display-function (current-buffer))) - (let ((win (get-buffer-window (current-buffer) 0))) - (if win (set-window-point win point)))) - ;; FIXME: we used to only run bookmark-after-jump-hook in - ;; `bookmark-jump' itself, but in none of the other commands. - (when bookmark-fringe-mark - (let ((overlays (overlays-in (pos-bol) (1+ (pos-bol)))) - temp found) - (while (and (not found) (setq temp (pop overlays))) - (when (eq 'bookmark (overlay-get temp 'category)) - (setq found t))) - (unless found - (bookmark--set-fringe-mark)))) - (run-hooks 'bookmark-after-jump-hook) - (if bookmark-automatically-show-annotations + (let (buf point) + (save-window-excursion + (bookmark-handle-bookmark bookmark-name-or-record) + (setq buf (current-buffer) + point (point))) + (funcall display-function buf) + (when-let* ((win (get-buffer-window buf 0))) + (set-window-point win point)) + (when bookmark-fringe-mark + (let ((overlays (overlays-in (pos-bol) (1+ (pos-bol)))) + temp found) + (while (and (not found) (setq temp (pop overlays))) + (when (eq 'bookmark (overlay-get temp 'category)) + (setq found t))) + (unless found + (bookmark--set-fringe-mark)))) + ;; FIXME: we used to only run bookmark-after-jump-hook in + ;; `bookmark-jump' itself, but in none of the other commands. + (run-hooks 'bookmark-after-jump-hook) + (when bookmark-automatically-show-annotations ;; if there is an annotation for this bookmark, ;; show it in a buffer. - (bookmark-show-annotation bookmark-name-or-record))) + (bookmark-show-annotation bookmark-name-or-record)))) ;;;###autoload diff --git a/lisp/dired.el b/lisp/dired.el index bab5e833a76..2087a6f6f21 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2159,7 +2159,8 @@ ARG and NOCONFIRM, passed from `revert-buffer', are ignored." (if (dired-goto-subdir dir) (dired-hide-subdir 1)))) (unless modflag (restore-buffer-modified-p nil)) - (hack-dir-local-variables-non-file-buffer)) + (hack-dir-local-variables-non-file-buffer) + (dired--align-all-files)) ;; outside of the let scope ;;; Might as well not override the user if the user changed this. ;;; (setq buffer-read-only t) diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el index 25867a98a0e..3681df0b8f5 100644 --- a/lisp/dynamic-setting.el +++ b/lisp/dynamic-setting.el @@ -33,7 +33,7 @@ ;;; Customizable variables (declare-function font-get-system-font "xsettings.c" ()) -(declare-function reconsider-frame-font "frame.c" ()) +(declare-function reconsider-frame-fonts "frame.c" (frame)) (defvar font-use-system-font) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 01e7b35cc52..7559c58e77a 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -901,9 +901,13 @@ references may appear inside macro expansions, but not inside functions called from BODY." (declare (indent 1) (debug (symbolp body))) (if (cl--safe-expr-p `(progn ,@body)) `(progn ,@body) - `(cl--block-wrapper - (catch ',(intern (format "--cl-block-%s--" name)) - ,@body)))) + (let ((var (intern (format "--cl-block-%s--" name)))) + `(cl--block-wrapper + ;; Build a unique "tag" in the form of a fresh cons. + ;; We include `var' in the cons, just in case it help debugging. + (let ((,var (cons ',var nil))) + (catch ,var + ,@body)))))) ;;;###autoload (defmacro cl-return (&optional result) @@ -921,7 +925,7 @@ This is compatible with Common Lisp, but note that `defun' and `defmacro' do not create implicit blocks as they do in Common Lisp." (declare (indent 1) (debug (symbolp &optional form))) (let ((name2 (intern (format "--cl-block-%s--" name)))) - `(cl--block-throw ',name2 ,result))) + `(cl--block-throw ,name2 ,result))) ;;; The "cl-loop" macro. @@ -3672,20 +3676,24 @@ macro that returns its `&whole' argument." (defvar cl--active-block-names nil) -(cl-define-compiler-macro cl--block-wrapper (cl-form) - (let* ((cl-entry (cons (nth 1 (nth 1 cl-form)) nil)) - (cl--active-block-names (cons cl-entry cl--active-block-names)) - (cl-body (macroexpand-all ;Performs compiler-macro expansions. - (macroexp-progn (cddr cl-form)) - macroexpand-all-environment))) - ;; FIXME: To avoid re-applying macroexpand-all, we'd like to be able - ;; to indicate that this return value is already fully expanded. - (if (cdr cl-entry) - `(catch ,(nth 1 cl-form) ,@(macroexp-unprogn cl-body)) - cl-body))) +(cl-define-compiler-macro cl--block-wrapper (form) + (pcase form + (`(let ((,var . ,val)) (catch ,var . ,body)) + (let* ((cl-entry (cons var nil)) + (cl--active-block-names (cons cl-entry cl--active-block-names)) + (cl-body (macroexpand-all ;Performs compiler-macro expansions. + (macroexp-progn body) + macroexpand-all-environment))) + ;; FIXME: To avoid re-applying macroexpand-all, we'd like to be able + ;; to indicate that this return value is already fully expanded. + (if (cdr cl-entry) + `(let ((,var . ,val)) (catch ,var ,@(macroexp-unprogn cl-body))) + cl-body))) + ;; `form' was somehow mangled, god knows what happened, let's not touch it. + (_ form))) (cl-define-compiler-macro cl--block-throw (cl-tag cl-value) - (let ((cl-found (assq (nth 1 cl-tag) cl--active-block-names))) + (let ((cl-found (and (symbolp cl-tag) (assq cl-tag cl--active-block-names)))) (if cl-found (setcdr cl-found t))) `(throw ,cl-tag ,cl-value)) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 643b6aba2a6..c367d4a3624 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -152,7 +152,11 @@ Each regexp variable's value should actually be a format string to be used to substitute the desired symbol name into the regexp. Instead of regexp variable, types can be mapped to functions as well, in which case the function is called with one argument (the object -we're looking for) and it should search for it.") +we're looking for) and it should search for it. + +Symbols can have their own version of this alist on +the property `find-function-type-alist'. +See the function `find-function-update-type-alist'.") (put 'find-function-regexp-alist 'risky-local-variable t) (define-obsolete-variable-alias 'find-function-source-path @@ -402,9 +406,9 @@ or just (BUFFER . nil) if the definition can't be found in the file. If TYPE is nil, look for a function definition, otherwise, TYPE specifies the kind of definition. -If SYMBOL has a property `definition-type', -the property value is used instead of TYPE. -TYPE is interpreted via `find-function-regexp-alist'. +TYPE is looked up in SYMBOL's property `find-function-type-alist' +(which can be maintained with `find-function-update-type-alist') +or the variable `find-function-regexp-alist'. The search is done in the source for library LIBRARY." (if (null library) @@ -413,8 +417,6 @@ The search is done in the source for library LIBRARY." ;; that defines something else. (while (and (symbolp symbol) (get symbol 'definition-name)) (setq symbol (get symbol 'definition-name))) - (setq type (or (get symbol 'definition-type) - type)) (if (string-match "\\`src/\\(.*\\.\\(c\\|m\\)\\)\\'" library) (find-function-C-source symbol (match-string 1 library) type) (when (string-match "\\.el\\(c\\)\\'" library) @@ -424,7 +426,10 @@ The search is done in the source for library LIBRARY." (when (string-match "\\.emacs\\(.el\\)\\'" library) (setq library (substring library 0 (match-beginning 1)))) (let* ((filename (find-library-name library)) - (regexp-symbol (cdr (assq type find-function-regexp-alist)))) + (regexp-symbol + (or (and (symbolp symbol) + (alist-get type (get symbol 'find-function-type-alist))) + (alist-get type find-function-regexp-alist)))) (with-current-buffer (find-file-noselect filename) (let ((regexp (if (functionp regexp-symbol) regexp-symbol (format (symbol-value regexp-symbol) @@ -466,6 +471,13 @@ The search is done in the source for library LIBRARY." (find-function--search-by-expanding-macros (current-buffer) symbol type)))))))))) +;;;###autoload +(defun find-function-update-type-alist (symbol type variable) + "Update SYMBOL property `find-function-type-alist' with (TYPE . VARIABLE). +Property `find-function-type-alist' is a symbol-specific version +of variable `find-function-regexp-alist' and has the same format." + (setf (alist-get type (get symbol 'find-function-type-alist)) variable)) + (defun find-function--try-macroexpand (form) "Try to macroexpand FORM in full or partially. This is a best-effort operation in which if macroexpansion fails, diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index a0c8e4d607f..8fbe35220f1 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1,4 +1,4 @@ -;;; rx.el --- S-exp notation for regexps --*- lexical-binding: t -*- +;;; rx.el --- S-exp notation for regexps -*- lexical-binding: t -*- ;; Copyright (C) 2001-2025 Free Software Foundation, Inc. diff --git a/lisp/files.el b/lisp/files.el index e9f69fcd33c..09bc3ea429f 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4490,15 +4490,15 @@ It is dangerous if either of these conditions are met: (substitute-command-keys instead) (format-message "use `%s' instead" instead))))))) -(defvar hack-local-variables--inhibit nil - "List of file/dir local variables to ignore.") +(defvar hack-local-variables--inhibit-eval nil + "List of `eval' forms to ignore in file/dir local variables.") (defun hack-one-local-variable (var val) "Set local variable VAR with value VAL. If VAR is `mode', call `VAL-mode' as a function unless it's already the major mode." (pcase var - ((guard (memq var hack-local-variables--inhibit)) nil) + ((and 'eval (guard (member val hack-local-variables--inhibit-eval))) nil) ('mode (let ((mode (intern (concat (downcase (symbol-name val)) "-mode")))) @@ -4506,8 +4506,8 @@ already the major mode." ('eval (pcase val (`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook))) - (let ((hack-local-variables--inhibit ;; FIXME: Should be buffer-local! - (cons 'eval hack-local-variables--inhibit))) + (let ((hack-local-variables--inhibit-eval ;; FIXME: Should be buffer-local! + (cons val hack-local-variables--inhibit-eval))) (save-excursion (eval val t)))) (_ (hack-one-local-variable--obsolete var) diff --git a/lisp/leim/quail/iroquoian.el b/lisp/leim/quail/iroquoian.el index 63c24cf4590..6671a1d20f1 100644 --- a/lisp/leim/quail/iroquoian.el +++ b/lisp/leim/quail/iroquoian.el @@ -27,8 +27,8 @@ ;; Input methods are implemented for all Five Nations Iroquois ;; languages: -;; - Mohawk (Kanien’kéha / Onkwehonwehnéha) -;; - Oneida (Onʌyote’a·ká· / Ukwehuwehnéha) +;; - Mohawk (Kanien’kéha / Kanyen’kéha / Onkwehonwehnéha) +;; - Oneida (Onʌyote’a·ká· / Onyota’a:ká: / Ukwehuwehnéha) ;; - Onondaga (Onųdaʔgegáʔ) ;; - Cayuga (Gayogo̱ho:nǫhnéha:ˀ) ;; - Seneca (Onödowá’ga:’) @@ -123,7 +123,7 @@ Entries are as with rules in `quail-define-rules'.") (quail-define-package "mohawk-postfix" "Mohawk" "MOH<" t - "Mohawk (Kanien’kéha) input method with postfix modifiers + "Mohawk (Kanien’kéha/Kanyen’kéha) input method with postfix modifiers Stress diacritics: @@ -216,8 +216,8 @@ Entries are as with rules in `quail-define-rules'.") Entries are as with rules in `quail-define-rules'.") (defconst iroquoian-oneida-consonant-alist - '((";;" ?\N{MODIFIER LETTER GLOTTAL STOP}) - (";'" ?\N{RIGHT SINGLE QUOTATION MARK})) + '((";;" ?\N{RIGHT SINGLE QUOTATION MARK}) + (";'" ?\N{MODIFIER LETTER GLOTTAL STOP})) "Alist of rules for consonant letters in Oneida input methods. Entries are as with rules in `quail-define-rules'.") @@ -229,7 +229,7 @@ Entries are as with rules in `quail-define-rules'.") (quail-define-package "oneida-postfix" "Oneida" "ONE<" t - "Oneida (Onʌyote’a·ká·) input method with postfix modifiers + "Oneida (Onʌyote’a·ká·/Onyota’a:ká:) input method with postfix modifiers Modifiers: @@ -258,8 +258,8 @@ Consonants: | Key | Translation | Description | |-----+-------------+--------------------------| -| ;; | ˀ | Glottal stop | -| ;\\=' | \\=’ | Glottal stop (alternate) | +| ;; | \\=’ | Glottal stop | +| ;\\=' | ˀ | Glottal stop (alternate) | h, k, l, n, s, t, w, and y are bound to a single key. @@ -393,9 +393,11 @@ Entries are as with rules in `quail-define-rules'.") Entries are as with rules in `quail-define-rules'.") (defconst iroquoian-onondaga-nasal-alist - '(("n-" ?ñ) + '(("n~" ?ñ) + ("n-" ["ñ"]) ("n--" ["n-"]) - ("N-" ?Ñ) + ("N~" ?Ñ) + ("N-" ["Ñ"]) ("N--" ["N-"])) "Alist of rules for nasal modifier letters in Onondaga input methods. Entries are as with rules in `quail-define-rules'.") @@ -433,10 +435,14 @@ Vowels: |-----------------------------------------------------------| | Onondaga Nation, New York orthography | |-----------------------------------------------------------| -| en- | eñ | Mid front nasal vowel | -| EN- | EÑ | Mid front nasal vowel (capital) | -| on- | oñ | Back high nasal vowel | -| ON- | OÑ | Back high nasal vowel (capital) | +| en~ | eñ | Mid front nasal vowel | +| en- | eñ | (same as above) | +| EN~ | EÑ | Mid front nasal vowel (capital) | +| EN- | EÑ | (same as above) | +| on~ | oñ | Back high nasal vowel | +| on- | oñ | (same as above) | +| ON~ | OÑ | Back high nasal vowel (capital) | +| ON- | OÑ | (same as above) | | a\" | ä | Low front rounded vowel | | A\" | Ä | Low front rounded vowel (capital) | |-----------------------------------------------------------| @@ -895,8 +901,8 @@ Entries are as with rules in `quail-define-rules'.") This input method can be used to enter the following languages: -- Mohawk (Kanien’kéha / Onkwehonwehnéha) -- Oneida (Onʌyote’a·ká· / Ukwehuwehnéha) +- Mohawk (Kanien’kéha / Kanyen’kéha / Onkwehonwehnéha) +- Oneida (Onʌyote’a·ká· / Onyota’a:ká: / Ukwehuwehnéha) - Cayuga (Gayogo̱ho:nǫhnéha:ˀ) - Onondaga (Onųdaʔgegáʔ) - Seneca (Onödowá’ga:’) @@ -942,10 +948,14 @@ Vowels: | -------------------------------------------------------------------- | | (Onondaga Nation, New York) | | -------------------------------------------------------------------- | -| en- | eñ | Mid front nasal vowel | -| EN- | EÑ | Mid front nasal vowel (capital) | -| on- | oñ | Back high nasal vowel | -| ON- | OÑ | Back high nasal vowel (capital) | +| en~ | eñ | Mid front nasal vowel | +| en- | eñ | (same as above) | +| EN~ | EÑ | Mid front nasal vowel (capital) | +| EN- | EÑ | (same as above) | +| on~ | oñ | Back high nasal vowel | +| on- | oñ | (same as above) | +| ON~ | OÑ | Back high nasal vowel (capital) | +| ON- | OÑ | (same as above) | | a\" | ä | Low front rounded vowel | | A\" | Ä | Low front rounded vowel (capital) | | -------------------------------------------------------------------- | @@ -991,8 +1001,8 @@ Consonants: |----------------------------------------------------------------------| | Oneida | | -------------------------------------------------------------------- | -| ;\\=' | ˀ | Glottal stop | -| ;; | \\=’ | Glottal stop (alternate) | +| ;; | \\=’ | Glottal stop | +| ;\\=' | ˀ | Glottal stop (alternate) | | Single-key consonants: h k l n s t w y | |----------------------------------------------------------------------| | Onondaga | diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 0c23ebc19cd..7c7303d073d 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -2237,8 +2237,16 @@ Differences in #targets are ignored." (kill-new (plist-get eww-data :url))) (defun eww-download () - "Download URL to `eww-download-directory'. -Use link at point if there is one, else the current page's URL." + "Download a Web page to `eww-download-directory'. +Use link at point if there is one, else the current page's URL. +This command downloads the page to the download directory, under +a file name generated from the last portion of the page's URL, +after the last slash. (If URL ends in a slash, the page will be +saved under the name \"!\".) +If there's already a file by that name in the download directory, +this command will modify the name to make it unique. +The command shows in the echo-area the actual file name where the +page was saved." (interactive nil eww-mode) (let ((dir (if (stringp eww-download-directory) eww-download-directory diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index e8ca7574d34..6ca491f9f26 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -151,7 +151,7 @@ If WARN-UNENCRYPTED, query the user if the connection is unencrypted." ;; Deprecated by NIST from 2016/2023 (see also CVE-2016-2183). (3des-cipher medium) ;; Towards TLS 1.3 - (dhe-kx high) + (dhe-kx medium) (rsa-kx high) (cbc-cipher high)) "Alist of TLS connection checks to perform. @@ -400,13 +400,17 @@ Diffie-Hellman Fails in Practice\", `https://weakdh.org/' (defun nsm-protocol-check--dhe-kx (_host _port status &optional _settings) "Check for existence of DH key exchange based on integer factorization. -In the years since the discovery of Logjam, it was discovered -that there were rampant use of small subgroup prime or composite -number for DHE by many servers, and thus allowed themselves to be -vulnerable to backdoors[1]. Given the difficulty in validating -Diffie-Hellman parameters, major browser vendors had started to -remove DHE since 2016[2]. Emacs stops short of banning DHE and -terminating connection, but prompts the user instead. +In the years since the discovery of Logjam, it was discovered that there +were rampant use of small subgroup prime or composite number for DHE by +many servers, and thus allowed themselves to be vulnerable to +backdoors[1]. Given the difficulty in validating Diffie-Hellman +parameters, major browser vendors had started to remove DHE since +2016[2]. In 2020, the so-called Racoon Attack was discovered, a +server-side vulnerability that exploits a side-channel to get the shared +secret key[3]. + +Emacs stops short of banning DHE and terminating the connection, but +prompts the user instead. References: @@ -414,7 +418,11 @@ References: Diffie-Hellman Backdoors in TLS.\", `https://eprint.iacr.org/2016/999.pdf' [2]: Chrome Platform Status (2017). \"Remove DHE-based ciphers\", -`https://www.chromestatus.com/feature/5128908798164992'" +`https://www.chromestatus.com/feature/5128908798164992' +[3]: Merget, Brinkmann, Aviram, Somorovsky, Mittmann, and +Schwenk (2020). \"Raccoon Attack: Finding and Exploiting +Most-Significant-Bit-Oracles in TLS-DH(E)\" +`https://raccoon-attack.com/RacoonAttack.pdf'" (let ((kx (plist-get status :key-exchange))) (when (string-match "^\\bDHE\\b" kx) (format-message @@ -692,9 +700,10 @@ Security (DTLS)\", `https://tools.ietf.org/html/rfc7525'" (defun nsm-protocol-check--version (_host _port status &optional _settings) "Check for SSL/TLS protocol version. -This function guards against the usage of SSL3.0, which has been -deprecated by RFC7568[1], and TLS 1.0, which has been deprecated -by PCI DSS[2]. +This function guards against the usage of SSL3.0, TLS 1.0, and TLS 1.1. +- SSL 3.0 has been deprecated by RFC7568[1]. +- TLS 1.0 has been deprecated by PCI DSS[2], and later by RFC8996[3]. +- TLS 1.1 has been deprecated by RFC8996[3]. References: @@ -702,12 +711,15 @@ References: Sockets Layer Version 3.0\", `https://tools.ietf.org/html/rfc7568' [2]: PCI Security Standards Council (2016). \"Migrating from SSL and Early TLS\" -`https://www.pcisecuritystandards.org/documents/Migrating-from-SSL-Early-TLS-Info-Supp-v1_1.pdf'" +`https://docs-prv.pcisecuritystandards.org/Guidance%20Document/SSL%20TLS/Migrating_from_SSL_and_Early_TLS_-v12.pdf' +[3]: Moriarty, Farrell (2021). \"Deprecating TLS 1.0 and TLS 1.1\" +`https://tools.ietf.org/html/rfc7568' +" (let ((protocol (plist-get status :protocol))) (and protocol (or (string-match "SSL" protocol) (and (string-match "TLS1.\\([0-9]+\\)" protocol) - (< (string-to-number (match-string 1 protocol)) 1))) + (< (string-to-number (match-string 1 protocol)) 2))) (format-message "%s protocol is deprecated by standard bodies" protocol)))) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 95fff9db0b4..d432deee5d1 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -554,7 +554,7 @@ PROPERTIES is a list of file properties (strings)." (lambda (key) (and (tramp-file-name-p key) (null (tramp-file-name-localname key)) - (tramp-connection-property-p key " process-buffer") + (tramp-connection-property-p key " connected") key)) (hash-table-keys tramp-cache-data)))) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index a469df1b872..71829e81093 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -173,7 +173,7 @@ interactively, a Tramp connection has to be selected." (get-buffer (tramp-debug-buffer-name vec))) (unless keep-debug (get-buffer (tramp-trace-buffer-name vec))) - (tramp-get-connection-property vec " process-buffer"))) + (tramp-get-connection-property vec " connected"))) (when (bufferp buf) (kill-buffer buf))) ;; Flush file cache. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1241d321b9b..d87cecb9ec6 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2002,10 +2002,11 @@ Unless DONT-CREATE, the buffer is created when it doesn't exist yet." (or (get-buffer (tramp-buffer-name vec)) (unless dont-create (with-current-buffer (get-buffer-create (tramp-buffer-name vec)) - ;; We use the existence of connection property " process-buffer" - ;; as indication, whether a connection is active. + ;; We use the existence of connection property " connected" + ;; as indication, whether a connection is active. It keeps + ;; the connection buffer, for cleanup. (tramp-set-connection-property - vec " process-buffer" + vec " connected" (tramp-get-connection-property vec " process-buffer")) (setq buffer-undo-list t default-directory diff --git a/lisp/pcmpl-git.el b/lisp/pcmpl-git.el index f57c2d5470a..f23002df28b 100644 --- a/lisp/pcmpl-git.el +++ b/lisp/pcmpl-git.el @@ -82,8 +82,18 @@ Files listed by `git ls-files ARGS' satisfy the predicate." (pcomplete-from-help `(,vc-git-program "help" ,subcmd) :argument "-+\\(?:\\[no-\\]\\)?[a-z-]+=?")))) + ;; Complete modified tracked files and untracked files and + ;; ignored files if -f or --force is specified. + ("add" + (pcomplete-here + (pcomplete-entries + nil + (let ((flags (list "-o" "-m"))) + (unless (or (member "-f" pcomplete-args) (member "--force" pcomplete-args)) + (push "--exclude-standard" flags)) + (apply #'pcmpl-git--tracked-file-predicate flags))))) ;; Complete modified tracked files - ((or "add" "commit" "restore") + ((or "commit" "restore") (pcomplete-here (pcomplete-entries nil (pcmpl-git--tracked-file-predicate "-m")))) diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el index a2334505db9..2d1c645f42c 100644 --- a/lisp/progmodes/asm-mode.el +++ b/lisp/progmodes/asm-mode.el @@ -40,10 +40,7 @@ ;; ;; Code is indented to the first tab stop level. -;; This mode runs two hooks: -;; 1) `asm-mode-set-comment-hook' before the part of the initialization -;; depending on `asm-comment-char', and -;; 2) `asm-mode-hook' at the end of initialization. +;; This mode runs the hook `asm-mode-hook' at the end of initialization. ;;; Code: @@ -105,6 +102,8 @@ cpp-font-lock-keywords) "Additional expressions to highlight in Assembler mode.") +(make-obsolete-variable 'asm-mode-set-comment-hook 'asm-mode-hook "31.0") + ;;;###autoload (define-derived-mode asm-mode prog-mode "Assembler" "Major mode for editing typical assembler code. @@ -117,9 +116,7 @@ Features a private abbrev table and the following bindings: The character used for making comments is set by the variable `asm-comment-char' (which defaults to `?\\;'). - -Alternatively, you may set this variable in `asm-mode-set-comment-hook', -which is called near the beginning of mode initialization. +Alternatively, you may set this variable in `asm-mode-hook'. Turning on Asm mode runs the hook `asm-mode-hook' at the end of initialization. @@ -127,15 +124,18 @@ Special commands: \\{asm-mode-map}" :after-hook (progn - (run-hooks 'asm-mode-set-comment-hook) ;; Make our own local child of `asm-mode-map' ;; so we can define our own comment character. - (use-local-map (make-composed-keymap nil asm-mode-map)) - (local-set-key (vector asm-comment-char) #'asm-comment) + ;; FIXME: Use `post-self-insert-hook' instead and make it conditional + ;; on some "electricity" config var. + (unless (lookup-key asm-mode-map (vector asm-comment-char)) + (use-local-map (make-composed-keymap nil asm-mode-map)) + (local-set-key (vector asm-comment-char) #'asm-comment)) (set-syntax-table (make-syntax-table asm-mode-syntax-table)) (modify-syntax-entry asm-comment-char "< b") - (setq-local comment-start (string asm-comment-char))) + (unless (local-variable-p 'comment-start) + (setq-local comment-start (string asm-comment-char)))) (setq local-abbrev-table asm-mode-abbrev-table) (setq-local font-lock-defaults '(asm-font-lock-keywords)) @@ -143,6 +143,8 @@ Special commands: ;; Stay closer to the old TAB behavior (was tab-to-tab-stop). (setq-local tab-always-indent nil) + (run-hooks 'asm-mode-set-comment-hook) + (setq-local comment-add 1) (setq-local comment-start-skip "\\(?:\\s<+\\|/[/*]+\\)[ \t]*") (setq-local comment-end-skip "[ \t]*\\(\\s>\\|\\*+/\\)") diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 213c748ad2d..c5bf135e286 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -706,22 +706,16 @@ MODE is either `c' or `cpp'." (rx (| "/**" "/*!" "//!" "///")) "A regexp that matches all doxygen comment styles.") -(defun c-ts-mode--test-virtual-named-p () - "Return t if the virtual keyword is a namded node, nil otherwise." - (ignore-errors - (progn (treesit-query-compile 'cpp "(virtual)" t) t))) - (defun c-ts-mode--font-lock-settings (mode) "Tree-sitter font-lock settings. MODE is either `c' or `cpp'." (treesit-font-lock-rules - :language mode + :default-language mode :feature 'comment `(((comment) @font-lock-doc-face (:match ,(rx bos "/**") @font-lock-doc-face)) (comment) @font-lock-comment-face) - :language mode :feature 'preprocessor `((preproc_directive) @font-lock-preprocessor-face @@ -744,45 +738,37 @@ MODE is either `c' or `cpp'." ")" @font-lock-preprocessor-face) [,@c-ts-mode--preproc-keywords] @font-lock-preprocessor-face) - :language mode :feature 'constant `((true) @font-lock-constant-face (false) @font-lock-constant-face (null) @font-lock-constant-face) - :language mode :feature 'keyword `([,@(c-ts-mode--keywords mode)] @font-lock-keyword-face ,@(when (eq mode 'cpp) '((auto) @font-lock-keyword-face (this) @font-lock-keyword-face)) - ,@(when (and (eq mode 'cpp) - (c-ts-mode--test-virtual-named-p)) - '((virtual) @font-lock-keyword-face)) - ,@(when (and (eq mode 'cpp) - (not (c-ts-mode--test-virtual-named-p))) - '("virtual" @font-lock-keyword-face))) + ,@(when (eq mode 'cpp) + (treesit-query-first-valid 'cpp + '((virtual) @font-lock-keyword-face) + '("virtual" @font-lock-keyword-face)))) - :language mode :feature 'operator `([,@c-ts-mode--operators ,@(when (eq mode 'cpp) c-ts-mode--c++-operators)] @font-lock-operator-face "!" @font-lock-negation-char-face) - :language mode :feature 'string `((string_literal) @font-lock-string-face (system_lib_string) @font-lock-string-face ,@(when (eq mode 'cpp) '((raw_string_literal) @font-lock-string-face))) - :language mode :feature 'literal `((number_literal) @font-lock-number-face (char_literal) @font-lock-constant-face) - :language mode :feature 'type `((primitive_type) @font-lock-type-face (type_identifier) @font-lock-type-face @@ -798,7 +784,6 @@ MODE is either `c' or `cpp'." (namespace_identifier) @font-lock-constant-face)) [,@c-ts-mode--type-keywords] @font-lock-type-face) - :language mode :feature 'definition ;; Highlights identifiers in declarations. `(,@(when (eq mode 'cpp) @@ -825,7 +810,6 @@ MODE is either `c' or `cpp'." (enumerator name: (identifier) @font-lock-property-name-face)) - :language mode :feature 'assignment ;; TODO: Recursively highlight identifiers in parenthesized ;; expressions, see `c-ts-mode--fontify-declarator' for @@ -842,44 +826,35 @@ MODE is either `c' or `cpp'." (identifier) @font-lock-variable-name-face)) (init_declarator declarator: (_) @c-ts-mode--fontify-declarator)) - :language mode :feature 'function '((call_expression function: [(identifier) @font-lock-function-call-face (field_expression field: (field_identifier) @font-lock-function-call-face)])) - :language mode :feature 'variable '((identifier) @c-ts-mode--fontify-variable) - :language mode :feature 'label '((labeled_statement label: (statement_identifier) @font-lock-constant-face)) - :language mode :feature 'error '((ERROR) @c-ts-mode--fontify-error) :feature 'escape-sequence - :language mode :override t '((escape_sequence) @font-lock-escape-face) - :language mode :feature 'property '((field_identifier) @font-lock-property-use-face) - :language mode :feature 'bracket '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) - :language mode :feature 'delimiter '((["," ":" ";"]) @font-lock-delimiter-face) - :language mode :feature 'emacs-devel :override t `(((call_expression diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 989f3310635..e1ec4880058 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1375,13 +1375,14 @@ prototypes from signatures.") (optional (sequence (0+ (sequence ,cperl--ws*-rx - ,cperl--basic-scalar-rx + (or ,cperl--basic-scalar-rx "$") ,cperl--ws*-rx ",")) ,cperl--ws*-rx (or ,cperl--basic-scalar-rx ,cperl--basic-array-rx - ,cperl--basic-hash-rx))) + ,cperl--basic-hash-rx + "$" "%" "@"))) (optional (sequence ,cperl--ws*-rx) "," ) ,cperl--ws*-rx ")") @@ -4416,8 +4417,8 @@ recursive calls in starting lines of here-documents." (opt (group (eval cperl--normal-identifier-rx))) ; #13 (eval cperl--ws*-rx) (group (or (group (eval cperl--prototype-rx)) ; #14,#15 - ;; (group (eval cperl--signature-rx)) ; #16 - (group unmatchable) ; #16 + (group (eval cperl--signature-rx)) ; #16 + ;; (group unmatchable) ; #16 (group (or anything buffer-end)))))) ; #17 "\\|" ;; -------- weird variables, capture group 18 @@ -5312,7 +5313,7 @@ recursive calls in starting lines of here-documents." ;; match-string 13: Name of the subroutine (optional) ;; match-string 14: Indicator for proto/attr/signature ;; match-string 15: Prototype - ;; match-string 16: unused + ;; match-string 16: Subroutine signature ;; match-string 17: Distinguish declaration/definition (setq b1 (match-beginning 13) e1 (match-end 13)) (if (memq (char-after (1- b)) @@ -5328,9 +5329,18 @@ recursive calls in starting lines of here-documents." (forward-comment (buffer-size)) (cperl-find-sub-attrs st-l b1 e1 b)) ;; treat attributes without prototype and incomplete stuff - (goto-char (match-beginning 17)) - (cperl-find-sub-attrs st-l b1 e1 b)))) - ;; 1+6+2+1+1+6+1=18 extra () before this: + (if (match-beginning 16) ; a complete subroutine signature + ;; A signature ending in "$)" must not be + ;; mistaken as the punctuation variable $) which + ;; messes up balance of parens (Bug#74245). + (progn + (when (= (char-after (- (match-end 16) 2)) ?$) + (put-text-property (- (match-end 16) 2) (1- (match-end 16)) + 'syntax-table cperl-st-punct)) + (goto-char (match-end 16))) + (goto-char (match-beginning 17)) + (cperl-find-sub-attrs st-l b1 e1 b))))) + ;; 1+6+2+1+1+6+1=18 extra () before this: ;; "\\(\\= 201703L \ - : __STDC_VERSION__ >= 202000L && __clang_major__ >= 16) \ + : __STDC_VERSION__ >= 202000L && __clang_major__ >= 16 \ + && !defined __sun) \ : (defined __GNUC__ \ ? (defined __cplusplus \ ? __cplusplus >= 201103L && __GNUG__ >= 6 \ - : __STDC_VERSION__ >= 202000L && __GNUC__ >= 13) \ + : __STDC_VERSION__ >= 202000L && __GNUC__ >= 13 \ + && !defined __sun) \ : defined HAVE_C_STATIC_ASSERT)) \ && !defined assert \ && (!defined __cplusplus \ diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 771181cb1bf..980baf83998 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -388,6 +388,7 @@ AC_DEFUN([gl_INIT], gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_UNISTD_H_GETOPT], [1]) ]) gl_UNISTD_MODULE_INDICATOR([getopt-posix]) + gl_MUSL_LIBC AC_REQUIRE([AC_CANONICAL_HOST]) gl_FUNC_GETRANDOM gl_CONDITIONAL([GL_COND_OBJ_GETRANDOM], @@ -423,6 +424,11 @@ AC_DEFUN([gl_INIT], ]) gl_SYS_STAT_MODULE_INDICATOR([lstat]) gl_MODULE_INDICATOR([lstat]) + gl_FUNC_MALLOC_GNU + if test $REPLACE_MALLOC_FOR_MALLOC_GNU = 1; then + AC_LIBOBJ([malloc]) + fi + gl_STDLIB_MODULE_INDICATOR([malloc-gnu]) AC_REQUIRE([gl_FUNC_MALLOC_POSIX]) if test $REPLACE_MALLOC_FOR_MALLOC_POSIX = 1; then AC_LIBOBJ([malloc]) @@ -501,6 +507,11 @@ AC_DEFUN([gl_INIT], gl_CONDITIONAL([GL_COND_OBJ_READLINKAT], [test $HAVE_READLINKAT = 0 || test $REPLACE_READLINKAT = 1]) gl_UNISTD_MODULE_INDICATOR([readlinkat]) + gl_FUNC_REALLOC_POSIX + gl_FUNC_REALLOC_0_NONNULL + gl_CONDITIONAL([GL_COND_OBJ_REALLOC_POSIX], + [test $REPLACE_REALLOC_FOR_REALLOC_POSIX != 0]) + gl_STDLIB_MODULE_INDICATOR([realloc-posix]) gl_REGEX gl_CONDITIONAL([GL_COND_OBJ_REGEX], [test $ac_use_included_regex = yes]) AM_COND_IF([GL_COND_OBJ_REGEX], [ @@ -683,12 +694,10 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_8444034ea779b88768865bb60b4fb8c9=false gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false gl_gnulib_enabled_lchmod=false - gl_gnulib_enabled_e80bf6f757095d2e5fc94dafb8f8fc8b=false gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31=false gl_gnulib_enabled_open=false gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7=false gl_gnulib_enabled_rawmemchr=false - gl_gnulib_enabled_61bcaca76b3e6f9ae55d57a1c3193bc4=false gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false gl_gnulib_enabled_strtoll=false gl_gnulib_enabled_utimens=false @@ -810,7 +819,6 @@ AC_DEFUN([gl_INIT], if $gl_gnulib_enabled_8444034ea779b88768865bb60b4fb8c9; then :; else AC_PROG_MKDIR_P gl_gnulib_enabled_8444034ea779b88768865bb60b4fb8c9=true - func_gl_gnulib_m4code_61bcaca76b3e6f9ae55d57a1c3193bc4 fi } func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1 () @@ -826,9 +834,6 @@ AC_DEFUN([gl_INIT], if test $HAVE_GROUP_MEMBER = 0; then func_gl_gnulib_m4code_getgroups fi - if test $HAVE_GROUP_MEMBER = 0; then - func_gl_gnulib_m4code_e80bf6f757095d2e5fc94dafb8f8fc8b - fi fi } func_gl_gnulib_m4code_lchmod () @@ -843,17 +848,6 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_lchmod=true fi } - func_gl_gnulib_m4code_e80bf6f757095d2e5fc94dafb8f8fc8b () - { - if $gl_gnulib_enabled_e80bf6f757095d2e5fc94dafb8f8fc8b; then :; else - gl_FUNC_MALLOC_GNU - if test $REPLACE_MALLOC_FOR_MALLOC_GNU = 1; then - AC_LIBOBJ([malloc]) - fi - gl_STDLIB_MODULE_INDICATOR([malloc-gnu]) - gl_gnulib_enabled_e80bf6f757095d2e5fc94dafb8f8fc8b=true - fi - } func_gl_gnulib_m4code_5264294aa0a5557541b53c8c741f7f31 () { if $gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31; then :; else @@ -898,17 +892,6 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_rawmemchr=true fi } - func_gl_gnulib_m4code_61bcaca76b3e6f9ae55d57a1c3193bc4 () - { - if $gl_gnulib_enabled_61bcaca76b3e6f9ae55d57a1c3193bc4; then :; else - gl_FUNC_REALLOC_POSIX - gl_FUNC_REALLOC_0_NONNULL - gl_CONDITIONAL([GL_COND_OBJ_REALLOC_POSIX], - [test $REPLACE_REALLOC_FOR_REALLOC_POSIX != 0]) - gl_STDLIB_MODULE_INDICATOR([realloc-posix]) - gl_gnulib_enabled_61bcaca76b3e6f9ae55d57a1c3193bc4=true - fi - } func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c () { if $gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c; then :; else @@ -1010,9 +993,6 @@ AC_DEFUN([gl_INIT], if test $ac_use_included_regex = yes; then func_gl_gnulib_m4code_fd38c7e463b54744b77b98aeafb4fa7c fi - if test $ac_use_included_regex = yes; then - func_gl_gnulib_m4code_e80bf6f757095d2e5fc94dafb8f8fc8b - fi if test $ac_use_included_regex = yes; then func_gl_gnulib_m4code_verify fi @@ -1046,12 +1026,10 @@ AC_DEFUN([gl_INIT], AM_CONDITIONAL([gl_GNULIB_ENABLED_8444034ea779b88768865bb60b4fb8c9], [$gl_gnulib_enabled_8444034ea779b88768865bb60b4fb8c9]) AM_CONDITIONAL([gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1], [$gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1]) AM_CONDITIONAL([gl_GNULIB_ENABLED_lchmod], [$gl_gnulib_enabled_lchmod]) - AM_CONDITIONAL([gl_GNULIB_ENABLED_e80bf6f757095d2e5fc94dafb8f8fc8b], [$gl_gnulib_enabled_e80bf6f757095d2e5fc94dafb8f8fc8b]) AM_CONDITIONAL([gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31], [$gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31]) AM_CONDITIONAL([gl_GNULIB_ENABLED_open], [$gl_gnulib_enabled_open]) AM_CONDITIONAL([gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7], [$gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7]) AM_CONDITIONAL([gl_GNULIB_ENABLED_rawmemchr], [$gl_gnulib_enabled_rawmemchr]) - AM_CONDITIONAL([gl_GNULIB_ENABLED_61bcaca76b3e6f9ae55d57a1c3193bc4], [$gl_gnulib_enabled_61bcaca76b3e6f9ae55d57a1c3193bc4]) AM_CONDITIONAL([gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c], [$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c]) AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll]) AM_CONDITIONAL([gl_GNULIB_ENABLED_utimens], [$gl_gnulib_enabled_utimens]) diff --git a/m4/stdalign.m4 b/m4/stdalign.m4 index bb2d1555373..885feafdd8b 100644 --- a/m4/stdalign.m4 +++ b/m4/stdalign.m4 @@ -1,5 +1,5 @@ # stdalign.m4 -# serial 1 +# serial 3 dnl Copyright 2011-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -104,11 +104,13 @@ AC_DEFUN([gl_ALIGNASOF], /* GCC releases before GCC 4.9 had a bug in _Alignof. See GCC bug 52023 . - clang versions < 8.0.0 have the same bug. */ + clang versions < 8.0.0 have the same bug. + IBM XL C V16.1.0 cc (non-clang) has the same bug. */ # if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \ || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9) \ && !defined __clang__) \ - || (defined __clang__ && __clang_major__ < 8)) + || (defined __clang__ && __clang_major__ < 8) \ + || defined __xlC__) # undef/**/_Alignof # ifdef __cplusplus # if (201103 <= __cplusplus || defined _MSC_VER) @@ -179,7 +181,8 @@ AC_DEFUN([gl_ALIGNASOF], # if ((defined _Alignas \ && !(defined __cplusplus \ && (201103 <= __cplusplus || defined _MSC_VER))) \ - || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__)) + || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__ \ + && !defined __xlC__)) # define alignas _Alignas # endif # endif diff --git a/m4/string_h.m4 b/m4/string_h.m4 index a07738479d4..d0a67608114 100644 --- a/m4/string_h.m4 +++ b/m4/string_h.m4 @@ -1,5 +1,5 @@ # string_h.m4 -# serial 39 +# serial 43 dnl Copyright (C) 2007-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -70,6 +70,8 @@ AC_DEFUN([gl_STRING_H_REQUIRE_DEFAULTS], gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRSTR]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRCASESTR]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRTOK_R]) + gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STR_STARTSWITH]) + gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STR_ENDSWITH]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MBSLEN]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MBSNLEN]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MBSCHR]) @@ -84,6 +86,8 @@ AC_DEFUN([gl_STRING_H_REQUIRE_DEFAULTS], gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MBSSPN]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MBSSEP]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MBSTOK_R]) + gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MBS_STARTSWITH]) + gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MBS_ENDSWITH]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRERROR]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRERROR_R]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRERRORNAME_NP]) diff --git a/m4/sys_socket_h.m4 b/m4/sys_socket_h.m4 index 75e97485724..fb69209b4dc 100644 --- a/m4/sys_socket_h.m4 +++ b/m4/sys_socket_h.m4 @@ -1,5 +1,5 @@ # sys_socket_h.m4 -# serial 29 +# serial 31 dnl Copyright (C) 2005-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -53,24 +53,10 @@ AC_DEFUN_ONCE([gl_SYS_SOCKET_H], fi # We need to check for ws2tcpip.h now. gl_PREREQ_SYS_H_SOCKET - AC_CHECK_TYPES([struct sockaddr_storage, sa_family_t],,,[ - /* sys/types.h is not needed according to POSIX, but the - sys/socket.h in i386-unknown-freebsd4.10 and - powerpc-apple-darwin5.5 required it. */ -#include -#ifdef HAVE_SYS_SOCKET_H -#include -#endif -#ifdef HAVE_WS2TCPIP_H -#include -#endif -]) + gl_PREREQ_SYS_SA_FAMILY if test $ac_cv_type_struct_sockaddr_storage = no; then HAVE_STRUCT_SOCKADDR_STORAGE=0 fi - if test $ac_cv_type_sa_family_t = no; then - HAVE_SA_FAMILY_T=0 - fi if test $ac_cv_type_struct_sockaddr_storage != no; then AC_CHECK_MEMBERS([struct sockaddr_storage.ss_family], [], @@ -159,6 +145,32 @@ AC_DEFUN([gl_PREREQ_SYS_H_WS2TCPIP], AC_SUBST([HAVE_WS2TCPIP_H]) ]) +# Common prerequisites of the replacement and of the +# replacement. +# Sets and substitutes HAVE_SA_FAMILY_T. +AC_DEFUN([gl_PREREQ_SYS_SA_FAMILY], +[ + AC_REQUIRE([gl_CHECK_SOCKET_HEADERS]) + AC_CHECK_TYPES([struct sockaddr_storage, sa_family_t],,,[ + /* sys/types.h is not needed according to POSIX, but the + sys/socket.h in i386-unknown-freebsd4.10 and + powerpc-apple-darwin5.5 required it. */ +#include +#ifdef HAVE_SYS_SOCKET_H +#include +#endif +#ifdef HAVE_WS2TCPIP_H +#include +#endif +]) + if test $ac_cv_type_sa_family_t = yes; then + HAVE_SA_FAMILY_T=1 + else + HAVE_SA_FAMILY_T=0 + fi + AC_SUBST([HAVE_SA_FAMILY_T]) +]) + # gl_SYS_SOCKET_MODULE_INDICATOR([modulename]) # sets the shell variable that indicates the presence of the given module # to a C preprocessor expression that will evaluate to 1. @@ -203,6 +215,5 @@ AC_DEFUN([gl_SYS_SOCKET_H_DEFAULTS], HAVE_STRUCT_SOCKADDR_STORAGE=1; AC_SUBST([HAVE_STRUCT_SOCKADDR_STORAGE]) HAVE_STRUCT_SOCKADDR_STORAGE_SS_FAMILY=1; AC_SUBST([HAVE_STRUCT_SOCKADDR_STORAGE_SS_FAMILY]) - HAVE_SA_FAMILY_T=1; AC_SUBST([HAVE_SA_FAMILY_T]) HAVE_ACCEPT4=1; AC_SUBST([HAVE_ACCEPT4]) ]) diff --git a/m4/sys_types_h.m4 b/m4/sys_types_h.m4 index e13de24a784..e99fdcc6c2f 100644 --- a/m4/sys_types_h.m4 +++ b/m4/sys_types_h.m4 @@ -1,5 +1,5 @@ # sys_types_h.m4 -# serial 14 +# serial 15 dnl Copyright (C) 2011-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -34,6 +34,14 @@ AC_DEFUN_ONCE([gl_SYS_TYPES_H], WINDOWS_STAT_INODES=0 ]) AC_SUBST([WINDOWS_STAT_INODES]) + + dnl Test whether the 'blksize_t' type is defined. + AC_CHECK_TYPE([blksize_t], [HAVE_BLKSIZE_T=1], [HAVE_BLKSIZE_T=0]) + AC_SUBST([HAVE_BLKSIZE_T]) + + dnl Test whether the 'blkcnt_t' type is defined. + AC_CHECK_TYPE([blkcnt_t], [HAVE_BLKCNT_T=1], [HAVE_BLKCNT_T=0]) + AC_SUBST([HAVE_BLKCNT_T]) ]) # Initializes the default values for AC_SUBSTed shell variables. diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk index 321a7fdd17f..7b164c1b119 100644 --- a/nt/gnulib-cfg.mk +++ b/nt/gnulib-cfg.mk @@ -53,10 +53,7 @@ OMIT_GNULIB_MODULE_fchmodat = true OMIT_GNULIB_MODULE_fcntl = true OMIT_GNULIB_MODULE_fcntl-h = true OMIT_GNULIB_MODULE_file-has-acl = true -OMIT_GNULIB_MODULE_float = true -OMIT_GNULIB_MODULE_fpucw = true OMIT_GNULIB_MODULE_free-posix = true -OMIT_GNULIB_MODULE_fseterr = true OMIT_GNULIB_MODULE_fsusage = true OMIT_GNULIB_MODULE_futimens = true OMIT_GNULIB_MODULE_getdelim = true @@ -69,15 +66,10 @@ OMIT_GNULIB_MODULE_nanosleep = true OMIT_GNULIB_MODULE_nproc = true OMIT_GNULIB_MODULE_open = true OMIT_GNULIB_MODULE_pipe2 = true -OMIT_GNULIB_MODULE_realloc-gnu = true OMIT_GNULIB_MODULE_realloc-posix = true -OMIT_GNULIB_MODULE_secure_getenv = true OMIT_GNULIB_MODULE_signal-h = true -OMIT_GNULIB_MODULE_signbit = true -OMIT_GNULIB_MODULE_size_max = true OMIT_GNULIB_MODULE_stdio-h = true OMIT_GNULIB_MODULE_stdlib-h = true -OMIT_GNULIB_MODULE_stpncpy = true OMIT_GNULIB_MODULE_sys_select-h = true OMIT_GNULIB_MODULE_sys_stat-h = true OMIT_GNULIB_MODULE_sys_time-h = true @@ -85,4 +77,3 @@ OMIT_GNULIB_MODULE_sys_types-h = true OMIT_GNULIB_MODULE_unistd-h = true OMIT_GNULIB_MODULE_utimens = true OMIT_GNULIB_MODULE_utimensat = true -OMIT_GNULIB_MODULE_xsize = true diff --git a/nt/inc/stdalign.h b/nt/inc/stdalign.h index 7e349dc31d0..808407156fa 100644 --- a/nt/inc/stdalign.h +++ b/nt/inc/stdalign.h @@ -1,9 +1,6 @@ #ifndef _NT_STDALIGN_H_ #define _NT_STDALIGN_H_ -/* This header has the necessary stuff from lib/stdalign.in.h, but - avoids the need to have Sed at build time. */ - #include #if defined __cplusplus template struct __alignof_helper { char __a; __t __b; }; diff --git a/src/Makefile.in b/src/Makefile.in index 3d249a1abdd..3fe0535a968 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -60,6 +60,7 @@ LDFLAGS = @LDFLAGS@ EXEEXT = @EXEEXT@ version = @version@ MKDIR_P = @MKDIR_P@ +AWK = @AWK@ # Don't use LIBS. configure puts stuff in it that either shouldn't be # linked with Emacs or is duplicated by the other stuff below. # LIBS = @LIBS@ @@ -549,7 +550,7 @@ pdumper.o: dmpstruct.h endif dmpstruct.h: $(srcdir)/dmpstruct.awk dmpstruct.h: $(libsrc)/make-fingerprint$(EXEEXT) $(dmpstruct_headers) - $(AM_V_GEN)POSIXLY_CORRECT=1 awk -f $(srcdir)/dmpstruct.awk \ + $(AM_V_GEN)POSIXLY_CORRECT=1 $(AWK) -f $(srcdir)/dmpstruct.awk \ $(dmpstruct_headers) > $@ AUTO_DEPEND = @AUTO_DEPEND@ diff --git a/src/alloc.c b/src/alloc.c index d2c965ce7e7..ce38413ceea 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -684,7 +684,7 @@ malloc_warning (const char *str) void display_malloc_warning (void) { - call3 (Qdisplay_warning, + calln (Qdisplay_warning, Qalloc, build_string (pending_malloc_warning), QCemergency); @@ -719,21 +719,24 @@ buffer_memory_full (ptrdiff_t nbytes) ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b)) /* Alignment needed for memory blocks that are allocated via malloc - and that contain Lisp objects. On typical hosts malloc already - aligns sufficiently, but extra work is needed on oddball hosts - where Emacs would crash if malloc returned a non-GCALIGNED pointer. */ + and that contain Lisp objects. */ enum { LISP_ALIGNMENT = alignof (union { union emacs_align_type x; GCALIGNED_UNION_MEMBER }) }; static_assert (LISP_ALIGNMENT % GCALIGNMENT == 0); -/* True if malloc (N) is known to return storage suitably aligned for - Lisp objects whenever N is a multiple of LISP_ALIGNMENT. In - practice this is true whenever alignof (max_align_t) is also a +/* Verify Emacs's assumption that malloc (N) returns storage suitably + aligned for Lisp objects whenever N is a multiple of LISP_ALIGNMENT. + This assumption holds for current Emacs porting targets; + if the assumption fails on a new platform, this check should + cause compilation to fail and some porting work will need to be done. + + In practice the assumption holds when alignof (max_align_t) is also a multiple of LISP_ALIGNMENT. This works even for buggy platforms like MinGW circa 2020, where alignof (max_align_t) is 16 even though the malloc alignment is only 8, and where Emacs still works because it never does anything that requires an alignment of 16. */ enum { MALLOC_IS_LISP_ALIGNED = alignof (max_align_t) % LISP_ALIGNMENT == 0 }; +static_assert (MALLOC_IS_LISP_ALIGNED); /* If compiled with XMALLOC_BLOCK_INPUT_CHECK, define a symbol BLOCK_INPUT_IN_MEMORY_ALLOCATORS that is visible to the debugger. @@ -774,9 +777,6 @@ malloc_unblock_input (void) malloc_probe (size); \ } while (0) -static void *lmalloc (size_t, bool) ATTRIBUTE_MALLOC_SIZE ((1)); -static void *lrealloc (void *, size_t); - /* Like malloc but check for no memory and block interrupt input. */ void * @@ -785,7 +785,7 @@ xmalloc (size_t size) void *val; MALLOC_BLOCK_INPUT; - val = lmalloc (size, false); + val = malloc (size); MALLOC_UNBLOCK_INPUT; if (!val) @@ -802,7 +802,7 @@ xzalloc (size_t size) void *val; MALLOC_BLOCK_INPUT; - val = lmalloc (size, true); + val = calloc (1, size); MALLOC_UNBLOCK_INPUT; if (!val) @@ -819,12 +819,7 @@ xrealloc (void *block, size_t size) void *val; MALLOC_BLOCK_INPUT; - /* Call lmalloc when BLOCK is null, for the benefit of long-obsolete - platforms lacking support for realloc (NULL, size). */ - if (! block) - val = lmalloc (size, false); - else - val = lrealloc (block, size); + val = realloc (block, size); MALLOC_UNBLOCK_INPUT; if (!val) @@ -1012,10 +1007,6 @@ record_xmalloc (size_t size) } -/* Like malloc but used for allocating Lisp data. NBYTES is the - number of bytes to allocate, TYPE describes the intended use of the - allocated memory block (for strings, for conses, ...). */ - #if ! USE_LSB_TAG extern void *lisp_malloc_loser; void *lisp_malloc_loser EXTERNALLY_VISIBLE; @@ -1033,7 +1024,7 @@ lisp_malloc (size_t nbytes, bool clearit, enum mem_type type) allocated_mem_type = type; #endif - val = lmalloc (nbytes, clearit); + val = clearit ? calloc (1, nbytes) : malloc (nbytes); #if ! USE_LSB_TAG /* If the memory just allocated cannot be addressed thru a Lisp @@ -1119,11 +1110,7 @@ aligned_alloc (size_t alignment, size_t size) Verify this for all arguments this function is given. */ static_assert (BLOCK_ALIGN % sizeof (void *) == 0 && POWER_OF_2 (BLOCK_ALIGN / sizeof (void *))); - static_assert (MALLOC_IS_LISP_ALIGNED - || (LISP_ALIGNMENT % sizeof (void *) == 0 - && POWER_OF_2 (LISP_ALIGNMENT / sizeof (void *)))); - eassert (alignment == BLOCK_ALIGN - || (!MALLOC_IS_LISP_ALIGNED && alignment == LISP_ALIGNMENT)); + eassert (alignment == BLOCK_ALIGN); void *p; return posix_memalign (&p, alignment, size) == 0 ? p : 0; @@ -1374,81 +1361,6 @@ lisp_align_free (void *block) #endif // not HAVE_MPS -/* True if a malloc-returned pointer P is suitably aligned for SIZE, - where Lisp object alignment may be needed if SIZE is a multiple of - LISP_ALIGNMENT. */ - -static bool -laligned (void *p, size_t size) -{ - return (MALLOC_IS_LISP_ALIGNED || (intptr_t) p % LISP_ALIGNMENT == 0 - || size % LISP_ALIGNMENT != 0); -} - -/* Like malloc and realloc except return null only on failure, - the result is Lisp-aligned if SIZE is, and lrealloc's pointer - argument must be nonnull. Code allocating C heap memory - for a Lisp object should use one of these functions to obtain a - pointer P; that way, if T is an enum Lisp_Type value and L == - make_lisp_ptr (P, T), then XPNTR (L) == P and XTYPE (L) == T. - - If CLEARIT, arrange for the allocated memory to be cleared. - This might use calloc, as calloc can be faster than malloc+memset. - - On typical modern platforms these functions' loops do not iterate. - On now-rare (and perhaps nonexistent) platforms, the code can loop, - reallocating (typically with larger and larger sizes) until the - allocator returns a Lisp-aligned pointer. This loop in - theory could repeat forever. If an infinite loop is possible on a - platform, a build would surely loop and the builder can then send - us a bug report. Adding a counter to try to detect any such loop - would complicate the code (and possibly introduce bugs, in code - that's never really exercised) for little benefit. */ - -static void * -lmalloc (size_t size, bool clearit) -{ -#ifdef USE_ALIGNED_ALLOC - if (! MALLOC_IS_LISP_ALIGNED && size % LISP_ALIGNMENT == 0) - { - void *p = aligned_alloc (LISP_ALIGNMENT, size); - if (p) - { - if (clearit) - memclear (p, size); - } - else if (! (MALLOC_0_IS_NONNULL || size)) - return aligned_alloc (LISP_ALIGNMENT, LISP_ALIGNMENT); - return p; - } -#endif - - while (true) - { - void *p = clearit ? calloc (1, size) : malloc (size); - if (laligned (p, size) && (MALLOC_0_IS_NONNULL || size || p)) - return p; - free (p); - size_t bigger; - if (!ckd_add (&bigger, size, LISP_ALIGNMENT)) - size = bigger; - } -} - -static void * -lrealloc (void *p, size_t size) -{ - while (true) - { - p = realloc (p, size); - if (laligned (p, size) && (size || p)) - return p; - size_t bigger; - if (!ckd_add (&bigger, size, LISP_ALIGNMENT)) - size = bigger; - } -} - /*********************************************************************** Interval Allocation @@ -8192,7 +8104,7 @@ respective remote host. */) = Ffind_file_name_handler (BVAR (current_buffer, directory), Qmemory_info); if (!NILP (handler)) - return call1 (handler, Qmemory_info); + return calln (handler, Qmemory_info); #if defined HAVE_LINUX_SYSINFO struct sysinfo si; diff --git a/src/androidfns.c b/src/androidfns.c index 9eb313faaf6..f8e3d397008 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -2127,7 +2127,7 @@ android_create_tip_frame (struct android_display_info *dpyinfo, { Lisp_Object bg = Fframe_parameter (frame, Qbackground_color); - call2 (Qface_set_after_frame_default, frame, Qnil); + calln (Qface_set_after_frame_default, frame, Qnil); if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) { @@ -2166,7 +2166,7 @@ android_hide_tip (bool delete) { if (!NILP (tip_timer)) { - call1 (Qcancel_timer, tip_timer); + calln (Qcancel_timer, tip_timer); tip_timer = Qnil; } @@ -2350,7 +2350,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, tip_f = XFRAME (tip_frame); if (!NILP (tip_timer)) { - call1 (Qcancel_timer, tip_timer); + calln (Qcancel_timer, tip_timer); tip_timer = Qnil; } @@ -2389,11 +2389,11 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, } else tip_last_parms - = call2 (Qassq_delete_all, parm, tip_last_parms); + = calln (Qassq_delete_all, parm, tip_last_parms); } else tip_last_parms - = call2 (Qassq_delete_all, parm, tip_last_parms); + = calln (Qassq_delete_all, parm, tip_last_parms); } /* Now check if every parameter in what is left of @@ -2567,8 +2567,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, start_timer: /* Let the tip disappear after timeout seconds. */ - tip_timer = call3 (Qrun_at_time, timeout, Qnil, - Qx_hide_tip); + tip_timer = calln (Qrun_at_time, timeout, Qnil, Qx_hide_tip); return unbind_to (count, Qnil); #endif @@ -3219,14 +3218,14 @@ for more details about these values. */) if (android_query_battery (&state)) return Qnil; - return listn (8, make_int (state.capacity), - make_fixnum (state.charge_counter), - make_int (state.current_average), - make_int (state.current_now), - make_fixnum (state.status), - make_int (state.remaining), - make_fixnum (state.plugged), - make_fixnum (state.temperature)); + return list (make_int (state.capacity), + make_fixnum (state.charge_counter), + make_int (state.current_average), + make_int (state.current_now), + make_fixnum (state.status), + make_int (state.remaining), + make_fixnum (state.plugged), + make_fixnum (state.temperature)); } diff --git a/src/androidvfs.c b/src/androidvfs.c index d7284a4cc85..656ff7003dd 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -7911,7 +7911,7 @@ files will be removed. */) file = ENCODE_FILE (Fexpand_file_name (file, Qnil)); - if (!NILP (call1 (Qfile_remote_p, file))) + if (!NILP (calln (Qfile_remote_p, file))) signal_error ("Cannot relinquish access to remote file", file); vp = android_name_file (SSDATA (file)); diff --git a/src/buffer.c b/src/buffer.c index 0b2899938b2..400b9cfeadb 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -504,7 +504,7 @@ See also `find-buffer-visiting'. */) handler = Ffind_file_name_handler (filename, Qget_file_buffer); if (!NILP (handler)) { - Lisp_Object handled_buf = call2 (handler, Qget_file_buffer, + Lisp_Object handled_buf = calln (handler, Qget_file_buffer, filename); return BUFFERP (handled_buf) ? handled_buf : Qnil; } @@ -559,7 +559,7 @@ run_buffer_list_update_hook (struct buffer *buf) { eassert (buf); if (! (NILP (Vrun_hooks) || buf->inhibit_buffer_hooks)) - call1 (Vrun_hooks, Qbuffer_list_update_hook); + calln (Vrun_hooks, Qbuffer_list_update_hook); } DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 2, 0, @@ -1711,8 +1711,7 @@ This does not change the name of the visited file (if any). */) run_buffer_list_update_hook (current_buffer); - call2 (Quniquify__rename_buffer_advice, - requestedname, unique); + calln (Quniquify__rename_buffer_advice, requestedname, unique); /* Refetch since that last call may have done GC. */ return BVAR (current_buffer, name); @@ -1752,7 +1751,7 @@ exists, return the buffer `*scratch*' (creating it if necessary). */) if (candidate_buffer (buf, buffer) /* If the frame has a buffer_predicate, disregard buffers that don't fit the predicate. */ - && (NILP (pred) || !NILP (call1 (pred, buf)))) + && (NILP (pred) || !NILP (calln (pred, buf)))) { if (!NILP (visible_ok) || NILP (Fget_buffer_window (buf, Qvisible))) @@ -1768,7 +1767,7 @@ exists, return the buffer `*scratch*' (creating it if necessary). */) if (candidate_buffer (buf, buffer) /* If the frame has a buffer_predicate, disregard buffers that don't fit the predicate. */ - && (NILP (pred) || !NILP (call1 (pred, buf)))) + && (NILP (pred) || !NILP (calln (pred, buf)))) { if (!NILP (visible_ok) || NILP (Fget_buffer_window (buf, Qvisible))) @@ -1938,7 +1937,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) { /* Ask whether to kill the buffer, and exit if the user says "no". */ - if (NILP (call1 (Qkill_buffer__possibly_save, buffer))) + if (NILP (calln (Qkill_buffer__possibly_save, buffer))) return unbind_to (count, Qnil); /* Recheck modified. */ modified = BUF_MODIFF (b) > BUF_SAVE_MODIFF (b); @@ -4247,9 +4246,9 @@ call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, bool after, while (CONSP (list)) { if (NILP (arg3)) - call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2); + calln (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2); else - call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3); + calln (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3); list = XCDR (list); } } @@ -5092,19 +5091,18 @@ defvar_per_buffer (const struct Lisp_Fwd *fwd, const char *namestring) static Lisp_Object make_lispy_itree_node (const struct itree_node *node) { - return listn (12, - intern (":begin"), - make_fixnum (node->begin), - intern (":end"), - make_fixnum (node->end), - intern (":limit"), - make_fixnum (node->limit), - intern (":offset"), - make_fixnum (node->offset), - intern (":rear-advance"), - node->rear_advance ? Qt : Qnil, - intern (":front-advance"), - node->front_advance ? Qt : Qnil); + return list (intern (":begin"), + make_fixnum (node->begin), + intern (":end"), + make_fixnum (node->end), + intern (":limit"), + make_fixnum (node->limit), + intern (":offset"), + make_fixnum (node->offset), + intern (":rear-advance"), + node->rear_advance ? Qt : Qnil, + intern (":front-advance"), + node->front_advance ? Qt : Qnil); } static Lisp_Object diff --git a/src/callint.c b/src/callint.c index 40f3abae00e..9e9bcfd6b02 100644 --- a/src/callint.c +++ b/src/callint.c @@ -305,7 +305,7 @@ invoke it (via an `interactive' spec that contains, for instance, an Lisp_Object up_event = Qnil; /* Set SPECS to the interactive form, or barf if not interactive. */ - Lisp_Object form = call1 (Qinteractive_form, function); + Lisp_Object form = calln (Qinteractive_form, function); if (! CONSP (form)) wrong_type_argument (Qcommandp, function); Lisp_Object specs = Fcar (XCDR (form)); @@ -330,7 +330,7 @@ invoke it (via an `interactive' spec that contains, for instance, an and turn them into things we can eval. */ Lisp_Object values = quotify_args (Fcopy_sequence (specs)); fix_command (function, values); - call4 (Qadd_to_history, Qcommand_history, + calln (Qadd_to_history, Qcommand_history, Fcons (function, values), Qnil, Qt); } @@ -638,7 +638,7 @@ invoke it (via an `interactive' spec that contains, for instance, an goto have_prefix_arg; FALLTHROUGH; case 'n': /* Read number from minibuffer. */ - args[i] = call1 (Qread_number, callint_message); + args[i] = calln (Qread_number, callint_message); visargs[i] = Fnumber_to_string (args[i]); break; @@ -687,12 +687,12 @@ invoke it (via an `interactive' spec that contains, for instance, an break; case 'x': /* Lisp expression read but not evaluated. */ - args[i] = call1 (Qread_minibuffer, callint_message); + args[i] = calln (Qread_minibuffer, callint_message); visargs[i] = last_minibuf_string; break; case 'X': /* Lisp expression read and evaluated. */ - args[i] = call1 (Qeval_minibuffer, callint_message); + args[i] = calln (Qeval_minibuffer, callint_message); visargs[i] = last_minibuf_string; break; @@ -766,7 +766,7 @@ invoke it (via an `interactive' spec that contains, for instance, an visargs[i] = (varies[i] > 0 ? list1 (intern (callint_argfuns[varies[i]])) : quotify_arg (args[i])); - call4 (Qadd_to_history, Qcommand_history, + calln (Qadd_to_history, Qcommand_history, Flist (nargs - 1, visargs + 1), Qnil, Qt); } diff --git a/src/callproc.c b/src/callproc.c index 212eb825a2d..0c336fc8c05 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -928,7 +928,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, /* If the caller required, let the buffer inherit the coding-system used to decode the process output. */ if (inherit_process_coding_system) - call1 (Qafter_insert_file_set_buffer_file_coding_system, + calln (Qafter_insert_file_set_buffer_file_coding_system, make_fixnum (total_read)); } diff --git a/src/casefiddle.c b/src/casefiddle.c index 68b8dc63dbe..faeb16fb8f2 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -583,7 +583,7 @@ casify_pnc_region (enum case_action flag, Lisp_Object beg, Lisp_Object end, { if (!NILP (region_noncontiguous_p)) { - Lisp_Object bounds = call1 (Vregion_extract_function, Qbounds); + Lisp_Object bounds = calln (Vregion_extract_function, Qbounds); FOR_EACH_TAIL (bounds) { CHECK_CONS (XCAR (bounds)); diff --git a/src/charset.c b/src/charset.c index 983be8ca233..f9736edd1fd 100644 --- a/src/charset.c +++ b/src/charset.c @@ -685,7 +685,7 @@ map_charset_for_dump (void (*c_function) (Lisp_Object, Lisp_Object), if (c_function) (*c_function) (arg, range); else - call2 (function, range, arg); + calln (function, range, arg); XSETCAR (range, Qnil); } if (c == stop) @@ -698,7 +698,7 @@ map_charset_for_dump (void (*c_function) (Lisp_Object, Lisp_Object), if (c_function) (*c_function) (arg, range); else - call2 (function, range, arg); + calln (function, range, arg); } break; } @@ -740,7 +740,7 @@ map_charset_chars (void (*c_function)(Lisp_Object, Lisp_Object), Lisp_Object fun if (NILP (function)) (*c_function) (arg, range); else - call2 (function, range, arg); + calln (function, range, arg); } else if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP) { diff --git a/src/chartab.c b/src/chartab.c index 76a40ca7cc4..dbb6a717213 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -665,7 +665,7 @@ optimize_sub_char_table (Lisp_Object table, Lisp_Object test) if (optimizable && (NILP (test) ? NILP (Fequal (this, elt)) /* defaults to `equal'. */ : EQ (test, Qeq) ? !EQ (this, elt) /* Optimize `eq' case. */ - : NILP (call2 (test, this, elt)))) + : NILP (calln (test, this, elt)))) optimizable = 0; } @@ -806,7 +806,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), { if (decoder) val = decoder (top, val); - call2 (function, XCAR (range), val); + calln (function, XCAR (range), val); } } else @@ -817,7 +817,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), { if (decoder) val = decoder (top, val); - call2 (function, range, val); + calln (function, range, val); } } } @@ -882,7 +882,7 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), { if (decoder) val = decoder (table, val); - call2 (function, XCAR (range), val); + calln (function, XCAR (range), val); } } else @@ -893,7 +893,7 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), { if (decoder) val = decoder (table, val); - call2 (function, range, val); + calln (function, range, val); } } } @@ -941,7 +941,7 @@ map_sub_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object), if (c_function) (*c_function) (arg, range); else - call2 (function, range, arg); + calln (function, range, arg); } XSETCAR (range, Qnil); } @@ -964,7 +964,7 @@ map_sub_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object), if (c_function) (*c_function) (arg, range); else - call2 (function, range, arg); + calln (function, range, arg); XSETCAR (range, Qnil); } } @@ -1025,7 +1025,7 @@ map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object), if (c_function) (*c_function) (arg, range); else - call2 (function, range, arg); + calln (function, range, arg); } XSETCAR (range, Qnil); } @@ -1036,7 +1036,7 @@ map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object), if (c_function) (*c_function) (arg, range); else - call2 (function, range, arg); + calln (function, range, arg); } } diff --git a/src/cmds.c b/src/cmds.c index 8e99db839b6..7179822c21c 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -255,7 +255,7 @@ because it respects values of `delete-active-region' and `overwrite-mode'. */) } else { - call1 (Qkill_forward_chars, n); + calln (Qkill_forward_chars, n); } return Qnil; } diff --git a/src/coding.c b/src/coding.c index 804da31655d..5b858c8b581 100644 --- a/src/coding.c +++ b/src/coding.c @@ -8034,7 +8034,7 @@ decode_coding_gap (struct coding_system *coding, ptrdiff_t bytes) Fcons (undo_list, Fcurrent_buffer ())); bset_undo_list (current_buffer, Qt); TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte); - val = call1 (CODING_ATTR_POST_READ (attrs), + val = calln (CODING_ATTR_POST_READ (attrs), make_fixnum (coding->produced_char)); CHECK_FIXNAT (val); coding->produced_char += Z - prev_Z; @@ -10870,10 +10870,10 @@ usage: (find-operation-coding-system OPERATION ARGUMENTS...) */) return Fcons (val, val); if (! NILP (Ffboundp (val))) { - /* We use call1 rather than safe_call1 + /* We use calln rather than safe_calln so as to get bug reports about functions called here which don't handle the current interface. */ - val = call1 (val, Flist (nargs, args)); + val = calln (val, Flist (nargs, args)); if (CONSP (val)) return val; if (SYMBOLP (val) && ! NILP (Fcoding_system_p (val))) diff --git a/src/comp.c b/src/comp.c index c65d80569c3..9c3f9b1b141 100644 --- a/src/comp.c +++ b/src/comp.c @@ -2292,7 +2292,7 @@ emit_limple_insn (Lisp_Object insn) ptrdiff_t i = 0; FOR_EACH_TAIL (p) { - if (i == sizeof (arg) / sizeof (Lisp_Object)) + if (i == ARRAYELTS (arg)) break; arg[i++] = XCAR (p); } diff --git a/src/composite.c b/src/composite.c index 4c2d303165a..d2b34c781a8 100644 --- a/src/composite.c +++ b/src/composite.c @@ -482,7 +482,7 @@ run_composition_function (ptrdiff_t from, ptrdiff_t to, Lisp_Object prop) && !composition_valid_p (start, end, prop)) to = end; if (!NILP (Ffboundp (func))) - call2 (func, make_fixnum (from), make_fixnum (to)); + calln (func, make_fixnum (from), make_fixnum (to)); } /* Make invalid compositions adjacent to or inside FROM and TO valid. diff --git a/src/data.c b/src/data.c index 684bad73e44..45bce3ade28 100644 --- a/src/data.c +++ b/src/data.c @@ -988,7 +988,7 @@ defalias (Lisp_Object symbol, Lisp_Object definition) { /* Handle automatic advice activation. */ Lisp_Object hook = Fget (symbol, Qdefalias_fset_function); if (!NILP (hook)) - call2 (hook, symbol, definition); + calln (hook, symbol, definition); else Ffset (symbol, definition); } @@ -1209,7 +1209,7 @@ Value, if non-nil, is a list (interactive SPEC). */) if (genfun /* Avoid burping during bootstrap. */ && !NILP (Fsymbol_function (Qoclosure_interactive_form))) - return call1 (Qoclosure_interactive_form, fun); + return calln (Qoclosure_interactive_form, fun); else return Qnil; } diff --git a/src/dbusbind.c b/src/dbusbind.c index 7c8388cca61..b590a40c4a9 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1478,7 +1478,7 @@ usage: (dbus-message-internal &rest REST) */) bus or an unknown name, we regard it as broadcast message due to backward compatibility. */ if (dbus_bus_name_has_owner (connection, SSDATA (service), NULL)) - uname = call2 (Qdbus_get_name_owner, bus, service); + uname = calln (Qdbus_get_name_owner, bus, service); else uname = Qnil; diff --git a/src/dired.c b/src/dired.c index 89d6033f9b9..915a2097042 100644 --- a/src/dired.c +++ b/src/dired.c @@ -79,7 +79,17 @@ dirent_namelen (struct dirent *dp) } #ifndef HAVE_STRUCT_DIRENT_D_TYPE -enum { DT_UNKNOWN, DT_DIR, DT_LNK }; +#if !defined (DT_UNKNOWN) && !defined (DT_DIR) && !defined (DT_LNK) +enum { + DT_UNKNOWN, + DT_DIR, + DT_LNK, +}; +#elif defined (DT_UNKNOWN) && defined (DT_DIR) && defined (DT_LNK) +/* Nothing to do here, all three are defined as macros. */ +#elif defined (DT_UNKNOWN) || defined (DT_DIR) || defined (DT_LNK) +#error "Cannot determine DT_UNKNOWN, DT_DIR, DT_LNK" +#endif #endif /* Return the file type of DP. */ @@ -387,7 +397,7 @@ If COUNT is non-nil and a natural number, the function will return call the corresponding file name handler. */ Lisp_Object handler = Ffind_file_name_handler (directory, Qdirectory_files); if (!NILP (handler)) - return call6 (handler, Qdirectory_files, directory, + return calln (handler, Qdirectory_files, directory, full, match, nosort, count); return directory_files_internal (directory, full, match, nosort, @@ -427,7 +437,7 @@ which see. */) Lisp_Object handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes); if (!NILP (handler)) - return call7 (handler, Qdirectory_files_and_attributes, + return calln (handler, Qdirectory_files_and_attributes, directory, full, match, nosort, id_format, count); return directory_files_internal (directory, full, match, nosort, @@ -462,13 +472,13 @@ is matched against file and directory names relative to DIRECTORY. */) call the corresponding file name handler. */ handler = Ffind_file_name_handler (directory, Qfile_name_completion); if (!NILP (handler)) - return call4 (handler, Qfile_name_completion, file, directory, predicate); + return calln (handler, Qfile_name_completion, file, directory, predicate); /* If the file name has special constructs in it, call the corresponding file name handler. */ handler = Ffind_file_name_handler (file, Qfile_name_completion); if (!NILP (handler)) - return call4 (handler, Qfile_name_completion, file, directory, predicate); + return calln (handler, Qfile_name_completion, file, directory, predicate); return file_name_completion (file, directory, 0, predicate); } @@ -490,13 +500,13 @@ is matched against file and directory names relative to DIRECTORY. */) call the corresponding file name handler. */ handler = Ffind_file_name_handler (directory, Qfile_name_all_completions); if (!NILP (handler)) - return call3 (handler, Qfile_name_all_completions, file, directory); + return calln (handler, Qfile_name_all_completions, file, directory); /* If the file name has special constructs in it, call the corresponding file name handler. */ handler = Ffind_file_name_handler (file, Qfile_name_all_completions); if (!NILP (handler)) - return call3 (handler, Qfile_name_all_completions, file, directory); + return calln (handler, Qfile_name_all_completions, file, directory); return file_name_completion (file, directory, 1, Qnil); } @@ -755,7 +765,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, name = Ffile_name_as_directory (name); /* Test the predicate, if any. */ - if (!NILP (predicate) && NILP (call1 (predicate, name))) + if (!NILP (predicate) && NILP (calln (predicate, name))) continue; /* Reject entries where the encoded strings match, but the @@ -1003,9 +1013,9 @@ so last access time will always be midnight of that day. */) compatibility with old file name handlers which do not implement the new arg. --Stef */ if (NILP (id_format)) - return call2 (handler, Qfile_attributes, filename); + return calln (handler, Qfile_attributes, filename); else - return call3 (handler, Qfile_attributes, filename, id_format); + return calln (handler, Qfile_attributes, filename, id_format); } encoded = ENCODE_FILE (filename); diff --git a/src/dispextern.h b/src/dispextern.h index a35a3036047..116da28a30f 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2029,9 +2029,9 @@ GLYPH_CODE_P (Lisp_Object gc) && RANGED_FIXNUMP (0, XCDR (gc), MAX_FACE_ID)) : (RANGED_FIXNUMP (0, gc, - (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS + (MAX_FACE_ID < EMACS_INT_MAX >> CHARACTERBITS ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR - : TYPE_MAXIMUM (EMACS_INT))))); + : EMACS_INT_MAX)))); } /* True means face attributes have been changed since the last diff --git a/src/doc.c b/src/doc.c index 04afe50d3dd..1c5906de9dc 100644 --- a/src/doc.c +++ b/src/doc.c @@ -358,7 +358,7 @@ string is passed through `substitute-command-keys'. */) xsignal1 (Qvoid_function, function); if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) fun = XCDR (fun); - doc = call1 (Qfunction_documentation, fun); + doc = calln (Qfunction_documentation, fun); /* If DOC is 0, it's typically because of a dumped file missing from the DOC file (bug in src/Makefile.in). */ @@ -383,7 +383,7 @@ string is passed through `substitute-command-keys'. */) } if (NILP (raw)) - doc = call1 (Qsubstitute_command_keys, doc); + doc = calln (Qsubstitute_command_keys, doc); return doc; } @@ -459,7 +459,7 @@ aren't strings. */) tem = Feval (tem, Qnil); if (NILP (raw) && STRINGP (tem)) - tem = call1 (Qsubstitute_command_keys, tem); + tem = calln (Qsubstitute_command_keys, tem); return tem; } diff --git a/src/emacs.c b/src/emacs.c index 3c8f3f45923..fdc299ba556 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -557,7 +557,7 @@ init_cmdargs (int argc, char **argv, int skip_args, char const *original_pwd) if (NILP (Vpurify_flag)) { if (!NILP (Ffboundp (Qfile_truename))) - dir = call1 (Qfile_truename, dir); + dir = calln (Qfile_truename, dir); } dir = Fexpand_file_name (build_string ("../.."), dir); } @@ -3017,7 +3017,7 @@ killed. */ if (noninteractive) safe_run_hooks (Qkill_emacs_hook); else - call1 (Qrun_hook_query_error_with_timeout, Qkill_emacs_hook); + calln (Qrun_hook_query_error_with_timeout, Qkill_emacs_hook); } #ifdef HAVE_X_WINDOWS diff --git a/src/eval.c b/src/eval.c index 06dfc94412a..759f0d0bc34 100644 --- a/src/eval.c +++ b/src/eval.c @@ -626,7 +626,7 @@ usage: (function ARG) */) return Fmake_interpreted_closure (args, cdr, Vinternal_interpreter_environment, docstring, iform); else - return call5 (Vinternal_make_interpreted_closure_function, + return calln (Vinternal_make_interpreted_closure_function, args, cdr, Vinternal_interpreter_environment, docstring, iform); } @@ -703,7 +703,7 @@ signal a `cyclic-variable-indirection' error. */) " to `%s'"); formatted = CALLN (Fformat_message, message, new_alias, base_variable); - call2 (Qdisplay_warning, + calln (Qdisplay_warning, list3 (Qdefvaralias, Qlosing_value, new_alias), formatted); } @@ -1888,7 +1888,7 @@ 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? */ - call2 (Vsignal_hook_function, error_symbol, data); + calln (Vsignal_hook_function, error_symbol, data); unbind_to (count, Qnil); } @@ -1928,7 +1928,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable) max_ensure_room (20); push_handler (make_fixnum (skip + h->bytecode_dest), SKIP_CONDITIONS); - call1 (h->val, error); + calln (h->val, error); unbind_to (count, Qnil); pop_handler (); } @@ -2312,7 +2312,7 @@ then strings and vectors are not accepted. */) a type-specific interactive-form. */ if (genfun) { - Lisp_Object iform = call1 (Qinteractive_form, fun); + Lisp_Object iform = calln (Qinteractive_form, fun); return NILP (iform) ? Qnil : Qt; } else @@ -3929,11 +3929,11 @@ backtrace_frame_apply (Lisp_Object function, union specbinding *pdl) flags = list2 (QCdebug_on_exit, Qt); if (backtrace_nargs (pdl) == UNEVALLED) - return call4 (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags); + return calln (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags); else { Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl)); - return call4 (function, Qt, backtrace_function (pdl), tem, flags); + return calln (function, Qt, backtrace_function (pdl), tem, flags); } } diff --git a/src/fileio.c b/src/fileio.c index db7c491e1a1..d832967bb6b 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -446,7 +446,7 @@ Given a Unix syntax file name, returns a string ending in slash. */) handler = Ffind_file_name_handler (filename, Qfile_name_directory); if (!NILP (handler)) { - Lisp_Object handled_name = call2 (handler, Qfile_name_directory, + Lisp_Object handled_name = calln (handler, Qfile_name_directory, filename); return STRINGP (handled_name) ? handled_name : Qnil; } @@ -550,7 +550,7 @@ or the entire name if it contains no slash. */) handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory); if (!NILP (handler)) { - Lisp_Object handled_name = call2 (handler, Qfile_name_nondirectory, + Lisp_Object handled_name = calln (handler, Qfile_name_nondirectory, filename); if (STRINGP (handled_name)) return handled_name; @@ -593,7 +593,7 @@ get a current directory to run processes in. */) handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory); if (!NILP (handler)) { - Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory, + Lisp_Object handled_name = calln (handler, Qunhandled_file_name_directory, filename); return STRINGP (handled_name) ? handled_name : Qnil; } @@ -655,7 +655,7 @@ is already present. */) handler = Ffind_file_name_handler (file, Qfile_name_as_directory); if (!NILP (handler)) { - Lisp_Object handled_name = call2 (handler, Qfile_name_as_directory, + Lisp_Object handled_name = calln (handler, Qfile_name_as_directory, file); if (STRINGP (handled_name)) return handled_name; @@ -746,7 +746,7 @@ In Unix-syntax, this function just removes the final slash. */) handler = Ffind_file_name_handler (directory, Qdirectory_file_name); if (!NILP (handler)) { - Lisp_Object handled_name = call2 (handler, Qdirectory_file_name, + Lisp_Object handled_name = calln (handler, Qdirectory_file_name, directory); if (STRINGP (handled_name)) return handled_name; @@ -1048,7 +1048,7 @@ the root directory. */) handler = Ffind_file_name_handler (name, Qexpand_file_name); if (!NILP (handler)) { - handled_name = call3 (handler, Qexpand_file_name, + handled_name = calln (handler, Qexpand_file_name, name, default_directory); if (STRINGP (handled_name)) return handled_name; @@ -1110,7 +1110,7 @@ the root directory. */) handler = Ffind_file_name_handler (default_directory, Qexpand_file_name); if (!NILP (handler)) { - handled_name = call3 (handler, Qexpand_file_name, + handled_name = calln (handler, Qexpand_file_name, name, default_directory); if (STRINGP (handled_name)) return handled_name; @@ -1165,7 +1165,7 @@ the root directory. */) Qexpand_file_name); if (!NILP (handler)) { - handled_name = call3 (handler, Qexpand_file_name, + handled_name = calln (handler, Qexpand_file_name, name, default_directory); if (STRINGP (handled_name)) return handled_name; @@ -1747,7 +1747,7 @@ the root directory. */) handler = Ffind_file_name_handler (result, Qexpand_file_name); if (!NILP (handler)) { - handled_name = call3 (handler, Qexpand_file_name, + handled_name = calln (handler, Qexpand_file_name, result, default_directory); if (! STRINGP (handled_name)) error ("Invalid handler in `file-name-handler-alist'"); @@ -2068,7 +2068,7 @@ those `/' is discarded. */) handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name); if (!NILP (handler)) { - Lisp_Object handled_name = call2 (handler, Qsubstitute_in_file_name, + Lisp_Object handled_name = calln (handler, Qsubstitute_in_file_name, filename); if (STRINGP (handled_name)) return handled_name; @@ -2108,7 +2108,7 @@ those `/' is discarded. */) Lisp_Object name = (!substituted ? filename : make_specified_string (nm, -1, endp - nm, multibyte)); - Lisp_Object tmp = call1 (Qsubstitute_env_in_file_name, name); + Lisp_Object tmp = calln (Qsubstitute_env_in_file_name, name); CHECK_STRING (tmp); if (!EQ (tmp, name)) substituted = true; @@ -2205,7 +2205,7 @@ barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist, AUTO_STRING (format, "File %s already exists; %s anyway? "); tem = CALLN (Fformat, format, absname, build_string (querystring)); if (quick) - tem = call1 (Qy_or_n_p, tem); + tem = calln (Qy_or_n_p, tem); else tem = do_yes_or_no_p (tem); if (NILP (tem)) @@ -2288,7 +2288,7 @@ permissions. */) if (NILP (handler)) handler = Ffind_file_name_handler (newname, Qcopy_file); if (!NILP (handler)) - return call7 (handler, Qcopy_file, file, newname, + return calln (handler, Qcopy_file, file, newname, ok_if_already_exists, keep_time, preserve_uid_gid, preserve_permissions); @@ -2697,7 +2697,7 @@ is case-insensitive. */) call the corresponding file name handler. */ handler = Ffind_file_name_handler (filename, Qfile_name_case_insensitive_p); if (!NILP (handler)) - return call2 (handler, Qfile_name_case_insensitive_p, filename); + return calln (handler, Qfile_name_case_insensitive_p, filename); /* If the file doesn't exist or there is trouble checking its filesystem, move up the filesystem tree until we reach an @@ -2758,7 +2758,7 @@ This is what happens in interactive use with M-x. */) if (NILP (handler)) handler = Ffind_file_name_handler (newname, Qrename_file); if (!NILP (handler)) - return call4 (handler, Qrename_file, + return calln (handler, Qrename_file, file, newname, ok_if_already_exists); encoded_file = ENCODE_FILE (file); @@ -2819,7 +2819,7 @@ This is what happens in interactive use with M-x. */) dirp = S_ISDIR (file_st.st_mode) != 0; } if (dirp) - call4 (Qcopy_directory, file, newname, Qt, Qnil); + calln (Qcopy_directory, file, newname, Qt, Qnil); else if (S_ISREG (file_st.st_mode)) Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt); else if (S_ISLNK (file_st.st_mode)) @@ -2837,9 +2837,9 @@ This is what happens in interactive use with M-x. */) specpdl_ref count = SPECPDL_INDEX (); specbind (Qdelete_by_moving_to_trash, Qnil); if (dirp) - call2 (Qdelete_directory, file, Qt); + calln (Qdelete_directory, file, Qt); else - call2 (Qdelete_file, file, Qnil); + calln (Qdelete_file, file, Qnil); return unbind_to (count, Qnil); } @@ -2865,14 +2865,14 @@ This is what happens in interactive use with M-x. */) call the corresponding file name handler. */ handler = Ffind_file_name_handler (file, Qadd_name_to_file); if (!NILP (handler)) - return call4 (handler, Qadd_name_to_file, file, + return calln (handler, Qadd_name_to_file, file, newname, ok_if_already_exists); /* If the new name has special constructs in it, call the corresponding file name handler. */ handler = Ffind_file_name_handler (newname, Qadd_name_to_file); if (!NILP (handler)) - return call4 (handler, Qadd_name_to_file, file, + return calln (handler, Qadd_name_to_file, file, newname, ok_if_already_exists); encoded_file = ENCODE_FILE (file); @@ -2929,7 +2929,7 @@ This happens for interactive use with M-x. */) call the corresponding file name handler. */ handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link); if (!NILP (handler)) - return call4 (handler, Qmake_symbolic_link, target, + return calln (handler, Qmake_symbolic_link, target, linkname, ok_if_already_exists); encoded_target = ENCODE_FILE (target); @@ -2990,7 +2990,7 @@ check_file_access (Lisp_Object file, Lisp_Object operation, int amode) Lisp_Object handler = Ffind_file_name_handler (file, operation); if (!NILP (handler)) { - Lisp_Object ok = call2 (handler, operation, file); + Lisp_Object ok = calln (handler, operation, file); /* This errno value is bogus. Any caller that depends on errno should be rethought anyway, to avoid a race between testing a handled file's accessibility and using the file. */ @@ -3045,7 +3045,7 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, call the corresponding file name handler. */ handler = Ffind_file_name_handler (absname, Qfile_writable_p); if (!NILP (handler)) - return call2 (handler, Qfile_writable_p, absname); + return calln (handler, Qfile_writable_p, absname); encoded = ENCODE_FILE (absname); if (file_access_p (SSDATA (encoded), W_OK)) @@ -3087,7 +3087,7 @@ If there is no error, returns nil. */) call the corresponding file name handler. */ handler = Ffind_file_name_handler (absname, Qaccess_file); if (!NILP (handler)) - return call3 (handler, Qaccess_file, absname, string); + return calln (handler, Qaccess_file, absname, string); encoded_filename = ENCODE_FILE (absname); @@ -3172,7 +3172,7 @@ This function does not check whether the link target exists. */) call the corresponding file name handler. */ handler = Ffind_file_name_handler (filename, Qfile_symlink_p); if (!NILP (handler)) - return call2 (handler, Qfile_symlink_p, filename); + return calln (handler, Qfile_symlink_p, filename); return emacs_readlinkat (AT_FDCWD, SSDATA (ENCODE_FILE (filename))); } @@ -3196,7 +3196,7 @@ See `file-symlink-p' to distinguish symlinks. */) call the corresponding file name handler. */ Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_directory_p); if (!NILP (handler)) - return call2 (handler, Qfile_directory_p, absname); + return calln (handler, Qfile_directory_p, absname); return file_directory_p (ENCODE_FILE (absname)) ? Qt : Qnil; } @@ -3273,7 +3273,7 @@ predicate must return true. */) handler = Ffind_file_name_handler (absname, Qfile_accessible_directory_p); if (!NILP (handler)) { - Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname); + Lisp_Object r = calln (handler, Qfile_accessible_directory_p, absname); /* Set errno in case the handler failed. EACCES might be a lie (e.g., the directory might not exist, or be a regular file), @@ -3367,7 +3367,7 @@ See `file-symlink-p' to distinguish symlinks. */) call the corresponding file name handler. */ Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_regular_p); if (!NILP (handler)) - return call2 (handler, Qfile_regular_p, absname); + return calln (handler, Qfile_regular_p, absname); #ifdef WINDOWSNT /* Tell stat to use expensive method to get accurate info. */ @@ -3406,7 +3406,7 @@ or if SELinux is disabled, or if Emacs lacks SELinux support. */) Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_selinux_context); if (!NILP (handler)) - return call2 (handler, Qfile_selinux_context, absname); + return calln (handler, Qfile_selinux_context, absname); #ifdef HAVE_LIBSELINUX file = SSDATA (ENCODE_FILE (absname)); @@ -3471,7 +3471,7 @@ or if Emacs was not compiled with SELinux support. */) call the corresponding file name handler. */ handler = Ffind_file_name_handler (absname, Qset_file_selinux_context); if (!NILP (handler)) - return call3 (handler, Qset_file_selinux_context, absname, context); + return calln (handler, Qset_file_selinux_context, absname, context); #if HAVE_LIBSELINUX encoded_absname = ENCODE_FILE (absname); @@ -3542,7 +3542,7 @@ Return nil if file does not exist. */) call the corresponding file name handler. */ Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_acl); if (!NILP (handler)) - return call2 (handler, Qfile_acl, absname); + return calln (handler, Qfile_acl, absname); # ifdef HAVE_ACL_SET_FILE # ifndef HAVE_ACL_TYPE_EXTENDED @@ -3599,7 +3599,7 @@ support. */) call the corresponding file name handler. */ handler = Ffind_file_name_handler (absname, Qset_file_acl); if (!NILP (handler)) - return call3 (handler, Qset_file_acl, absname, acl_string); + return calln (handler, Qset_file_acl, absname, acl_string); # ifdef HAVE_ACL_SET_FILE if (STRINGP (acl_string)) @@ -3650,7 +3650,7 @@ do not follow FILENAME if it is a symbolic link. */) call the corresponding file name handler. */ Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_modes); if (!NILP (handler)) - return call3 (handler, Qfile_modes, absname, flag); + return calln (handler, Qfile_modes, absname, flag); char *fname = SSDATA (ENCODE_FILE (absname)); if (emacs_fstatat (AT_FDCWD, fname, &st, nofollow) != 0) @@ -3681,7 +3681,7 @@ command from GNU Coreutils. */) call the corresponding file name handler. */ Lisp_Object handler = Ffind_file_name_handler (absname, Qset_file_modes); if (!NILP (handler)) - return call4 (handler, Qset_file_modes, absname, mode, flag); + return calln (handler, Qset_file_modes, absname, mode, flag); encoded = ENCODE_FILE (absname); char *fname = SSDATA (encoded); @@ -3755,7 +3755,7 @@ TIMESTAMP is in the format of `current-time'. */) absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)), handler = Ffind_file_name_handler (absname, Qset_file_times); if (!NILP (handler)) - return call4 (handler, Qset_file_times, absname, timestamp, flag); + return calln (handler, Qset_file_times, absname, timestamp, flag); Lisp_Object encoded_absname = ENCODE_FILE (absname); check_vfs_filename (encoded_absname, "Trying to set access times of" @@ -3808,7 +3808,7 @@ For existing files, this compares their last-modified times. */) if (NILP (handler)) handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p); if (!NILP (handler)) - return call3 (handler, Qfile_newer_than_file_p, absname1, absname2); + return calln (handler, Qfile_newer_than_file_p, absname1, absname2); encoded = ENCODE_FILE (absname1); @@ -3971,7 +3971,7 @@ get_window_points_and_markers (void) { Lisp_Object pt_marker = Fpoint_marker (); Lisp_Object windows - = call3 (Qget_buffer_window_list, Fcurrent_buffer (), Qnil, Qt); + = calln (Qget_buffer_window_list, Fcurrent_buffer (), Qnil, Qt); Lisp_Object window_markers = windows; /* Window markers (and point) are handled specially: rather than move to just before or just after the modified text, we try to keep the @@ -4130,7 +4130,7 @@ by calling `format-decode', which see. */) handler = Ffind_file_name_handler (filename, Qinsert_file_contents); if (!NILP (handler)) { - val = call6 (handler, Qinsert_file_contents, filename, + val = calln (handler, Qinsert_file_contents, filename, visit, beg, end, replace); if (CONSP (val) && CONSP (XCDR (val)) && RANGED_FIXNUMP (0, XCAR (XCDR (val)), ZV - PT)) @@ -4333,7 +4333,7 @@ by calling `format-decode', which see. */) insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0); TEMP_SET_PT_BOTH (BEG, BEG_BYTE); - coding_system = call2 (Vset_auto_coding_function, + coding_system = calln (Vset_auto_coding_function, filename, make_fixnum (nread)); set_buffer_internal (prev); @@ -4747,12 +4747,18 @@ by calling `format-decode', which see. */) goto handled; } - if (seekable || !NILP (end)) + /* Don't believe st.st_size if it is zero. */ + if ((regular && st.st_size > 0) || (!regular && seekable) || !NILP (end)) total = end_offset - beg_offset; else - /* For a special file, all we can do is guess. */ + /* For a special file that is not seekable, all we can do is guess. */ total = READ_BUF_SIZE; + /* From here on, treat a file with zero size as not seekable. This + causes us to read until we actually hit EOF. */ + if (regular && st.st_size == 0) + seekable = false; + if (NILP (visit) && total > 0) { if (!NILP (BVAR (current_buffer, file_truename)) @@ -4910,7 +4916,7 @@ by calling `format-decode', which see. */) if (inserted > 0 && ! NILP (Vset_auto_coding_function)) { - coding_system = call2 (Vset_auto_coding_function, + coding_system = calln (Vset_auto_coding_function, filename, make_fixnum (inserted)); } @@ -5041,7 +5047,7 @@ by calling `format-decode', which see. */) if (! NILP (Ffboundp (Qafter_insert_file_set_coding))) { - insval = call2 (Qafter_insert_file_set_coding, make_fixnum (inserted), + insval = calln (Qafter_insert_file_set_coding, make_fixnum (inserted), visit); if (! NILP (insval)) { @@ -5068,7 +5074,7 @@ by calling `format-decode', which see. */) if (NILP (replace)) { - insval = call3 (Qformat_decode, + insval = calln (Qformat_decode, Qnil, make_fixnum (inserted), visit); if (! RANGED_FIXNUMP (0, insval, ZV - PT)) wrong_type_argument (Qinserted_chars, insval); @@ -5091,7 +5097,7 @@ by calling `format-decode', which see. */) modiff_count ochars_modiff = CHARS_MODIFF; TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE); - insval = call3 (Qformat_decode, + insval = calln (Qformat_decode, Qnil, make_fixnum (oinserted), visit); if (! RANGED_FIXNUMP (0, insval, ZV - PT)) wrong_type_argument (Qinserted_chars, insval); @@ -5113,7 +5119,7 @@ by calling `format-decode', which see. */) { if (NILP (replace)) { - insval = call1 (XCAR (p), make_fixnum (inserted)); + insval = calln (XCAR (p), make_fixnum (inserted)); if (!NILP (insval)) { if (! RANGED_FIXNUMP (0, insval, ZV - PT)) @@ -5131,7 +5137,7 @@ by calling `format-decode', which see. */) modiff_count ochars_modiff = CHARS_MODIFF; TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE); - insval = call1 (XCAR (p), make_fixnum (oinserted)); + insval = calln (XCAR (p), make_fixnum (oinserted)); if (!NILP (insval)) { if (! RANGED_FIXNUMP (0, insval, ZV - PT)) @@ -5233,7 +5239,7 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file if (coding_system_require_warning && !NILP (Ffboundp (Vselect_safe_coding_system_function))) /* Confirm that VAL can surely encode the current region. */ - val = call5 (Vselect_safe_coding_system_function, + val = calln (Vselect_safe_coding_system_function, start, end, list2 (Qt, val), Qnil, filename); } @@ -5293,7 +5299,7 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file && !NILP (Ffboundp (Vselect_safe_coding_system_function))) { /* Confirm that VAL can surely encode the current region. */ - val = call5 (Vselect_safe_coding_system_function, + val = calln (Vselect_safe_coding_system_function, start, end, val, Qnil, filename); /* As the function specified by select-safe-coding-system-function is out of our control, make sure we are not fed by bogus @@ -5434,7 +5440,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, if (!NILP (handler)) { Lisp_Object val; - val = call8 (handler, Qwrite_region, start, end, + val = calln (handler, Qwrite_region, start, end, filename, append, visit, lockname, mustbenew); if (visiting) @@ -5778,7 +5784,7 @@ build_annotations (Lisp_Object start, Lisp_Object end) goto loop_over_p; } Vwrite_region_annotations_so_far = annotations; - res = call2 (XCAR (p), start, end); + res = calln (XCAR (p), start, end); /* If the function makes a different buffer current, assume that means this buffer contains altered text to be output. Reset START and END from the buffer bounds @@ -5812,7 +5818,7 @@ build_annotations (Lisp_Object start, Lisp_Object end) /* Value is either a list of annotations or nil if the function has written annotations to a temporary buffer, which is now current. */ - res = call5 (Qformat_annotate_function, XCAR (p), start, end, + res = calln (Qformat_annotate_function, XCAR (p), start, end, original_buffer, make_fixnum (i++)); if (current_buffer != given_buffer) { @@ -6008,7 +6014,7 @@ See Info node `(elisp)Modification Time' for more details. */) handler = Ffind_file_name_handler (BVAR (b, filename), Qverify_visited_file_modtime); if (!NILP (handler)) - return call2 (handler, Qverify_visited_file_modtime, buf); + return calln (handler, Qverify_visited_file_modtime, buf); filename = ENCODE_FILE (BVAR (b, filename)); mtime = (emacs_fstatat (AT_FDCWD, SSDATA (filename), &st, 0) == 0 @@ -6081,7 +6087,7 @@ in `current-time' or an integer flag as returned by `visited-file-modtime'. */) handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime); if (!NILP (handler)) /* The handler can find the file name the same way we did. */ - return call2 (handler, Qset_visited_file_modtime, Qnil); + return calln (handler, Qset_visited_file_modtime, Qnil); encoded = ENCODE_FILE (filename); @@ -6108,8 +6114,7 @@ auto_save_error (Lisp_Object error_val) AUTO_STRING (format, "Auto-saving %s: %s"); Lisp_Object msg = CALLN (Fformat, format, BVAR (current_buffer, name), Ferror_message_string (error_val)); - call3 (Qdisplay_warning, - Qauto_save, msg, QCerror); + calln (Qdisplay_warning, Qauto_save, msg, QCerror); return Qnil; } @@ -6169,7 +6174,7 @@ do_auto_save_make_dir (Lisp_Object dir) Lisp_Object result; auto_saving_dir_umask = 077; - result = call2 (Qmake_directory, dir, Qt); + result = calln (Qmake_directory, dir, Qt); auto_saving_dir_umask = 0; return result; } @@ -6520,7 +6525,7 @@ If the underlying system call fails, value is nil. */) Lisp_Object handler = Ffind_file_name_handler (filename, Qfile_system_info); if (!NILP (handler)) { - Lisp_Object result = call2 (handler, Qfile_system_info, filename); + Lisp_Object result = calln (handler, Qfile_system_info, filename); if (CONSP (result) || NILP (result)) return result; error ("Invalid handler in `file-name-handler-alist'"); diff --git a/src/filelock.c b/src/filelock.c index c276f19dcd1..e61c6776e3e 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -555,7 +555,7 @@ make_lock_file_name (Lisp_Object fn) return Qnil; #endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ - lock_file_name = call1 (Qmake_lock_file_name, fn); + lock_file_name = calln (Qmake_lock_file_name, fn); return !NILP (lock_file_name) ? ENCODE_FILE (lock_file_name) : Qnil; } @@ -605,7 +605,7 @@ lock_file (Lisp_Object fn) && NILP (Fverify_visited_file_modtime (subject_buf)) && !NILP (Ffile_exists_p (fn)) && !(!NILP (lfname) && current_lock_owner (NULL, lfname) == I_OWN_IT)) - call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); + calln (intern ("userlock--ask-user-about-supersession-threat"), fn); /* Don't do locking if the user has opted out. */ if (!NILP (lfname)) @@ -623,7 +623,7 @@ lock_file (Lisp_Object fn) memmove (dot + replacementlen, dot + 1, pidlen); strcpy (dot + replacementlen + pidlen, ")"); memcpy (dot, replacement, replacementlen); - attack = call2 (intern ("ask-user-about-lock"), fn, + attack = calln (intern ("ask-user-about-lock"), fn, build_string (lock_info.user)); /* Take the lock if the user said so. */ if (!NILP (attack)) @@ -653,7 +653,7 @@ unlock_file (Lisp_Object fn) static Lisp_Object unlock_file_handle_error (Lisp_Object err) { - call1 (intern ("userlock--handle-unlock-error"), err); + calln (intern ("userlock--handle-unlock-error"), err); return Qnil; } @@ -690,7 +690,7 @@ whether to modify FILE. */) Lisp_Object handler; handler = Ffind_file_name_handler (file, Qlock_file); if (!NILP (handler)) - return call2 (handler, Qlock_file, file); + return calln (handler, Qlock_file, file); lock_file (file); #endif /* MSDOS */ @@ -710,7 +710,7 @@ DEFUN ("unlock-file", Funlock_file, Sunlock_file, 1, 1, 0, handler = Ffind_file_name_handler (file, Qunlock_file); if (!NILP (handler)) { - call2 (handler, Qunlock_file, file); + calln (handler, Qunlock_file, file); return Qnil; } @@ -786,7 +786,7 @@ t if it is locked by you, else a string saying which user has locked it. */) handler = Ffind_file_name_handler (filename, Qfile_locked_p); if (!NILP (handler)) { - return call2 (handler, Qfile_locked_p, filename); + return calln (handler, Qfile_locked_p, filename); } Lisp_Object lfname = make_lock_file_name (filename); diff --git a/src/fns.c b/src/fns.c index caf9cb7a51b..31d79d59b4d 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2028,7 +2028,7 @@ TESTFN is called with 2 arguments: a car of an alist element and KEY. */) if ((NILP (testfn) ? (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))) - : !NILP (call2 (testfn, XCAR (car), key)))) + : !NILP (calln (testfn, XCAR (car), key)))) return car; } CHECK_LIST_END (tail, alist); @@ -2518,7 +2518,7 @@ merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred) } Lisp_Object tem; - if (!NILP (call2 (pred, Fcar (l1), Fcar (l2)))) + if (!NILP (calln (pred, Fcar (l1), Fcar (l2)))) { tem = l1; l1 = Fcdr (l1); @@ -2607,7 +2607,7 @@ This function doesn't signal an error if PLIST is invalid. */) { if (! CONSP (XCDR (tail))) break; - if (!NILP (call2 (predicate, XCAR (tail), prop))) + if (!NILP (calln (predicate, XCAR (tail), prop))) return XCAR (XCDR (tail)); tail = XCDR (tail); } @@ -2666,7 +2666,7 @@ The PLIST is modified by side effects. */) if (! CONSP (XCDR (tail))) break; - if (!NILP (call2 (predicate, XCAR (tail), prop))) + if (!NILP (calln (predicate, XCAR (tail), prop))) { Fsetcar (XCDR (tail), val); return plist; @@ -2741,7 +2741,7 @@ The value is actually the tail of PLIST whose car is PROP. */) Lisp_Object tail = plist; FOR_EACH_TAIL (tail) { - if (!NILP (call2 (predicate, XCAR (tail), prop))) + if (!NILP (calln (predicate, XCAR (tail), prop))) return tail; tail = XCDR (tail); if (! CONSP (tail)) @@ -3310,14 +3310,16 @@ ARRAY is a vector, string, char-table, or bool-vector. */) return array; } -DEFUN ("clear-string", Fclear_string, Sclear_string, - 1, 1, 0, +DEFUN ("clear-string", Fclear_string, Sclear_string, 1, 1, 0, doc: /* Clear the contents of STRING. -This makes STRING unibyte and may change its length. */) +This makes STRING unibyte, clears its contents to null characters, and +removes all text properties. This may change its length. */) (Lisp_Object string) { CHECK_STRING (string); ptrdiff_t len = SBYTES (string); + Fset_text_properties (make_fixnum (0), make_fixnum (SCHARS (string)), + Qnil, string); if (len != 0 || STRING_MULTIBYTE (string)) { CHECK_IMPURE (string, XSTRING (string)); @@ -3386,7 +3388,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) { if (! CONSP (tail)) return i; - Lisp_Object dummy = call1 (fn, XCAR (tail)); + Lisp_Object dummy = calln (fn, XCAR (tail)); if (vals) vals[i] = dummy; tail = XCDR (tail); @@ -3396,7 +3398,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) { for (ptrdiff_t i = 0; i < leni; i++) { - Lisp_Object dummy = call1 (fn, AREF (seq, i)); + Lisp_Object dummy = calln (fn, AREF (seq, i)); if (vals) vals[i] = dummy; } @@ -3409,7 +3411,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) { ptrdiff_t i_before = i; int c = fetch_string_char_advance (seq, &i, &i_byte); - Lisp_Object dummy = call1 (fn, make_fixnum (c)); + Lisp_Object dummy = calln (fn, make_fixnum (c)); if (vals) vals[i_before] = dummy; } @@ -3419,7 +3421,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) eassert (BOOL_VECTOR_P (seq)); for (EMACS_INT i = 0; i < leni; i++) { - Lisp_Object dummy = call1 (fn, bool_vector_ref (seq, i)); + Lisp_Object dummy = calln (fn, bool_vector_ref (seq, i)); if (vals) vals[i] = dummy; } @@ -3552,7 +3554,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) Lisp_Object do_yes_or_no_p (Lisp_Object prompt) { - return call1 (Qyes_or_no_p, prompt); + return calln (Qyes_or_no_p, prompt); } DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0, @@ -3597,7 +3599,7 @@ by a mouse, or by some window-system gesture, or via a menu. */) } if (use_short_answers) - return call1 (Qy_or_n_p, prompt); + return calln (Qy_or_n_p, prompt); ptrdiff_t promptlen = SCHARS (prompt); bool prompt_ends_in_nonspace @@ -6645,7 +6647,7 @@ set a new value for KEY, or `remhash' to remove KEY. we shouldn't crash as a result (although the effects are unpredictable). */ DOHASH_SAFE (h, i) - call2 (function, HASH_KEY (h, i), HASH_VALUE (h, i)); + calln (function, HASH_KEY (h, i), HASH_VALUE (h, i)); return Qnil; } @@ -6905,7 +6907,7 @@ extract_data_from_object (Lisp_Object spec, if (!force_raw_text && !NILP (Ffboundp (Vselect_safe_coding_system_function))) /* Confirm that VAL can surely encode the current region. */ - coding_system = call4 (Vselect_safe_coding_system_function, + coding_system = calln (Vselect_safe_coding_system_function, make_fixnum (b), make_fixnum (e), coding_system, Qnil); diff --git a/src/font.c b/src/font.c index 86382267a4a..dfe479f9355 100644 --- a/src/font.c +++ b/src/font.c @@ -418,8 +418,24 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, eassert (len < 255); elt = make_vector (2, make_fixnum (100)); ASET (elt, 1, val); - ASET (font_style_table, prop - FONT_WEIGHT_INDEX, - CALLN (Fvconcat, table, make_vector (1, elt))); + Lisp_Object new_table = CALLN (Fvconcat, table, make_vector (1, elt)); + /* Update the corresponding variable with the new value of the + modified slot of font_style_table. */ + switch (prop) + { + case FONT_WEIGHT_INDEX: + Vfont_weight_table = new_table; + break; + case FONT_SLANT_INDEX: + Vfont_slant_table = new_table; + break; + case FONT_WIDTH_INDEX: + Vfont_width_table = new_table; + break; + default: + break; + } + ASET (font_style_table, prop - FONT_WEIGHT_INDEX, new_table); return (100 << 8) | (i << 4); } else @@ -5977,6 +5993,9 @@ This variable cannot be set; trying to do so will signal an error. */); Vfont_width_table = BUILD_STYLE_TABLE (width_table); make_symbol_constant (intern_c_string ("font-width-table")); + /* Because the above 3 variables are slots in the vector we create + below, and because that vector is staticpro'd, we don't explicitly + staticpro the variables, to avoid wasting slots in staticvec[]. */ staticpro (&font_style_table); font_style_table = CALLN (Fvector, Vfont_weight_table, Vfont_slant_table, Vfont_width_table); diff --git a/src/frame.c b/src/frame.c index 529d07e1b18..92c62e5db76 100644 --- a/src/frame.c +++ b/src/frame.c @@ -402,7 +402,7 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, : FRAME_COLUMN_WIDTH (f))); } else - retval = XFIXNUM (call4 (Qframe_windows_min_size, frame, horizontal, + retval = XFIXNUM (calln (Qframe_windows_min_size, frame, horizontal, ignore, pixelwise)); /* Don't allow too small height of text-mode frames, or else cm.c @@ -891,7 +891,7 @@ adjust_frame_size (struct frame *f, int new_text_width, int new_text_height, #endif } else if (new_text_cols != old_text_cols) - call2 (Qwindow__pixel_to_total, frame, Qt); + calln (Qwindow__pixel_to_total, frame, Qt); if (new_inner_height != old_inner_height /* When the top margin has changed we have to recalculate the top @@ -908,7 +908,7 @@ adjust_frame_size (struct frame *f, int new_text_width, int new_text_height, FrameRows (FRAME_TTY (f)) = new_text_lines + FRAME_TOP_MARGIN (f); } else if (new_text_lines != old_text_lines) - call2 (Qwindow__pixel_to_total, frame, Qnil); + calln (Qwindow__pixel_to_total, frame, Qnil); /* Assign new sizes. */ FRAME_COLS (f) = new_text_cols; @@ -1154,7 +1154,7 @@ make_frame_without_minibuffer (Lisp_Object mini_window, KBOARD *kb, Lisp_Object initial_frame; /* If there's no minibuffer frame to use, create one. */ - initial_frame = call1 (Qmake_initial_minibuffer_frame, + initial_frame = calln (Qmake_initial_minibuffer_frame, display); kset_default_minibuffer_frame (kb, initial_frame); } @@ -1819,7 +1819,7 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor non-active minibuffer. */ && NILP (Fminibufferp (XWINDOW (f->minibuffer_window)->contents, Qt))) { - Lisp_Object w = call1 (Qget_mru_window, frame); + Lisp_Object w = calln (Qget_mru_window, frame); if (WINDOW_LIVE_P (w)) /* W can be nil in minibuffer-only frames. */ Fset_frame_selected_window (frame, w, Qnil); } @@ -2981,7 +2981,7 @@ mouse_position (bool call_mouse_position_function) lispy_dummy = Qnil; retval = Fcons (lispy_dummy, Fcons (x, y)); if (call_mouse_position_function && !NILP (Vmouse_position_function)) - retval = call1 (Vmouse_position_function, retval); + retval = calln (Vmouse_position_function, retval); return retval; } @@ -3023,7 +3023,7 @@ Y. */) retval = Fcons (lispy_dummy, Fcons (x, y)); if (!NILP (Vmouse_position_function)) - retval = call1 (Vmouse_position_function, retval); + retval = calln (Vmouse_position_function, retval); return retval; } @@ -4483,7 +4483,7 @@ frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what, Lisp_Object frame; XSETFRAME (frame, f); - monitor_attributes = call1 (Qframe_monitor_attributes, frame); + monitor_attributes = calln (Qframe_monitor_attributes, frame); if (NILP (monitor_attributes)) { /* No monitor attributes available. */ @@ -4528,7 +4528,7 @@ frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what, Lisp_Object frame, outer_edges; XSETFRAME (frame, f); - outer_edges = call2 (Qframe_edges, frame, Qouter_edges); + outer_edges = calln (Qframe_edges, frame, Qouter_edges); if (!NILP (outer_edges)) { @@ -6128,7 +6128,7 @@ On Nextstep, this just calls `ns-parse-geometry'. */) #ifdef HAVE_NS if (strchr (SSDATA (string), ' ') != NULL) - return call1 (Qns_parse_geometry, string); + return calln (Qns_parse_geometry, string); #endif int geometry = XParseGeometry (SSDATA (string), &x, &y, &width, &height); @@ -6540,7 +6540,7 @@ have changed. */) /* Now call this to apply the existing value(s) of the `default' face. */ - call2 (Qface_set_after_frame_default, frame, params); + calln (Qface_set_after_frame_default, frame, params); /* Restore the value of the `font-parameter' parameter, as `face-set-after-frame-default' will have changed it through its diff --git a/src/gtkutil.c b/src/gtkutil.c index e1949b4a06d..09ba18e1526 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1762,7 +1762,6 @@ xg_create_frame_widgets (struct frame *f) 0); imc = gtk_im_multicontext_new (); - g_object_ref (imc); gtk_im_context_set_use_preedit (imc, TRUE); g_signal_connect_data (G_OBJECT (imc), "commit", @@ -5624,7 +5623,7 @@ find_rtl_image (struct frame *f, Lisp_Object image, Lisp_Object rtl) Lisp_Object rtl_image = PROP (TOOL_BAR_ITEM_IMAGES); if (!NILP (file = file_for_image (rtl_image))) { - file = call1 (Qfile_name_sans_extension, + file = calln (Qfile_name_sans_extension, Ffile_name_nondirectory (file)); if (! NILP (Fequal (file, rtl_name))) { @@ -6038,7 +6037,7 @@ update_frame_tool_bar (struct frame *f) specified_file = file_for_image (image); if (!NILP (specified_file) && !NILP (Ffboundp (Qx_gtk_map_stock))) - stock = call1 (Qx_gtk_map_stock, specified_file); + stock = calln (Qx_gtk_map_stock, specified_file); if (CONSP (stock)) { diff --git a/src/haikufns.c b/src/haikufns.c index 29e4d6283e1..22e82048fc4 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1196,7 +1196,7 @@ haiku_create_tip_frame (Lisp_Object parms) { Lisp_Object bg = Fframe_parameter (frame, Qbackground_color); - call2 (Qface_set_after_frame_default, frame, Qnil); + calln (Qface_set_after_frame_default, frame, Qnil); if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) { @@ -1309,7 +1309,7 @@ haiku_hide_tip (bool delete) if (!NILP (tip_timer)) { - call1 (Qcancel_timer, tip_timer); + calln (Qcancel_timer, tip_timer); tip_timer = Qnil; } @@ -2467,7 +2467,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, tip_f = XFRAME (tip_frame); if (!NILP (tip_timer)) { - call1 (Qcancel_timer, tip_timer); + calln (Qcancel_timer, tip_timer); tip_timer = Qnil; } @@ -2505,11 +2505,11 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, } else tip_last_parms = - call2 (Qassq_delete_all, parm, tip_last_parms); + calln (Qassq_delete_all, parm, tip_last_parms); } else tip_last_parms = - call2 (Qassq_delete_all, parm, tip_last_parms); + calln (Qassq_delete_all, parm, tip_last_parms); } /* Now check if every parameter in what is left of @@ -2680,7 +2680,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, start_timer: /* Let the tip disappear after timeout seconds. */ - tip_timer = call3 (Qrun_at_time, timeout, Qnil, Qx_hide_tip); + tip_timer = calln (Qrun_at_time, timeout, Qnil, Qx_hide_tip); return unbind_to (count, Qnil); } diff --git a/src/haikumenu.c b/src/haikumenu.c index acee8effe31..a7976cc1bed 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -786,7 +786,7 @@ the position of the last non-menu event instead. */) popup_activated_p += 1; } else - return call2 (Qpopup_menu, call0 (Qmouse_menu_bar_map), + return calln (Qpopup_menu, calln (Qmouse_menu_bar_map), last_nonmenu_event); return Qnil; diff --git a/src/image.c b/src/image.c index ff8c3aee57a..9b86fd930f6 100644 --- a/src/image.c +++ b/src/image.c @@ -2687,6 +2687,7 @@ image_get_dimension (struct image *img, Lisp_Object symbol) } return -1; } +#endif /* Calculate the scale of the image. IMG may be null as it is only required when creating an image, and this function is called from @@ -2742,6 +2743,7 @@ image_compute_scale (struct frame *f, Lisp_Object spec, struct image *img) return scale; } +#if defined HAVE_IMAGEMAGICK || defined HAVE_NATIVE_TRANSFORMS /* Compute the desired size of an image with native size WIDTH x HEIGHT, which is to be displayed on F. Use IMG to deduce the size. Store the desired size into *D_WIDTH x *D_HEIGHT. Store -1 x -1 if the @@ -12676,7 +12678,7 @@ gs_load (struct frame *f, struct image *img) if (NILP (loader)) loader = Qgs_load_image; - img->lisp_data = call6 (loader, frame, img->spec, + img->lisp_data = calln (loader, frame, img->spec, make_fixnum (img->width), make_fixnum (img->height), window_and_pixmap_id, diff --git a/src/insdel.c b/src/insdel.c index 5302d6c213c..8661952bcf3 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -2068,7 +2068,7 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end, : (!NILP (Vselect_active_regions) && !NILP (Vtransient_mark_mode)))) Vsaved_region_selection - = call1 (Vregion_extract_function, Qnil); + = calln (Vregion_extract_function, Qnil); signal_before_change (start, end, preserve_ptr); Fset (Qdeactivate_mark, Qt); diff --git a/src/intervals.c b/src/intervals.c index e81fa9e3a2c..b937c947ab0 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -2052,17 +2052,17 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) enter_after = Qnil; if (! EQ (leave_before, enter_before) && !NILP (leave_before)) - call2 (leave_before, make_fixnum (old_position), + calln (leave_before, make_fixnum (old_position), make_fixnum (charpos)); if (! EQ (leave_after, enter_after) && !NILP (leave_after)) - call2 (leave_after, make_fixnum (old_position), + calln (leave_after, make_fixnum (old_position), make_fixnum (charpos)); if (! EQ (enter_before, leave_before) && !NILP (enter_before)) - call2 (enter_before, make_fixnum (old_position), + calln (enter_before, make_fixnum (old_position), make_fixnum (charpos)); if (! EQ (enter_after, leave_after) && !NILP (enter_after)) - call2 (enter_after, make_fixnum (old_position), + calln (enter_after, make_fixnum (old_position), make_fixnum (charpos)); } } diff --git a/src/keyboard.c b/src/keyboard.c index 11ca9e518a1..ec166e5ac8f 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1050,7 +1050,7 @@ cmd_error_internal (Lisp_Object data, const char *context) /* Use user's specified output function if any. */ if (!NILP (Vcommand_error_function)) - call3 (Vcommand_error_function, data, + calln (Vcommand_error_function, data, context ? build_string (context) : empty_unibyte_string, Vsignaling_function); @@ -1553,7 +1553,7 @@ command_loop_1 (void) update_redisplay_ticks (0, NULL); display_working_on_window_p = false; - call1 (Qcommand_execute, Vthis_command); + calln (Qcommand_execute, Vthis_command); display_working_on_window_p = false; #ifdef HAVE_WINDOW_SYSTEM @@ -1642,11 +1642,11 @@ command_loop_1 (void) Vselection_inhibit_update_commands))) { Lisp_Object txt - = call1 (Vregion_extract_function, Qnil); + = calln (Vregion_extract_function, Qnil); if (XFIXNUM (Flength (txt)) > 0) /* Don't set empty selections. */ - call2 (Qgui_set_selection, QPRIMARY, txt); + calln (Qgui_set_selection, QPRIMARY, txt); CALLN (Frun_hook_with_args, Qpost_select_region_hook, txt); } @@ -2216,7 +2216,7 @@ help_echo_substitute_command_keys (Lisp_Object help) help))) return help; - return call1 (Qsubstitute_command_keys, help); + return calln (Qsubstitute_command_keys, help); } /* Display the help-echo property of the character after the mouse pointer. @@ -2270,7 +2270,7 @@ show_help_echo (Lisp_Object help, Lisp_Object window, Lisp_Object object, restore the mouse_moved flag. */ struct frame *f = some_mouse_moved (); - help = call1 (Qmouse_fixup_help_message, help); + help = calln (Qmouse_fixup_help_message, help); if (f) f->mouse_moved = true; } @@ -2278,7 +2278,7 @@ show_help_echo (Lisp_Object help, Lisp_Object window, Lisp_Object object, if (STRINGP (help) || NILP (help)) { if (!NILP (Vshow_help_function)) - call1 (Vshow_help_function, help_echo_substitute_command_keys (help)); + calln (Vshow_help_function, help_echo_substitute_command_keys (help)); help_echo_showing_p = STRINGP (help); } } @@ -3083,7 +3083,7 @@ read_char (int commandflag, Lisp_Object map, struct buffer *prev_buffer = current_buffer; last_input_event = c; - call4 (Qcommand_execute, tem, Qnil, Fvector (1, &last_input_event), Qt); + calln (Qcommand_execute, tem, Qnil, Fvector (1, &last_input_event), Qt); if (CONSP (c) && !NILP (Fmemq (XCAR (c), Vwhile_no_input_ignore_events)) && !end_time) @@ -3269,7 +3269,7 @@ read_char (int commandflag, Lisp_Object map, } /* Call the input method. */ - tem = call1 (Vinput_method_function, c); + tem = calln (Vinput_method_function, c); tem = unbind_to (count, tem); @@ -4816,7 +4816,7 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers) specbind (Qinhibit_quit, Qt); - call1 (Qtimer_event_handler, chosen_timer); + calln (Qtimer_event_handler, chosen_timer); Vdeactivate_mark = old_deactivate_mark; timers_run++; unbind_to (count, Qnil); @@ -6526,7 +6526,7 @@ make_lispy_event (struct input_event *event) being generated. */ { Lisp_Object edges - = call4 (Qwindow_edges, Fcar (start_pos), Qt, Qnil, Qt); + = calln (Qwindow_edges, Fcar (start_pos), Qt, Qnil, Qt); int new_x = XFIXNUM (Fcar (frame_relative_event_pos)); int new_y = XFIXNUM (Fcdr (frame_relative_event_pos)); @@ -8757,10 +8757,10 @@ parse_menu_item (Lisp_Object item, int inmenubar) /* Create item_properties vector if necessary. */ if (NILP (item_properties)) - item_properties = make_nil_vector (ITEM_PROPERTY_ENABLE + 1); + item_properties = make_nil_vector (ITEM_PROPERTY_MAX + 1); /* Initialize optional entries. */ - for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++) + for (i = ITEM_PROPERTY_DEF; i <= ITEM_PROPERTY_MAX; i++) ASET (item_properties, i, Qnil); ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt); @@ -8946,7 +8946,7 @@ parse_menu_item (Lisp_Object item, int inmenubar) /* The previous code preferred :key-sequence to :keys, so we preserve this behavior. */ if (STRINGP (keyeq) && !CONSP (keyhint)) - keyeq = concat2 (space_space, call1 (Qsubstitute_command_keys, keyeq)); + keyeq = concat2 (space_space, calln (Qsubstitute_command_keys, keyeq)); else { Lisp_Object prefix = keyeq; @@ -10305,7 +10305,7 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt, remapped. */ count = SPECPDL_INDEX (); specbind (Qcurrent_key_remap_sequence, remap); - next = unbind_to (count, call1 (next, prompt)); + next = unbind_to (count, calln (next, prompt)); /* If the function returned something invalid, barf--don't ignore it. */ @@ -12864,10 +12864,10 @@ static const struct event_head head_table[] = { static Lisp_Object init_while_no_input_ignore_events (void) { - Lisp_Object events = listn (9, Qselect_window, Qhelp_echo, Qmove_frame, - Qiconify_frame, Qmake_frame_visible, - Qfocus_in, Qfocus_out, Qconfig_changed_event, - Qselection_request); + Lisp_Object events = list (Qselect_window, Qhelp_echo, Qmove_frame, + Qiconify_frame, Qmake_frame_visible, + Qfocus_in, Qfocus_out, Qconfig_changed_event, + Qselection_request); #ifdef HAVE_DBUS events = Fcons (Qdbus_event, events); diff --git a/src/keyboard.h b/src/keyboard.h index c935d8790f6..38aa5a13b18 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -294,26 +294,31 @@ extern Lisp_Object item_properties; /* This describes the elements of item_properties. The first element is not a property, it is a pointer to the item properties that is saved for GC protection. */ -#define ITEM_PROPERTY_ITEM 0 -/* The item string. */ -#define ITEM_PROPERTY_NAME 1 -/* Start of initialize to nil */ -/* The binding: nil, a command or a keymap. */ -#define ITEM_PROPERTY_DEF 2 -/* The keymap if the binding is a keymap, otherwise nil. */ -#define ITEM_PROPERTY_MAP 3 -/* Nil, :radio or :toggle. */ -#define ITEM_PROPERTY_TYPE 4 -/* Nil or a string describing an equivalent key binding. */ -#define ITEM_PROPERTY_KEYEQ 5 -/* Not nil if a selected toggle box or radio button, otherwise nil. */ -#define ITEM_PROPERTY_SELECTED 6 -/* Place for a help string. Not yet used. */ -#define ITEM_PROPERTY_HELP 7 -/* Start of initialize to t */ -/* Last property. */ -/* Not nil if item is enabled. */ -#define ITEM_PROPERTY_ENABLE 8 +enum item_property_idx +{ + ITEM_PROPERTY_ITEM, + /* The item string. */ + ITEM_PROPERTY_NAME, + /* Start of initialize to nil */ + /* The binding: nil, a command or a keymap. */ + ITEM_PROPERTY_DEF, + /* The keymap if the binding is a keymap, otherwise nil. */ + ITEM_PROPERTY_MAP, + /* Nil, :radio or :toggle. */ + ITEM_PROPERTY_TYPE, + /* Nil or a string describing an equivalent key binding. */ + ITEM_PROPERTY_KEYEQ, + /* Not nil if a selected toggle box or radio button, otherwise nil. */ + ITEM_PROPERTY_SELECTED, + /* Place for a help string. Not yet used. */ + ITEM_PROPERTY_HELP, + /* Start of initialize to t */ + /* Last property. */ + /* Not nil if item is enabled. */ + ITEM_PROPERTY_ENABLE, + /* Keep this equal to the highest member. */ + ITEM_PROPERTY_MAX = ITEM_PROPERTY_ENABLE +}; /* This holds a Lisp vector that holds the results of decoding the keymaps or alist-of-alists that specify a menu. @@ -352,9 +357,12 @@ extern int menu_items_used; excluding those within submenus. */ extern int menu_items_n_panes; -#define MENU_ITEMS_PANE_NAME 1 -#define MENU_ITEMS_PANE_PREFIX 2 -#define MENU_ITEMS_PANE_LENGTH 3 +enum menu_item_pane_idx +{ + MENU_ITEMS_PANE_NAME = 1, + MENU_ITEMS_PANE_PREFIX = 2, + MENU_ITEMS_PANE_LENGTH = 3, +}; enum menu_item_idx { @@ -370,9 +378,9 @@ enum menu_item_idx }; enum - { - KBD_BUFFER_SIZE = 4096 - }; +{ + KBD_BUFFER_SIZE = 4096 +}; extern void unuse_menu_items (void); diff --git a/src/keymap.c b/src/keymap.c index 9ff0b52df72..99291e72b3f 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -579,7 +579,7 @@ map_keymap_internal (Lisp_Object map, static void map_keymap_call (Lisp_Object key, Lisp_Object val, Lisp_Object fun, void *dummy) { - call2 (fun, key, val); + calln (fun, key, val); } /* Same as map_keymap_internal, but traverses parent keymaps as well. @@ -642,7 +642,7 @@ usage: (map-keymap FUNCTION KEYMAP) */) (Lisp_Object function, Lisp_Object keymap, Lisp_Object sort_first) { if (! NILP (sort_first)) - return call2 (Qmap_keymap_sorted, function, keymap); + return calln (Qmap_keymap_sorted, function, keymap); map_keymap (keymap, map_keymap_call, function, NULL, 1); return Qnil; @@ -1069,9 +1069,9 @@ possibly_translate_key_sequence (Lisp_Object key, ptrdiff_t *length) This happens when menu items define as bindings strings that should be inserted into the buffer, not commands. See bug#64927, for example. */ - if (NILP (call1 (Qkey_valid_p, AREF (key, 0)))) + if (NILP (calln (Qkey_valid_p, AREF (key, 0)))) return key; - key = call1 (Qkey_parse, AREF (key, 0)); + key = calln (Qkey_parse, AREF (key, 0)); *length = CHECK_VECTOR_OR_STRING (key); if (*length == 0) xsignal2 (Qerror, build_string ("Invalid `key-parse' syntax: %S"), key); @@ -3035,14 +3035,14 @@ static void describe_vector_princ (Lisp_Object elt, Lisp_Object fun) { Findent_to (make_fixnum (16), make_fixnum (1)); - call1 (fun, elt); + calln (fun, elt); Fterpri (Qnil, Qnil); } static void describe_vector_basic (Lisp_Object elt, Lisp_Object fun) { - call1 (fun, elt); + calln (fun, elt); } DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0, diff --git a/src/lisp.h b/src/lisp.h index 9e57e12fdef..35a589acdc5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2634,7 +2634,7 @@ struct hash_impl; It's unsigned and a subtype of EMACS_UINT. */ typedef unsigned int hash_hash_t; -typedef enum { +typedef enum hash_table_std_test_t { Test_eql, Test_eq, Test_equal, @@ -2658,7 +2658,7 @@ struct hash_table_test Lisp_Object name; }; -typedef enum { +typedef enum hash_table_weakness_t { Weak_None, /* No weak references. */ Weak_Key, /* Reference to key is weak. */ Weak_Value, /* Reference to value is weak. */ @@ -2796,10 +2796,10 @@ struct Lisp_Hash_Table unsigned char index_bits; /* log2 (size of the index vector). */ /* Weakness of the table. */ - hash_table_weakness_t weakness : 3; + ENUM_BF (hash_table_weakness_t) weakness : 3; /* Hash table test (only used when frozen in dump) */ - hash_table_std_test_t frozen_test : 2; + ENUM_BF (hash_table_std_test_t) frozen_test : 2; /* True if the table can be purecopied. The table cannot be changed afterwards. */ @@ -3770,15 +3770,6 @@ enum maxargs 'Finsert (1, &text);'. */ #define CALLN(f, ...) CALLMANY (f, ((Lisp_Object []) {__VA_ARGS__})) #define calln(...) CALLN (Ffuncall, __VA_ARGS__) -/* Compatibility aliases. */ -#define call1 calln -#define call2 calln -#define call3 calln -#define call4 calln -#define call5 calln -#define call6 calln -#define call7 calln -#define call8 calln /* Define 'call0' as a function rather than a CPP macro because we sometimes want to pass it as a first class function. */ @@ -5218,7 +5209,7 @@ extern bool signal_quit_p (Lisp_Object); The calling convention: if (!NILP (Vrun_hooks)) - call1 (Vrun_hooks, Qmy_funny_hook); + calln (Vrun_hooks, Qmy_funny_hook); should no longer be used. */ extern void run_hook (Lisp_Object); diff --git a/src/lread.c b/src/lread.c index 11b015f183c..95ef9fbb628 100644 --- a/src/lread.c +++ b/src/lread.c @@ -525,7 +525,7 @@ unreadchar (Lisp_Object readcharfun, int c) unread_char = c; } else - call1 (readcharfun, make_fixnum (c)); + calln (readcharfun, make_fixnum (c)); } static int @@ -1343,7 +1343,7 @@ Return t if the file exists and loads successfully. */) handler = Ffind_file_name_handler (file, Qload); if (!NILP (handler)) return - call6 (handler, Qload, file, noerror, nomessage, nosuffix, must_suffix); + calln (handler, Qload, file, noerror, nomessage, nosuffix, must_suffix); /* The presence of this call is the result of a historical accident: it used to be in every file-operation and when it got removed @@ -1447,7 +1447,7 @@ Return t if the file exists and loads successfully. */) else handler = Ffind_file_name_handler (found, Qload); if (! NILP (handler)) - return call5 (handler, Qload, found, noerror, nomessage, Qt); + return calln (handler, Qload, found, noerror, nomessage, Qt); #ifdef DOS_NT /* Tramp has to deal with semi-broken packages that prepend drive letters to remote files. For that reason, Tramp @@ -1613,7 +1613,7 @@ Return t if the file exists and loads successfully. */) lread_close (fd); clear_unwind_protect (fd_index); } - val = call4 (Vload_source_file_function, found, hist_file_name, + val = calln (Vload_source_file_function, found, hist_file_name, NILP (noerror) ? Qnil : Qt, (NILP (nomessage) || force_load_messages) ? Qnil : Qt); return unbind_to (count, val); @@ -1740,7 +1740,7 @@ Return t if the file exists and loads successfully. */) /* Run any eval-after-load forms for this file. */ if (!NILP (Ffboundp (Qdo_after_load_evaluation))) - call1 (Qdo_after_load_evaluation, hist_file_name) ; + calln (Qdo_after_load_evaluation, hist_file_name); for (int i = 0; i < ARRAYELTS (saved_strings); i++) { @@ -2080,7 +2080,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, exists = !NILP (Ffile_readable_p (string)); else { - Lisp_Object tmp = call1 (predicate, string); + Lisp_Object tmp = calln (predicate, string); if (NILP (tmp)) exists = false; else if (EQ (tmp, Qdir_ok) @@ -2344,7 +2344,7 @@ readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand) form in the progn as a top-level form. This way, if one form in the progn defines a macro, that macro is in effect when we expand the remaining forms. See similar code in bytecomp.el. */ - val = call2 (macroexpand, val, Qnil); + val = calln (macroexpand, val, Qnil); if (EQ (CAR_SAFE (val), Qprogn)) { Lisp_Object subforms = XCDR (val); @@ -2353,7 +2353,7 @@ readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand) val = readevalloop_eager_expand_eval (XCAR (subforms), macroexpand); } else - val = eval_sub (call2 (macroexpand, val, Qt)); + val = eval_sub (calln (macroexpand, val, Qt)); return val; } @@ -2502,7 +2502,7 @@ readevalloop (Lisp_Object readcharfun, { if (!NILP (readfun)) { - val = call1 (readfun, readcharfun); + val = calln (readfun, readcharfun); /* If READCHARFUN has set point to ZV, we should stop reading, even if the form read sets point @@ -2515,7 +2515,7 @@ readevalloop (Lisp_Object readcharfun, } } else if (! NILP (Vload_read_function)) - val = call1 (Vload_read_function, readcharfun); + val = calln (Vload_read_function, readcharfun); else val = read_internal_start (readcharfun, Qnil, Qnil, false); } @@ -2674,8 +2674,7 @@ STREAM or the value of `standard-input' may be: minibuffer without a stream, as in (read). But is this feature ever used, and if so, why? IOW, will anything break if this feature is removed !? */ - return call1 (Qread_minibuffer, - build_string ("Lisp expression: ")); + return calln (Qread_minibuffer, build_string ("Lisp expression: ")); return read_internal_start (stream, Qnil, Qnil, false); } @@ -2702,8 +2701,7 @@ STREAM or the value of `standard-input' may be: stream = Qread_char; if (EQ (stream, Qread_char)) /* FIXME: ?! When is this used !? */ - return call1 (Qread_minibuffer, - build_string ("Lisp expression: ")); + return calln (Qread_minibuffer, build_string ("Lisp expression: ")); return read_internal_start (stream, Qnil, Qnil, true); } @@ -2812,7 +2810,7 @@ character_name_to_code (char const *name, ptrdiff_t name_len, Lisp_Object code = (name[0] == 'U' && name[1] == '+' ? string_to_number (name + 1, 16, &len) - : call2 (Qchar_from_name, make_unibyte_string (name, name_len), Qt)); + : calln (Qchar_from_name, make_unibyte_string (name, name_len), Qt)); if (! RANGED_FIXNUMP (0, code, MAX_UNICODE_CHAR) || len != name_len - 1 @@ -5378,7 +5376,7 @@ map_obarray (Lisp_Object obarray, static void mapatoms_1 (Lisp_Object sym, Lisp_Object function) { - call1 (function, sym); + calln (function, sym); } DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0, diff --git a/src/minibuf.c b/src/minibuf.c index b74e5221420..455d2f2b62d 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -166,8 +166,8 @@ zip_minibuffer_stacks (Lisp_Object dest_window, Lisp_Object source_window) return; } - call1 (Qrecord_window_buffer, dest_window); - call1 (Qrecord_window_buffer, source_window); + calln (Qrecord_window_buffer, dest_window); + calln (Qrecord_window_buffer, source_window); acc = merge_c (dw->prev_buffers, sw->prev_buffers, minibuffer_ent_greater); @@ -494,7 +494,7 @@ confirm the aborting of the current minibuffer and all contained ones. */) to abort any extra non-minibuffer recursive edits. Thus, the number of recursive edits we have to abort equals the number of minibuffers we have to abort. */ - call1 (Qminibuffer_quit_recursive_edit, array[1]); + calln (Qminibuffer_quit_recursive_edit, array[1]); } } else @@ -689,7 +689,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, } MB_frame = XWINDOW (XFRAME (selected_frame)->minibuffer_window)->frame; - call1 (Qrecord_window_buffer, minibuf_window); + calln (Qrecord_window_buffer, minibuf_window); record_unwind_protect_void (minibuffer_unwind); if (read_minibuffer_restore_windows) @@ -895,7 +895,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* Turn on an input method stored in INPUT_METHOD if any. */ if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method))) - call1 (Qactivate_input_method, input_method); + calln (Qactivate_input_method, input_method); run_hook (Qminibuffer_setup_hook); @@ -964,13 +964,13 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, && !EQ (XWINDOW (XFRAME (calling_frame)->minibuffer_window) ->frame, calling_frame)))) - call2 (Qselect_frame_set_input_focus, calling_frame, Qnil); + calln (Qselect_frame_set_input_focus, calling_frame, Qnil); /* Add the value to the appropriate history list, if any. This is done after the previous buffer has been made current again, in case the history variable is buffer-local. */ if (! (NILP (Vhistory_add_new_input) || NILP (histstring))) - call2 (Qadd_to_history, histvar, histstring); + calln (Qadd_to_history, histvar, histstring); /* If Lisp form desired instead of string, parse it. */ if (expflag) @@ -1565,8 +1565,8 @@ function, instead of the usual behavior. */) result = (NILP (predicate) /* Partial backward compatibility for older read_buffer_functions which don't expect a `predicate' argument. */ - ? call3 (Vread_buffer_function, prompt, def, require_match) - : call4 (Vread_buffer_function, prompt, def, require_match, + ? calln (Vread_buffer_function, prompt, def, require_match) + : calln (Vread_buffer_function, prompt, def, require_match, predicate)); return unbind_to (count, result); } @@ -1656,7 +1656,7 @@ or from one of the possible completions. */) CHECK_STRING (string); if (type == function_table) - return call3 (collection, string, predicate, Qnil); + return calln (collection, string, predicate, Qnil); bestmatch = bucket = Qnil; zero = make_fixnum (0); @@ -1729,11 +1729,11 @@ or from one of the possible completions. */) else { if (type == hash_table) - tem = call2 (predicate, elt, + tem = calln (predicate, elt, HASH_VALUE (XHASH_TABLE (collection), idx - 1)); else - tem = call1 (predicate, elt); + tem = calln (predicate, elt); } if (NILP (tem)) continue; } @@ -1880,7 +1880,7 @@ which case that function should itself handle `completion-regexp-list'). */) CHECK_STRING (string); if (type == 0) - return call3 (collection, string, predicate, Qt); + return calln (collection, string, predicate, Qt); allmatches = bucket = Qnil; zero = make_fixnum (0); @@ -1953,11 +1953,11 @@ which case that function should itself handle `completion-regexp-list'). */) else { if (type == 3) - tem = call2 (predicate, elt, + tem = calln (predicate, elt, HASH_VALUE (XHASH_TABLE (collection), idx - 1)); else - tem = call1 (predicate, elt); + tem = calln (predicate, elt); } if (NILP (tem)) continue; } @@ -2121,7 +2121,7 @@ the values STRING, PREDICATE and `lambda'. */) found_matching_key: ; } else - return call3 (collection, string, predicate, Qlambda); + return calln (collection, string, predicate, Qlambda); /* Reject this element if it fails to match all the regexps. */ if (!match_regexps (string, Vcompletion_regexp_list, @@ -2132,8 +2132,8 @@ the values STRING, PREDICATE and `lambda'. */) if (!NILP (predicate)) { return HASH_TABLE_P (collection) - ? call2 (predicate, tem, arg) - : call1 (predicate, tem); + ? calln (predicate, tem, arg) + : calln (predicate, tem); } else return Qt; diff --git a/src/msdos.c b/src/msdos.c index 6ee35b9e853..63a5400bc7d 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -2069,7 +2069,7 @@ dos_set_keyboard (int code, int always) keyboard_map_all = always; dos_keyboard_layout = 1; - for (i = 0; i < (sizeof (keyboard_layout_list)/sizeof (struct keyboard_layout_list)); i++) + for (i = 0; i < ARRAYELTS (keyboard_layout_list); i++) if (code == keyboard_layout_list[i].country_code) { keyboard = keyboard_layout_list[i].keyboard_map; @@ -2512,7 +2512,7 @@ dos_rawgetc (void) one. */ if (code == -1) { - if (sc >= (sizeof (ibmpc_translate_map) / sizeof (short))) + if (sc >= ARRAYELTS (ibmpc_translate_map)) continue; if ((code = ibmpc_translate_map[sc]) == Ignore) continue; diff --git a/src/nsfns.m b/src/nsfns.m index 1867d747658..79a3b39e6eb 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -2518,7 +2518,7 @@ DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash, handler = Ffind_file_name_handler (filename, operation); if (!NILP (handler)) - return call2 (handler, operation, filename); + return calln (handler, operation, filename); else { NSFileManager *fm = [NSFileManager defaultManager]; @@ -3145,7 +3145,7 @@ ns_create_tip_frame (struct ns_display_info *dpyinfo, Lisp_Object parms) { Lisp_Object bg = Fframe_parameter (frame, Qbackground_color); - call2 (Qface_set_after_frame_default, frame, Qnil); + calln (Qface_set_after_frame_default, frame, Qnil); if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) { @@ -3184,7 +3184,7 @@ x_hide_tip (bool delete) { if (!NILP (tip_timer)) { - call1 (Qcancel_timer, tip_timer); + calln (Qcancel_timer, tip_timer); tip_timer = Qnil; } @@ -3335,7 +3335,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, tip_f = XFRAME (tip_frame); if (!NILP (tip_timer)) { - call1 (Qcancel_timer, tip_timer); + calln (Qcancel_timer, tip_timer); tip_timer = Qnil; } @@ -3383,11 +3383,11 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, } else tip_last_parms - = call2 (Qassq_delete_all, parm, tip_last_parms); + = calln (Qassq_delete_all, parm, tip_last_parms); } else tip_last_parms - = call2 (Qassq_delete_all, parm, tip_last_parms); + = calln (Qassq_delete_all, parm, tip_last_parms); } /* Now check if every parameter in what is left of @@ -3549,8 +3549,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, start_timer: /* Let the tip disappear after timeout seconds. */ - tip_timer = call3 (Qrun_at_time, timeout, Qnil, - Qx_hide_tip); + tip_timer = calln (Qrun_at_time, timeout, Qnil, Qx_hide_tip); } return unbind_to (count, Qnil); diff --git a/src/nsselect.m b/src/nsselect.m index 4b5fe6770c2..8220ccd9566 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -439,7 +439,7 @@ anything that the functions on `selection-converter-alist' know about. */) { /* FIXME: Use run-hook-with-args! */ for (rest = Vns_sent_selection_hooks; CONSP (rest); rest = Fcdr (rest)) - call3 (Fcar (rest), selection, target_symbol, successful_p); + calln (Fcar (rest), selection, target_symbol, successful_p); } return value; diff --git a/src/pgtkfns.c b/src/pgtkfns.c index 4becb5492ac..9251e137f09 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -2849,7 +2849,7 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct { Lisp_Object bg = Fframe_parameter (frame, Qbackground_color); - call2 (Qface_set_after_frame_default, frame, Qnil); + calln (Qface_set_after_frame_default, frame, Qnil); if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) { @@ -2996,7 +2996,7 @@ pgtk_hide_tip (bool delete) { if (!NILP (tip_timer)) { - call1 (Qcancel_timer, tip_timer); + calln (Qcancel_timer, tip_timer); tip_timer = Qnil; } @@ -3175,7 +3175,7 @@ Text larger than the specified size is clipped. */) tip_f = XFRAME (tip_frame); if (!NILP (tip_timer)) { - call1 (Qcancel_timer, tip_timer); + calln (Qcancel_timer, tip_timer); tip_timer = Qnil; } @@ -3213,11 +3213,11 @@ Text larger than the specified size is clipped. */) } else tip_last_parms = - call2 (Qassq_delete_all, parm, tip_last_parms); + calln (Qassq_delete_all, parm, tip_last_parms); } else tip_last_parms = - call2 (Qassq_delete_all, parm, tip_last_parms); + calln (Qassq_delete_all, parm, tip_last_parms); } /* Now check if every parameter in what is left of @@ -3376,7 +3376,7 @@ Text larger than the specified size is clipped. */) start_timer: /* Let the tip disappear after timeout seconds. */ - tip_timer = call3 (Qrun_at_time, timeout, Qnil, Qx_hide_tip); + tip_timer = calln (Qrun_at_time, timeout, Qnil, Qx_hide_tip); return unbind_to (count, Qnil); } diff --git a/src/pgtkselect.c b/src/pgtkselect.c index f1a9214a6b4..c05594d7366 100644 --- a/src/pgtkselect.c +++ b/src/pgtkselect.c @@ -266,10 +266,8 @@ pgtk_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, } if (!NILP (handler_fn)) - value = call3 (handler_fn, selection_symbol, - (local_request - ? Qnil - : target_type), + value = calln (handler_fn, selection_symbol, + (local_request ? Qnil : target_type), tem); else value = Qnil; diff --git a/src/print.c b/src/print.c index 696d807a340..94d1fe11f96 100644 --- a/src/print.c +++ b/src/print.c @@ -307,7 +307,7 @@ static void printchar (unsigned int ch, Lisp_Object fun) { if (!NILP (fun) && !EQ (fun, Qt)) - call1 (fun, make_fixnum (ch)); + calln (fun, make_fixnum (ch)); else { unsigned char str[MAX_MULTIBYTE_LENGTH]; diff --git a/src/process.c b/src/process.c index 0360d721de6..98a85d12c97 100644 --- a/src/process.c +++ b/src/process.c @@ -3368,7 +3368,7 @@ finish_after_tls_connection (Lisp_Object proc) Lisp_Object result = Qt; if (!NILP (Ffboundp (Qnsm_verify_connection))) - result = call3 (Qnsm_verify_connection, + result = calln (Qnsm_verify_connection, proc, plist_get (contact, QChost), plist_get (contact, QCservice)); @@ -4964,7 +4964,7 @@ server_accept_connection (Lisp_Object server, int channel) { int code = errno; if (!would_block (code) && !NILP (ps->log)) - call3 (ps->log, server, Qnil, + calln (ps->log, server, Qnil, concat3 (build_string ("accept failed with code"), Fnumber_to_string (make_fixnum (code)), build_string ("\n"))); @@ -5126,7 +5126,7 @@ server_accept_connection (Lisp_Object server, int channel) if (!NILP (ps->log)) { AUTO_STRING (accept_from, "accept from "); - call3 (ps->log, server, proc, concat3 (accept_from, host_string, nl)); + calln (ps->log, server, proc, concat3 (accept_from, host_string, nl)); } AUTO_STRING (open_from, "open from "); @@ -8471,7 +8471,7 @@ See `process-attributes' for getting attributes of a process given its ID. */) = Ffind_file_name_handler (BVAR (current_buffer, directory), Qlist_system_processes); if (!NILP (handler)) - return call1 (handler, Qlist_system_processes); + return calln (handler, Qlist_system_processes); return list_system_processes (); } @@ -8535,7 +8535,7 @@ integer or floating point values. = Ffind_file_name_handler (BVAR (current_buffer, directory), Qprocess_attributes); if (!NILP (handler)) - return call2 (handler, Qprocess_attributes, pid); + return calln (handler, Qprocess_attributes, pid); return system_process_attributes (pid); } diff --git a/src/sort.c b/src/sort.c index 1f957ade2e3..c904f911703 100644 --- a/src/sort.c +++ b/src/sort.c @@ -199,7 +199,7 @@ typedef struct merge_state static bool order_pred_lisp (merge_state *ms, Lisp_Object a, Lisp_Object b) { - return !NILP (call2 (ms->predicate, a, b)); + return !NILP (calln (ms->predicate, a, b)); } static bool @@ -1151,7 +1151,7 @@ tim_sort (Lisp_Object predicate, Lisp_Object keyfunc, (any call to keyfunc might trigger a GC). */ if (!NILP (keyfunc)) for (ptrdiff_t i = 0; i < length; i++) - keys[i] = call1 (keyfunc, seq[i]); + keys[i] = calln (keyfunc, seq[i]); /* FIXME: This is where we would check the keys for interesting properties for more optimized comparison (such as all being fixnums diff --git a/src/syntax.c b/src/syntax.c index 0b68fed648a..6ffa8a94c7f 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -585,7 +585,7 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte) if (!NILP (Vcomment_use_syntax_ppss)) { modiff_count modiffs = CHARS_MODIFF; - Lisp_Object ppss = call1 (Qsyntax_ppss, make_fixnum (pos)); + Lisp_Object ppss = calln (Qsyntax_ppss, make_fixnum (pos)); if (modiffs != CHARS_MODIFF) error ("syntax-ppss modified the buffer!"); TEMP_SET_PT_BOTH (opoint, opoint_byte); @@ -1430,7 +1430,7 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, { AUTO_STRING (prefixdoc, ",\n\t is a prefix character for `backward-prefix-chars'"); - insert1 (call1 (Qsubstitute_command_keys, prefixdoc)); + insert1 (calln (Qsubstitute_command_keys, prefixdoc)); } return syntax; @@ -1474,7 +1474,7 @@ scan_words (ptrdiff_t from, EMACS_INT count) func = CHAR_TABLE_REF (Vfind_word_boundary_function_table, ch0); if (! NILP (Ffboundp (func))) { - pos = call2 (func, make_fixnum (from - 1), make_fixnum (end)); + pos = calln (func, make_fixnum (from - 1), make_fixnum (end)); if (FIXNUMP (pos) && from < XFIXNUM (pos) && XFIXNUM (pos) <= ZV) { from = XFIXNUM (pos); @@ -1523,7 +1523,7 @@ scan_words (ptrdiff_t from, EMACS_INT count) func = CHAR_TABLE_REF (Vfind_word_boundary_function_table, ch1); if (! NILP (Ffboundp (func))) { - pos = call2 (func, make_fixnum (from), make_fixnum (beg)); + pos = calln (func, make_fixnum (from), make_fixnum (beg)); if (FIXNUMP (pos) && BEGV <= XFIXNUM (pos) && XFIXNUM (pos) < from) { from = XFIXNUM (pos); diff --git a/src/sysdep.c b/src/sysdep.c index 188b3c3958a..3d9c49d9280 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3160,7 +3160,7 @@ static const struct speed_struct speeds[] = static speed_t convert_speed (speed_t speed) { - for (size_t i = 0; i < sizeof speeds / sizeof speeds[0]; i++) + for (size_t i = 0; i < ARRAYELTS (speeds); i++) { if (speed == speeds[i].internal) return speed; @@ -3380,7 +3380,7 @@ list_system_processes (void) int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_PROC}; #endif size_t len; - size_t mibsize = sizeof mib / sizeof mib[0]; + size_t mibsize = ARRAYELTS (mib); struct kinfo_proc *procs; size_t i; diff --git a/src/textconv.c b/src/textconv.c index 80b1a37f0fd..105a8077072 100644 --- a/src/textconv.c +++ b/src/textconv.c @@ -1308,7 +1308,7 @@ really_set_point_and_mark (struct frame *f, ptrdiff_t point, && !NILP (BVAR (current_buffer, mark_active))) call0 (Qdeactivate_mark); else - call1 (Qpush_mark, make_fixnum (mark)); + calln (Qpush_mark, make_fixnum (mark)); /* Update the ephemeral last point. */ w = XWINDOW (selected_window); diff --git a/src/textprop.c b/src/textprop.c index 1803f2d1cb0..30c26ce4809 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -2167,7 +2167,7 @@ call_mod_hooks (Lisp_Object list, Lisp_Object start, Lisp_Object end) { while (!NILP (list)) { - call2 (Fcar (list), start, end); + calln (Fcar (list), start, end); list = Fcdr (list); } } diff --git a/src/treesit.c b/src/treesit.c index 0d878a580eb..2f06de67ad8 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -1946,7 +1946,10 @@ which the parser should operate. Regions must not overlap, and the regions should come in order in the list. Signal `treesit-set-range-error' if the argument is invalid, or something else went wrong. If RANGES is nil, the PARSER is to parse the whole -buffer. */) +buffer. + +DO NOT modify RANGES after passing it to this function, as RANGES is +saved to PARSER internally. */) (Lisp_Object parser, Lisp_Object ranges) { treesit_check_parser (parser); @@ -3081,6 +3084,9 @@ You can use `treesit-query-validate' to validate and debug a query. */) wrong_type_argument (Qtreesit_query_p, query); CHECK_SYMBOL (language); + Lisp_Object remapped_lang = resolve_language_symbol (language); + CHECK_SYMBOL (remapped_lang); + treesit_initialize (); if (TS_COMPILED_QUERY_P (query)) @@ -3091,7 +3097,7 @@ You can use `treesit-query-validate' to validate and debug a query. */) return query; } - Lisp_Object lisp_query = make_treesit_query (query, language); + Lisp_Object lisp_query = make_treesit_query (query, remapped_lang); /* Maybe actually compile. */ if (NILP (eager)) diff --git a/src/undo.c b/src/undo.c index 42aca6b2d54..1a91aca01aa 100644 --- a/src/undo.c +++ b/src/undo.c @@ -363,7 +363,7 @@ truncate_undo_list (struct buffer *b) Lisp_Object tem; /* Normally the function this calls is undo-outer-limit-truncate. */ - tem = call1 (Vundo_outer_limit_function, make_int (size_so_far)); + tem = calln (Vundo_outer_limit_function, make_int (size_so_far)); if (! NILP (tem)) { /* The function is responsible for making diff --git a/src/w32fns.c b/src/w32fns.c index c7963d2c616..c2551ea2378 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -4154,7 +4154,7 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam, windows_msg.time = GetMessageTime (); TranslateMessage (&windows_msg); } - count = get_wm_chars (hwnd, buf, sizeof (buf)/sizeof (*buf), 1, + count = get_wm_chars (hwnd, buf, ARRAYELTS (buf), 1, /* The message may have been synthesized by who knows what; be conservative. */ modifier_set (VK_LCONTROL) @@ -7574,7 +7574,7 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) Lisp_Object fg = Fframe_parameter (frame, Qforeground_color); Lisp_Object colors = Qnil; - call2 (Qface_set_after_frame_default, frame, Qnil); + calln (Qface_set_after_frame_default, frame, Qnil); if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) colors = Fcons (Fcons (Qbackground_color, bg), colors); @@ -7723,7 +7723,7 @@ w32_hide_tip (bool delete) { if (!NILP (tip_timer)) { - call1 (Qcancel_timer, tip_timer); + calln (Qcancel_timer, tip_timer); tip_timer = Qnil; } @@ -7816,7 +7816,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, Lisp_Object timer = tip_timer; tip_timer = Qnil; - call1 (Qcancel_timer, timer); + calln (Qcancel_timer, timer); } block_input (); @@ -7867,11 +7867,11 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, } else tip_last_parms = - call2 (Qassq_delete_all, parm, tip_last_parms); + calln (Qassq_delete_all, parm, tip_last_parms); } else tip_last_parms = - call2 (Qassq_delete_all, parm, tip_last_parms); + calln (Qassq_delete_all, parm, tip_last_parms); } /* Now check if there's a parameter left in tip_last_parms with a @@ -8053,8 +8053,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, start_timer: /* Let the tip disappear after timeout seconds. */ - tip_timer = call3 (Qrun_at_time, timeout, Qnil, - Qx_hide_tip); + tip_timer = calln (Qrun_at_time, timeout, Qnil, Qx_hide_tip); return unbind_to (count, Qnil); } @@ -8379,8 +8378,7 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, file_details_w->lStructSize = sizeof (*file_details_w); /* Set up the inout parameter for the selected file name. */ file_details_w->lpstrFile = filename_buf_w; - file_details_w->nMaxFile = - sizeof (filename_buf_w) / sizeof (*filename_buf_w); + file_details_w->nMaxFile = ARRAYELTS (filename_buf_w); file_details_w->hwndOwner = FRAME_W32_WINDOW (f); /* Undocumented Bug in Common File Dialog: If a filter is not specified, shell links are not resolved. */ @@ -8413,8 +8411,7 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, else file_details_a->lStructSize = sizeof (*file_details_a); file_details_a->lpstrFile = filename_buf_a; - file_details_a->nMaxFile = - sizeof (filename_buf_a) / sizeof (*filename_buf_a); + file_details_a->nMaxFile = ARRAYELTS (filename_buf_a); file_details_a->hwndOwner = FRAME_W32_WINDOW (f); file_details_a->lpstrFilter = filter_a; file_details_a->lpstrInitialDir = dir_a; @@ -8541,7 +8538,7 @@ DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash, handler = Ffind_file_name_handler (filename, operation); if (!NILP (handler)) - return call2 (handler, operation, filename); + return calln (handler, operation, filename); else { const char * path; @@ -9729,7 +9726,7 @@ DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0, Lisp_Object handler = Ffind_file_name_handler (encoded, Qfile_system_info); if (!NILP (handler)) { - value = call2 (handler, Qfile_system_info, encoded); + value = calln (handler, Qfile_system_info, encoded); if (CONSP (value) || NILP (value)) return value; error ("Invalid handler in `file-name-handler-alist'"); diff --git a/src/w32term.c b/src/w32term.c index df9f90076c0..1e973b9f2e5 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -276,7 +276,7 @@ int event_record_index; record_event (char *locus, int type) { - if (event_record_index == sizeof (event_record) / sizeof (struct record)) + if (event_record_index == ARRAYELTS (event_record)) event_record_index = 0; event_record[event_record_index].locus = locus; @@ -5259,7 +5259,7 @@ w32_read_socket (struct terminal *terminal, hlinfo->mouse_face_hidden = true; } - if (temp_index == sizeof temp_buffer / sizeof (short)) + if (temp_index == ARRAYELTS (temp_buffer)) temp_index = 0; temp_buffer[temp_index++] = msg.msg.wParam; inev.kind = NON_ASCII_KEYSTROKE_EVENT; @@ -5285,7 +5285,7 @@ w32_read_socket (struct terminal *terminal, hlinfo->mouse_face_hidden = true; } - if (temp_index == sizeof temp_buffer / sizeof (short)) + if (temp_index == ARRAYELTS (temp_buffer)) temp_index = 0; temp_buffer[temp_index++] = msg.msg.wParam; @@ -5400,7 +5400,7 @@ w32_read_socket (struct terminal *terminal, hlinfo->mouse_face_hidden = true; } - if (temp_index == sizeof temp_buffer / sizeof (short)) + if (temp_index == ARRAYELTS (temp_buffer)) temp_index = 0; temp_buffer[temp_index++] = msg.msg.wParam; inev.kind = MULTIMEDIA_KEY_EVENT; diff --git a/src/window.c b/src/window.c index 5cb2fe1c1a1..e9a8d3e1a9a 100644 --- a/src/window.c +++ b/src/window.c @@ -2676,8 +2676,8 @@ recombine_windows (Lisp_Object window) static void delete_deletable_window (Lisp_Object window) { - if (!NILP (call1 (Qwindow_deletable_p, window))) - call1 (Qdelete_window, window); + if (!NILP (calln (Qwindow_deletable_p, window))) + calln (Qdelete_window, window); } /*********************************************************************** @@ -3342,7 +3342,7 @@ resize_root_window (Lisp_Object window, Lisp_Object delta, Lisp_Object horizontal, Lisp_Object ignore, Lisp_Object pixelwise) { - return call5 (Qwindow__resize_root_window, window, delta, + return calln (Qwindow__resize_root_window, window, delta, horizontal, ignore, pixelwise); } @@ -3350,7 +3350,7 @@ resize_root_window (Lisp_Object window, Lisp_Object delta, static Lisp_Object window_pixel_to_total (Lisp_Object frame, Lisp_Object horizontal) { - return call2 (Qwindow__pixel_to_total, frame, horizontal); + return calln (Qwindow__pixel_to_total, frame, horizontal); } @@ -3729,7 +3729,7 @@ replace_buffer_in_windows (Lisp_Object buffer) /* When kill-buffer is called early during loadup, this function is undefined. */ if (!NILP (Ffboundp (Qreplace_buffer_in_windows))) - call1 (Qreplace_buffer_in_windows, buffer); + calln (Qreplace_buffer_in_windows, buffer); } /** If BUFFER is shown in any window, safely replace it with some other @@ -4454,7 +4454,7 @@ This function runs `window-scroll-functions' before running dedication. */ wset_dedicated (w, Qnil); - call1 (Qrecord_window_buffer, window); + calln (Qrecord_window_buffer, window); } unshow_buffer (w); @@ -4468,7 +4468,7 @@ This function runs `window-scroll-functions' before running static Lisp_Object display_buffer (Lisp_Object buffer, Lisp_Object not_this_window_p, Lisp_Object override_frame) { - return call3 (Qdisplay_buffer, buffer, not_this_window_p, override_frame); + return calln (Qdisplay_buffer, buffer, not_this_window_p, override_frame); } DEFUN ("force-window-update", Fforce_window_update, Sforce_window_update, @@ -4532,7 +4532,7 @@ temp_output_buffer_show (register Lisp_Object buf) set_buffer_internal (old); if (!NILP (Vtemp_buffer_show_function)) - call1 (Vtemp_buffer_show_function, buf); + calln (Vtemp_buffer_show_function, buf); else if (WINDOW_LIVE_P (window = display_buffer (buf, Qnil, Qnil))) { if (!EQ (XWINDOW (window)->frame, selected_frame)) @@ -5663,7 +5663,7 @@ grow_mini_window (struct window *w, int delta) struct window *r = XWINDOW (root); Lisp_Object grow; - grow = call3 (Qwindow__resize_root_window_vertically, + grow = calln (Qwindow__resize_root_window_vertically, root, make_fixnum (- delta), Qt); if (FIXNUMP (grow) @@ -5701,7 +5701,7 @@ shrink_mini_window (struct window *w) struct window *r = XWINDOW (root); Lisp_Object grow; - grow = call3 (Qwindow__resize_root_window_vertically, + grow = calln (Qwindow__resize_root_window_vertically, root, make_fixnum (delta), Qt); if (FIXNUMP (grow) && window_resize_check (r, false)) @@ -7512,7 +7512,7 @@ the return value is nil. Otherwise the value is t. */) && (NILP (Fminibufferp (p->buffer, Qnil)))) /* If a window we restore gets another buffer, record the window's old buffer. */ - call1 (Qrecord_window_buffer, window); + calln (Qrecord_window_buffer, window); } /* Disallow set_window_size_hook, temporarily. */ @@ -7683,10 +7683,10 @@ the return value is nil. Otherwise the value is t. */) w->start_at_line_beg = true; if (FUNCTIONP (window_restore_killed_buffer_windows) && !MINI_WINDOW_P (w)) - kept_windows = Fcons (listn (6, window, p->buffer, - Fmarker_last_position (p->start), - Fmarker_last_position (p->pointm), - p->dedicated, Qt), + kept_windows = Fcons (list (window, p->buffer, + Fmarker_last_position (p->start), + Fmarker_last_position (p->pointm), + p->dedicated, Qt), kept_windows); } else if (!NILP (w->start)) @@ -7708,10 +7708,10 @@ the return value is nil. Otherwise the value is t. */) { if (FUNCTIONP (window_restore_killed_buffer_windows)) kept_windows - = Fcons (listn (6, window, p->buffer, - Fmarker_last_position (p->start), - Fmarker_last_position (p->pointm), - p->dedicated, Qnil), + = Fcons (list (window, p->buffer, + Fmarker_last_position (p->start), + Fmarker_last_position (p->pointm), + p->dedicated, Qnil), kept_windows); else if (EQ (window_restore_killed_buffer_windows, Qdelete) || (!NILP (p->dedicated) diff --git a/src/xfaces.c b/src/xfaces.c index 2464a6d6588..24577962830 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1083,7 +1083,7 @@ tty_lookup_color (struct frame *f, Lisp_Object color, Emacs_Color *tty_color, XSETFRAME (frame, f); - color_desc = call2 (Qtty_color_desc, color, frame); + color_desc = calln (Qtty_color_desc, color, frame); if (CONSP (color_desc) && CONSP (XCDR (color_desc))) { Lisp_Object rgb; @@ -1112,7 +1112,7 @@ tty_lookup_color (struct frame *f, Lisp_Object color, Emacs_Color *tty_color, && !NILP (Ffboundp (Qtty_color_standard_values))) { /* Look up STD_COLOR separately. */ - rgb = call1 (Qtty_color_standard_values, color); + rgb = calln (Qtty_color_standard_values, color); if (! parse_rgb_list (rgb, std_color)) return false; } @@ -1174,7 +1174,7 @@ tty_color_name (struct frame *f, int idx) Lisp_Object coldesc; XSETFRAME (frame, f); - coldesc = call2 (Qtty_color_by_index, make_fixnum (idx), frame); + coldesc = calln (Qtty_color_by_index, make_fixnum (idx), frame); if (!NILP (coldesc)) return XCAR (coldesc); @@ -3830,7 +3830,7 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param, mode, so that we have to load new defface specs. Call frame-set-background-mode to do that. */ XSETFRAME (frame, f); - call1 (Qframe_set_background_mode, frame); + calln (Qframe_set_background_mode, frame); face = Qdefault; lface = lface_from_face_name (f, face, true); @@ -4765,7 +4765,7 @@ the triangle inequality. */) if (NILP (metric)) return make_fixnum (color_distance (&cdef1, &cdef2)); else - return call2 (metric, + return calln (metric, list3i (cdef1.red, cdef1.green, cdef1.blue), list3i (cdef2.red, cdef2.green, cdef2.blue)); } @@ -6594,7 +6594,7 @@ map_tty_color (struct frame *f, struct face *face, Lisp_Object color, if (STRINGP (color) && SCHARS (color) && CONSP (Vtty_defined_color_alist) - && (def = assoc_no_quit (color, call1 (Qtty_color_alist, frame)), + && (def = assoc_no_quit (color, calln (Qtty_color_alist, frame)), CONSP (def))) { /* Associations in tty-defined-color-alist are of the form diff --git a/src/xfns.c b/src/xfns.c index c0777c93258..c70e51c7205 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -8681,7 +8681,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) { Lisp_Object bg = Fframe_parameter (frame, Qbackground_color); - call2 (Qface_set_after_frame_default, frame, Qnil); + calln (Qface_set_after_frame_default, frame, Qnil); if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) { @@ -8853,7 +8853,7 @@ x_hide_tip (bool delete) { if (!NILP (tip_timer)) { - call1 (Qcancel_timer, tip_timer); + calln (Qcancel_timer, tip_timer); tip_timer = Qnil; } @@ -9080,7 +9080,7 @@ Text larger than the specified size is clipped. */) tip_f = XFRAME (tip_frame); if (!NILP (tip_timer)) { - call1 (Qcancel_timer, tip_timer); + calln (Qcancel_timer, tip_timer); tip_timer = Qnil; } @@ -9119,11 +9119,11 @@ Text larger than the specified size is clipped. */) } else tip_last_parms = - call2 (Qassq_delete_all, parm, tip_last_parms); + calln (Qassq_delete_all, parm, tip_last_parms); } else tip_last_parms = - call2 (Qassq_delete_all, parm, tip_last_parms); + calln (Qassq_delete_all, parm, tip_last_parms); } /* Now check if every parameter in what is left of @@ -9305,8 +9305,7 @@ Text larger than the specified size is clipped. */) start_timer: /* Let the tip disappear after timeout seconds. */ - tip_timer = call3 (Qrun_at_time, timeout, Qnil, - Qx_hide_tip); + tip_timer = calln (Qrun_at_time, timeout, Qnil, Qx_hide_tip); return unbind_to (count, Qnil); } diff --git a/src/xmenu.c b/src/xmenu.c index 13989f5a18c..8936e668b15 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1431,7 +1431,7 @@ menu_position_func (GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer #endif /* TODO: Get the monitor workarea directly without calculating other items in x-display-monitor-attributes-list. */ - workarea = call3 (Qframe_monitor_workarea, + workarea = calln (Qframe_monitor_workarea, Qnil, make_fixnum (data->x), make_fixnum (data->y)); diff --git a/src/xselect.c b/src/xselect.c index 0e932c6cce1..bfd5de9598b 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -396,7 +396,7 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, } if (!NILP (handler_fn)) - value = call3 (handler_fn, selection_symbol, + value = calln (handler_fn, selection_symbol, ((local_request && NILP (Vx_treat_local_requests_remotely)) ? Qnil diff --git a/src/xterm.c b/src/xterm.c index 9fc56ce95da..ada7fbc2e41 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -4124,10 +4124,10 @@ x_dnd_send_unsupported_drop (struct x_display_info *dpyinfo, Window target_windo x_dnd_unsupported_drop_time = before; x_dnd_unsupported_drop_window = target_window; x_dnd_unsupported_drop_data - = listn (5, assq_no_quit (QXdndSelection, - dpyinfo->terminal->Vselection_alist), - targets, arg, make_fixnum (root_x), - make_fixnum (root_y)); + = list (assq_no_quit (QXdndSelection, + dpyinfo->terminal->Vselection_alist), + targets, arg, make_fixnum (root_x), + make_fixnum (root_y)); x_dnd_waiting_for_finish = true; x_dnd_finish_display = dpyinfo->display; @@ -13103,7 +13103,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, ref = SPECPDL_INDEX (); record_unwind_protect_ptr (x_dnd_cleanup_drag_and_drop, f); - call2 (Vx_dnd_movement_function, frame_object, + calln (Vx_dnd_movement_function, frame_object, Fposn_at_x_y (x, y, frame_object, Qnil)); x_dnd_unwind_flag = false; unbind_to (ref, Qnil); @@ -13137,7 +13137,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, ref = SPECPDL_INDEX (); record_unwind_protect_ptr (x_dnd_cleanup_drag_and_drop, f); - call4 (Vx_dnd_wheel_function, + calln (Vx_dnd_wheel_function, Fposn_at_x_y (x, y, frame_object, Qnil), make_fixnum (x_dnd_wheel_button), make_uint (x_dnd_wheel_state), @@ -13206,7 +13206,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, record_unwind_protect_ptr (x_dnd_cleanup_drag_and_drop, f); if (!NILP (Vx_dnd_unsupported_drop_function)) - val = call8 (Vx_dnd_unsupported_drop_function, + val = calln (Vx_dnd_unsupported_drop_function, XCAR (XCDR (x_dnd_unsupported_drop_data)), Fnth (make_fixnum (3), x_dnd_unsupported_drop_data), Fnth (make_fixnum (4), x_dnd_unsupported_drop_data), diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 8133b5812a7..5e46216cc42 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -390,11 +390,17 @@ This expects `auto-revert--messages' to be bound by (should auto-revert-mode) (should (string-match name (substring-no-properties (buffer-string)))) + ;; If we don't sleep for a while, this test fails on + ;; MS-Windows. + (if (eq system-type 'windows-nt) + (sleep-for 0.5)) (ert-with-message-capture auto-revert--messages ;; Delete file. (delete-file tmpfile) (auto-revert--wait-for-revert buf)) + (if (eq system-type 'windows-nt) + (sleep-for 1)) ;; Check, that the buffer has been reverted. (should-not (string-match name (substring-no-properties (buffer-string)))) diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el index b74e79aa9e0..e2a0276ae0a 100644 --- a/test/lisp/emacs-lisp/cl-extra-tests.el +++ b/test/lisp/emacs-lisp/cl-extra-tests.el @@ -29,6 +29,33 @@ (should (eq (cl-get 'cl-get-test 'y :none) nil)) (should (eq (cl-get 'cl-get-test 'z :none) :none))) +(ert-deftest cl-extra-test-coerce () + (should (equal (cl-coerce "abc" 'list) '(?a ?b ?c))) + (should (equal (cl-coerce ["a" "b" "c"] 'list) '("a" "b" "c"))) + (should (equal (cl-coerce "abc" 'vector) [97 98 99])) + (should (equal (cl-coerce '("a" "b" "c") 'vector) ["a" "b" "c"])) + (should (equal (cl-coerce '(3 4) 'bool-vector) #&2"")) + (should (equal (cl-coerce "abc" 'bool-vector) #&3"")) + (should (equal (cl-coerce [1] 'string) (char-to-string 1))) + (should (equal (cl-coerce '(1) 'string) (char-to-string 1))) + (should (equal (cl-coerce '(1 2 3) 'array) [1 2 3])) + (should (equal (cl-coerce "abc" 'array) "abc")) + (should-error (cl-coerce (list 1 2 3) 'character)) + (should-error (cl-coerce [1 2 3] 'character)) + (should-error (cl-coerce "abc" 'character)) + (should (equal (cl-coerce "a" 'character) 97)) + (should (equal (cl-coerce 'a 'character) 97))) + +(ert-deftest cl-extra-test-equalp () + (should (cl-equalp "Test" "test")) + (should (cl-equalp 1 1.0)) + (should (cl-equalp '(1 2 3) '(1 2 3))) + (should (cl-equalp [1 2 3] [1 2 3])) + (should-not (cl-equalp "Test1" "Test2")) + (should-not (cl-equalp 1 2)) + (should-not (cl-equalp '(1 2 3) '(4 5 6))) + (should-not (cl-equalp [1 2 3] [4 5 6]))) + (ert-deftest cl-getf () (let ((plist '(x 1 y nil))) (should (eq (cl-getf plist 'x) 1)) @@ -127,4 +154,154 @@ (should (equal (cl-concatenate 'string "123" "456") "123456"))) +(ert-deftest cl-extra-test-mapcan () + (should (equal (cl-mapcan #'list '(1 2 3)) '(1 2 3))) + (should (equal (cl-mapcan #'list '(1 2 3) '(4 5 6)) '(1 4 2 5 3 6))) + (should (equal (cl-mapcan #'list '(1 2) '(3 4 5)) '(1 3 2 4))) + (should (equal (cl-mapcan #'list '(1 2 3) "#$%") '(1 ?# 2 ?$ 3 ?%))) + (should (equal (cl-mapcan #'list '()) '())) + (should (equal (cl-mapcan #'list '() '()) '()))) + +(ert-deftest cl-extra-test-mapcon () + (should (equal (cl-mapcon #'list '(1 2 3)) '((1 2 3) (2 3) (3)))) + (should (equal (cl-mapcon #'list '()) nil)) + (should (equal (cl-mapcon #'list '() '()) nil))) + +(ert-deftest cl-extra-test-some () + (should (equal (cl-some #'identity (list nil nil "foo")) "foo")) + (should (equal (cl-some #'identity [nil nil nil]) nil)) + (should (equal (cl-some (lambda (a b) (> (+ a b) 198)) (list ?a ?b ?c) "abcz") nil)) + (should (equal (cl-some (lambda (a b) (> (+ a b) 198)) (list ?a ?b ?c) "abz") t))) + +(ert-deftest cl-extra-test-every () + (should (equal (cl-every #'identity (list t 42 "foo")) t)) + (should (equal (cl-every #'identity [t nil "foo"]) nil)) + (should (equal (cl-every (lambda (a b) (<= (+ a b) 198)) + (list ?a ?b ?c) "abcz") + t)) + (should (equal (cl-every (lambda (a b) (<= (+ a b) 198)) + (list ?a ?b ?c) "abz") + nil))) + +(ert-deftest cl-extra-test-notany () + (should (equal (cl-notany #'cl-oddp '(1 3 5)) nil)) + (should (equal (cl-notany #'cl-oddp '(2 4 6)) t)) + (should (equal (cl-notany #'cl-oddp '(1 2 3 4 5)) nil))) + +(ert-deftest cl-extra-test-notevery () + (should (equal (cl-notevery #'cl-oddp '(1 3 5)) nil)) + (should (equal (cl-notevery #'cl-oddp '(2 4 6)) t)) + (should (equal (cl-notevery #'cl-oddp '(1 2 3 4 5)) t))) + +(ert-deftest cl-extra-test-gcd () + (should (equal (cl-gcd 4) 4)) + (should (equal (cl-gcd 3 5) 1)) + (should (equal (cl-gcd 4 8) 4)) + (should (equal (cl-gcd 3 5 7) 1)) + (should (equal (cl-gcd 4 8 12) 4)) + (should (equal (cl-gcd 0) 0)) + (should (equal (cl-gcd 4 0) 4)) + (should (equal (cl-gcd 0 0) 0))) + +(ert-deftest cl-extra-test-lcm () + (should (equal (cl-lcm 4) 4)) + (should (equal (cl-lcm 3 5) 15)) + (should (equal (cl-lcm 4 8) 8)) + (should (equal (cl-lcm 3 5 7) 105)) + (should (equal (cl-lcm 4 8 12) 24)) + (should (equal (cl-lcm 0 4) 0)) + (should (equal (cl-lcm 0 0) 0)) + (should (equal (cl-lcm) 1))) + +(ert-deftest cl-extra-test-isqrt () + (should (equal (cl-isqrt 4) 2)) + (should (equal (cl-isqrt 100) 10)) + (should (equal (cl-isqrt 1) 1)) + (should (equal (cl-isqrt 0) 0)) + (should (equal (cl-isqrt 3) 1)) + (should (equal (cl-isqrt 10) 3)) + (should-error (cl-isqrt -4)) + (should-error (cl-isqrt 2.5))) + +(ert-deftest cl-extra-test-floor () + (should (equal (cl-floor 4.5) '(4 0.5))) + (should (equal (cl-floor 10 3) '(3 1)))) + +(ert-deftest cl-extra-test-ceiling () + (should (equal (cl-ceiling 4.5) '(5 -0.5))) + (should (equal (cl-ceiling 10 3) '(4 -2)))) + +(ert-deftest cl-extra-test-truncate () + (should (equal (cl-truncate 4.5) '(4 0.5))) + (should (equal (cl-truncate 10 3) '(3 1)))) + +(ert-deftest cl-extra-test-round () + (should (equal (cl-round 4.5) '(4 0.5))) + (should (equal (cl-round 10 3) '(3 1))) + (should (equal (cl-round 1.5) '(2 -0.5))) + (should (equal (cl-round 2.5) '(2 0.5)))) + +(ert-deftest cl-extra-test-mod () + (should (equal (cl-mod 10 3) 1)) + (should (equal (cl-mod -10 -3) -1)) + (should (equal (cl-mod -10 3) 2)) + (should (equal (cl-mod 10 -3) -2))) + +(ert-deftest cl-extra-test-rem () + (should (equal (cl-rem 10 3) 1)) + (should (equal (cl-rem -10 -3) -1)) + (should (equal (cl-rem -10 3) -1)) + (should (equal (cl-rem 10 -3) 1))) + +(ert-deftest cl-extra-test-signum () + (should (equal (cl-signum 10) 1)) + (should (equal (cl-signum -10) -1)) + (should (equal (cl-signum 0) 0))) + +(ert-deftest cl-extra-test-parse-integer () + (should (equal (cl-parse-integer "10") 10)) + (should (equal (cl-parse-integer "-10") -10)) + (should (equal (cl-parse-integer "+10") 10)) + (should (equal (cl-parse-integer "ff" :radix 16) 255)) + (should (equal (cl-parse-integer "11" :start 1) 1)) + (should (equal (cl-parse-integer "abc def" :end 3 :junk-allowed t) nil))) + +(ert-deftest cl-extra-test-subseq () + (should (equal (cl-subseq "hello" 1) "ello")) + (should (equal (cl-subseq "hello" 1 4) "ell")) + (should (equal (cl-subseq "hello" -1) "o")) + (should (equal (cl-subseq "hello world" -5 -1) "worl")) + (should (equal (cl-subseq '(1 2 3 4 5) 2) '(3 4 5))) + (should (equal (cl-subseq '(1 2 3 4 5) 1 3) '(2 3)))) + +(ert-deftest cl-extra-test-concatenate () + (should (equal (cl-concatenate 'string "hello " "world") "hello world")) + (should (equal (cl-concatenate 'list '(1 2) '(3 4) '(5 6)) '(1 2 3 4 5 6)))) + +(ert-deftest cl-extra-test-revappend () + (should (equal (cl-revappend '(1 2 3) '(4 5 6)) '(3 2 1 4 5 6)))) + +(ert-deftest cl-extra-test-nreconc () + (should (equal (cl-nreconc '(1 2 3) '(4 5 6)) '(3 2 1 4 5 6)))) + +(ert-deftest cl-extra-test-list-length () + (should (equal (cl-list-length '(1 2 3)) 3)) + (should (equal (cl-list-length '()) 0)) + (let ((xl (number-sequence 1 100))) + (setcdr (nthcdr 99 xl) xl) + (should (equal (cl-list-length xl) nil)))) + +(ert-deftest cl-extra-test-tailp () + (let ((l '(1 2 3 4 5))) + (should (cl-tailp (nthcdr 2 l) l)) + (should (cl-tailp l l)) + (should (not (cl-tailp '(4 5) l))))) + +(ert-deftest cl-extra-test-remprop () + (let ((sym (make-symbol "test"))) + (put sym 'foo 'bar) + (should (equal (cl-get sym 'foo) 'bar)) + (cl-remprop sym 'foo) + (should (equal (cl-get sym 'foo 'default) 'default)))) + ;;; cl-extra-tests.el ends here diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index a9c71fa5808..ff860d94468 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -242,6 +242,42 @@ (should (= (cl-the integer (cl-incf side-effect)) 1)) (should (= side-effect 1)))) +(ert-deftest cl-lib-test-pushnew () + (let ((list '(1 2 3))) + (cl-pushnew 0 list) + (should (equal list '(0 1 2 3)))) + (let ((list '((1 2) (3 4)))) + (cl-pushnew '(3 7) list :key #'cdr) + (should (equal list '((3 7) (1 2) (3 4)) ))) + (let ((list '((1 2) (3 4)))) + (cl-pushnew '(3 7) list :key #'car) + (should (equal list '((1 2) (3 4))))) + (let ((list '((1 2) (3 4)))) + (cl-pushnew '(3 4) list :test #'equal) + (should (equal list '((1 2) (3 4))))) + (let ((list '((1 2) (3 4)))) + (cl-pushnew '(3 5) list :test #'equal) + (should (equal list '((3 5) (1 2) (3 4))))) + (let ((list '((1 2) (3 4)))) + (cl-pushnew '(3 4) list :test-not #'equal) + (should (equal list '((1 2) (3 4))))) + (let ((list '((1 2) (3 4)))) + (cl-pushnew '(3 5) list :test-not #'equal) + (should (equal list '((1 2) (3 4)))))) + +(ert-deftest cl-lib-test-values-list () + (let ((list '(:a :b :c))) + (should (equal (cl-values-list list) '(:a :b :c)))) + (let ((not-a-list :a)) + (should-error (cl-values-list not-a-list) :type 'wrong-type-argument))) + +(ert-deftest cl-lib-multiple-value-list () + (should (equal (cl-multiple-value-list 1) 1)) + (should (equal (cl-multiple-value-list '(1 2 3)) '(1 2 3))) + (should (equal (cl-multiple-value-list "string") "string")) + (should (equal (cl-multiple-value-list nil) nil)) + (should (equal (cl-multiple-value-list (list 1 2 3)) '(1 2 3)))) + (ert-deftest cl-lib-test-incf () (let ((var 0)) (should (= (cl-incf var) 1)) @@ -388,6 +424,50 @@ (should (= 10 (cl-tenth '(1 2 3 4 5 6 7 8 9 10 11)))) (should-error (cl-tenth "1234567890") :type 'wrong-type-argument)) +(ert-deftest cl-lib-test-mapcar () + (should (equal (cl-mapcar #'1+ '(1 2 3)) '(2 3 4))) + (should (equal (cl-mapcar #'+ '(1 2 3) '(4 5 6)) '(5 7 9))) + (should (equal (cl-mapcar #'+ '(1 2 3) '(4 5)) '(5 7))) + (should (equal (cl-mapcar #'+ '() '()) '())) + (should-error (cl-mapcar #'+ 1 '(4 5 6))) + (should-error (cl-mapcar #'+ '(1 2 3) 4))) + +(ert-deftest cl-lib-test-list* () + (should (equal (cl-list* 'a) 'a)) + (should (equal (cl-list* 'a 'b) '(a . b))) + (should (equal (cl-list* 'a 'b 'c 'd) '(a b c . d))) + (should (equal (cl-list* 'a 'b '(c d)) '(a b c d)))) + +(ert-deftest cl-lib-test-copy-list () + (let ((original '(1 2 . 3)) + (result (cl-copy-list '(1 2 . 3)))) + (and (should (equal original result)) + (not (eq original result))))) + +(ert-deftest cl-lib-test-subst () + (should (equal (cl-subst 'x 'a '(a b c)) '(x b c))) + (should (equal (cl-subst 'x 'a '(a b a c)) '(x b x c))) + (should (equal (cl-subst 'x 'a '(b c d)) '(b c d))) + (should (equal (cl-subst 'x 'a '(a b (a c) d)) '(x b (x c) d))) + (should (equal (cl-subst "a" "A" '("a" "b" "c" "a") :test #'equal) '("a" "b" "c" "a")))) + +(ert-deftest cl-lib-test-acons () + (should (equal (cl-acons 'key 'value '()) '((key . value)))) + (should (equal (cl-acons 'key 'value '((a . 1) (b . 2))) '((key . value) (a . 1) (b . 2)))) + (should (equal (cl-acons 'a 1 '((a . 1) (b . 2))) '((a . 1) (a . 1) (b . 2)))) + (should (equal (cl-acons nil 'value '((a . 1) (b . 2))) '((nil . value) (a . 1) (b . 2)))) + (should (equal (cl-acons 'key nil '((a . 1) (b . 2))) '((key . nil) (a . 1) (b . 2))))) + +(ert-deftest cl-lib-test-pairlis () + (should (equal (cl-pairlis '(a b c) '(1 2 3)) '((a . 1) (b . 2) (c . 3)))) + (should (equal (cl-pairlis '(a b c d) '(1 2 3)) '((a . 1) (b . 2) (c . 3)))) + (should (equal (cl-pairlis '(a b c) '(1 2 3 4)) '((a . 1) (b . 2) (c . 3)))) + (should (equal (cl-pairlis '(a b c) '(1 2 3) '((d . 4) (e . 5))) '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5)))) + (should (equal (cl-pairlis '() '(1 2 3)) '())) + (should (equal (cl-pairlis '(a b c) '()) '())) + (should (equal (cl-pairlis '(a nil c) '(1 2 3)) '((a . 1) (nil . 2) (c . 3)))) + (should (equal (cl-pairlis '(a b c) '(1 nil 3)) '((a . 1) (b) (c . 3))))) + (ert-deftest cl-lib-test-endp () (should (cl-endp '())) (should-not (cl-endp '(1))) @@ -558,5 +638,37 @@ (should (equal (mapcar (cl-constantly 3) '(a b c d)) '(3 3 3 3)))) +(ert-deftest cl-lib-set-difference () + ;; our set-difference preserves order, though it is not required to + ;; by cl standards. Nevertheless better keep that invariant + (should (equal (cl-set-difference '(1 2 3 4) '(3 4 5 6)) + '(1 2)))) + +(ert-deftest cl-nset-difference () + ;; our nset-difference doesn't + (let* ((l1 (list 1 2 3 4)) (l2 '(3 4 5 6)) + (diff (cl-nset-difference l1 l2))) + (should (memq 1 diff)) + (should (memq 2 diff)) + (should (= (length diff) 2)) + (should (equal l2 '(3 4 5 6)))) + (let* ((l1 (list "1" "2" "3" "4")) (l2 '("3" "4" "5" "6")) + (diff (cl-nset-difference l1 l2 :test #'equal))) + (should (member "1" diff)) + (should (member "2" diff)) + (should (= (length diff) 2)) + (should (equal l2 '("3" "4" "5" "6")))) + (let* ((l1 (list '(a . 1) '(b . 2) '(c . 3) '(d . 4))) + (l2 (list '(c . 3) '(d . 4) '(e . 5) '(f . 6))) + (diff (cl-nset-difference l1 l2 :key #'car))) + (should (member '(a . 1) diff)) + (should (member '(b . 2) diff)) + (should (= (length diff) 2))) + (let* ((l1 (list '("a" . 1) '("b" . 2) '("c" . 3) '("d" . 4))) + (l2 (list '("c" . 3) '("d" . 4) '("e" . 5) '("f" . 6))) + (diff (cl-nset-difference l1 l2 :key #'car :test #'string=))) + (should (member '("a" . 1) diff)) + (should (member '("b" . 2) diff)) + (should (= (length diff) 2)))) ;;; cl-lib-tests.el ends here diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 663961dc317..628bae36e48 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -728,6 +728,15 @@ collection clause." (cons (f1 7) 8))) '(7 . 8)))) +(ert-deftest cl-macs--test-cl-block-lexbind-bug-75498 () + (should (equal + (let ((ret (lambda (f) + (cl-block a (funcall f) (cl-return-from a :ret))))) + (cl-block a + (list :oops + (funcall ret (lambda () (cl-return-from a :clo)))))) + :clo))) + (ert-deftest cl-flet/edebug () "Check that we can instrument `cl-flet' forms (bug#65344)." (with-temp-buffer diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el index 9c62379d857..3541a989d34 100644 --- a/test/lisp/emacs-lisp/cl-seq-tests.el +++ b/test/lisp/emacs-lisp/cl-seq-tests.el @@ -59,6 +59,22 @@ Body are forms defining the test." (when ,list2 (setq cl-seq--test-list2 ,orig2)))))) +(ert-deftest cl-seq-endp-test () + (should (cl-endp '())) + (should (not (cl-endp '(1 2 3)))) + (should-error (cl-endp 42) :type 'wrong-type-argument)) + +(ert-deftest cl-seq-reduce-test () + (should (equal 6 (cl-reduce #'+ '(1 2 3)))) + (should (equal 5 (cl-reduce #'+ '(1 2 3 4) :start 1 :end 3))) + (should (equal 10 (cl-reduce #'+ '(1 2 3 4) :from-end t))) + (should (equal 10 (cl-reduce #'+ '(1 2 3 4) :initial-value 0))) + (should (equal 24 (cl-reduce #'* '(1 2 3 4) :initial-value 1))) + (should (equal 0 (cl-reduce #'+ '()))) + (should (equal 0 (cl-reduce #'+ '() :initial-value 0))) + (should (equal 1 (cl-reduce #'+ '(1)))) + (should (equal 0 (cl-reduce #'+ '() :initial-value 0)))) + ;; keywords supported: :start :end (ert-deftest cl-seq-fill-test () (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) @@ -116,6 +132,25 @@ Body are forms defining the test." (should (equal '(1 3 4 5 2 6) (cl-remove 2 list :from-end nil :count 1))) (should (equal '(1 2 3 4 5 6) (cl-remove 2 list :from-end t :count 1))))) +(ert-deftest cl-remove-if-test () + (should (equal '(1 3) (cl-remove-if 'cl-evenp '(1 2 3 4)))) + (should (equal '(1 3) (cl-remove-if 'cl-evenp '(1 2 3 4) :count 2))) + (should (equal '(1 3 4) (cl-remove-if 'cl-evenp '(1 2 3 4) :start 1 :end 3))) + (should (equal '(1 3) (cl-remove-if 'cl-evenp '(1 2 3 4) :from-end t))) + (should (equal '(2 4) (cl-remove-if 'cl-oddp '(1 2 3 4)))) + (should (equal '() (cl-remove-if 'cl-evenp '()))) + (should (equal '() (cl-remove-if 'cl-evenp '(2))))) + +(ert-deftest cl-remove-if-not-test () + (should (equal '(2 4) (cl-remove-if-not 'cl-evenp '(1 2 3 4)))) + (should (equal '(2 4) (cl-remove-if-not 'cl-evenp '(1 2 3 4) :count 2))) + (should (equal '(1 2 4) (cl-remove-if-not 'cl-evenp '(1 2 3 4) :start 1 :end 3))) + (should (equal '(2 4) (cl-remove-if-not 'cl-evenp '(1 2 3 4) :from-end t))) + (should (equal '(1 3) (cl-remove-if-not 'cl-oddp '(1 2 3 4)))) + (should (equal '() (cl-remove-if-not 'cl-evenp '()))) + (should (equal '(2) (cl-remove-if-not 'cl-evenp '(2)))) + (should (equal '(2) (cl-remove-if-not 'cl-evenp '(2) :key #'(lambda (x) (- x)))))) + ;; keywords supported: :test :test-not :key :count :start :end :from-end (ert-deftest cl-seq-delete-test () (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) @@ -139,6 +174,27 @@ Body are forms defining the test." (cl-seq--with-side-effects orig nil test))))) +(ert-deftest cl-delete-if-test () + (let ((list (list 1 2 3 4 5))) + (cl-delete-if 'cl-evenp list) + (should (equal '(1 3 5) list)) + (should (equal '(1 3 5) (cl-delete-if 'cl-evenp (list 1 2 3 4 5) :start 0 :end 4))) + (should (equal '(1 3 5) (cl-delete-if 'cl-evenp (list 1 2 3 4 5) :from-end t))) + (should (equal '(2 4) (cl-delete-if 'cl-oddp (list 1 2 3 4 5)))) + (should (equal '() (cl-delete-if 'cl-evenp '()))) + (should (equal '() (cl-delete-if 'cl-evenp (list 2)))))) + +(ert-deftest cl-delete-if-not-test () + (let ((list (list 1 2 3 4 5))) + (should (equal '(2 4) (cl-delete-if-not 'cl-evenp list))) + (should (equal '() (cl-delete-if-not 'cl-evenp '()))) + (should (equal '() (cl-delete-if-not 'cl-evenp (list 1)))))) + +(ert-deftest cl-delete-duplicates-test () + (let ((list (list 1 2 3 2 1))) + (should (equal '(3 2 1) (cl-delete-duplicates list))) + (should (equal '() (cl-delete-duplicates '()))))) + ;; keywords supported: :test :test-not :key :start :end :from-end (ert-deftest cl-seq-remove-duplicates-test () (let ((list '(1 2 3 4 5 2 6))) @@ -185,6 +241,65 @@ Body are forms defining the test." (should (equal '(b 2 3 4 5 2 6) (cl-substitute 'b nil list :if-not (lambda (x) (> (cl-position x list :from-end t) 1))))))) +(ert-deftest cl-seq-substitute-if-test () + (let ((result (cl-substitute-if 'x #'cl-evenp '(1 2 3 4 5)))) + (should (equal result '(1 x 3 x 5)))) + (let ((result (cl-substitute-if 'x #'cl-evenp '(1 3 5)))) + (should (equal result '(1 3 5)))) + (let ((result (cl-substitute-if 'x #'(lambda (n) t) '(1 2 3 4 5)))) + (should (equal result '(x x x x x)))) + (let ((result (cl-substitute-if 'x #'cl-evenp '(1 2 3 4 5) :start 1 :end 4))) + (should (equal result '(1 x 3 x 5)))) + (let ((result (cl-substitute-if 'x #'cl-oddp '(1 2 3 4 5) :from-end t))) + (should (equal result '(x 2 x 4 x)))) + (let ((result (cl-substitute-if 'x (lambda (n) (= n 3)) '(1 2 3 4 5) :key 'identity))) + (should (equal result '(1 2 x 4 5))))) + +(ert-deftest cl-seq-substitute-if-not-test () + (let ((result (cl-substitute-if-not 'x #'cl-evenp '(1 2 3 4 5)))) + (should (equal result '(x 2 x 4 x)))) + (let ((result (cl-substitute-if-not 'x #'cl-evenp '(2 4 6)))) + (should (equal result '(2 4 6)))) + (let ((result (cl-substitute-if-not 'x #'(lambda (n) (> n 5)) '(1 2 3 4 5)))) + (should (equal result '(x x x x x)))) + (let ((result (cl-substitute-if-not 'x #'cl-evenp '(1 2 3 4 5) :start 0 :end 4))) + (should (equal result '(x 2 x 4 5)))) + (let ((result (cl-substitute-if-not 'x #'cl-oddp '(1 2 3 4 5) :from-end t))) + (should (equal result '(1 x 3 x 5)))) + (let ((result (cl-substitute-if-not 'x (lambda (n) (= n 3)) '(1 2 3 4 5) :key 'identity))) + (should (equal result '(x x 3 x x))))) + +(ert-deftest cl-find-if-test () + (let ((result (cl-find-if #'cl-evenp '(1 2 3 4 5)))) + (should (equal result 2))) + (let ((result (cl-find-if #'(lambda (n) (> n 5)) '(1 2 3 4 5)))) + (should (equal result nil))) + (let ((result (cl-find-if #'(lambda (n) (> n 3)) '(1 2 3 4 5 6 7)))) + (should (equal result 4))) + (let ((result (cl-find-if #'cl-evenp '(1 2 3 4 5) :start 2))) + (should (equal result 4))) + (let ((result (cl-find-if #'cl-evenp '(1 2 3 4 5) :end 1))) + (should (equal result nil))) + (let ((result (cl-find-if #'cl-oddp '(2 4 5 6 7) :from-end t))) + (should (equal result 7))) + (let ((result (cl-find-if (lambda (n) (= n 4)) '(1 2 3 4 5) :key 'identity))) + (should (equal result 4)))) + +(ert-deftest cl-find-if-not-test () + (let ((result (cl-find-if-not #'cl-evenp '(1 2 3 4 5)))) + (should (equal result 1))) + (let ((result (cl-find-if-not #'cl-oddp '(1 3 5)))) + (should (equal result nil))) + (let ((result (cl-find-if-not #'(lambda (n) (< n 4)) '(1 2 3 4 5 6 7)))) + (should (equal result 4))) + (let ((result (cl-find-if-not #'cl-evenp '(1 2 3 4 5) :start 2))) + (should (equal result 3))) + (let ((result (cl-find-if-not #'cl-evenp '(1 2 3 4 5) :end 3))) + (should (equal result 1))) + (let ((result (cl-find-if-not #'cl-oddp '(2 4 6 7 8) :from-end t))) + (should (equal result 8))) + (let ((result (cl-find-if-not (lambda (n) (= n 4)) '(1 2 3 4 5) :key 'identity))) + (should (equal result 1)))) ;; keywords supported: :test :test-not :key :count :start :end :from-end (ert-deftest cl-seq-nsubstitute-test () @@ -221,7 +336,7 @@ Body are forms defining the test." (dolist (test tests) (let ((_list cl-seq--test-list)) (cl-seq--with-side-effects orig nil - test))))) + test))))) ;; keywords supported: :test :test-not :key :start :end :from-end (ert-deftest cl-seq-position-test () @@ -241,6 +356,22 @@ Body are forms defining the test." (should (= 1 (cl-position 5 list :key (lambda (x) (1+ (* x x)))))) (should (= 5 (cl-position 5 list :key (lambda (x) (1+ (* x x))) :from-end t))))) +(ert-deftest cl-position-if-test () + (let ((result (cl-position-if #'cl-evenp '(1 2 3 4 5)))) + (should (equal result 1))) + (let ((result (cl-position-if #'(lambda (n) (> n 5)) '(1 2 3 4 5)))) + (should (equal result nil))) + (let ((result (cl-position-if #'(lambda (n) (> n 3)) '(1 2 3 4 5 6 7)))) + (should (equal result 3))) + (let ((result (cl-position-if #'cl-evenp '(1 2 3 4 5) :start 2))) + (should (equal result 3))) + (let ((result (cl-position-if #'cl-evenp '(1 2 3 4 5) :end 1))) + (should (equal result nil))) + (let ((result (cl-position-if #'cl-oddp '(2 4 5 6 7) :from-end t))) + (should (equal result 4))) + (let ((result (cl-position-if (lambda (n) (= n 4)) '(1 2 3 4 5) :key 'identity))) + (should (equal result 3)))) + ;; keywords supported: :test :test-not :key :start :end (ert-deftest cl-seq-count-test () (let ((list '(1 2 3 4 5 2 6))) @@ -254,6 +385,50 @@ Body are forms defining the test." (should (equal (cl-count 'foo list :test (lambda (_a b) (cl-oddp b))) (cl-count 'foo list :test-not (lambda (_a b) (cl-evenp b))))))) +(ert-deftest cl-count-if-test () + (let ((result (cl-count-if #'cl-evenp '(1 2 3 4 5)))) + (should (equal result 2))) + (let ((result (cl-count-if #'cl-oddp '(2 4 6 8)))) + (should (equal result 0))) + (let ((result (cl-count-if (lambda (x) t) '(1 2 3 4)))) + (should (equal result 4))) + (let ((result (cl-count-if (lambda (x) nil) '(1 2 3 4)))) + (should (equal result 0))) + (let ((result (cl-count-if #'(lambda (x) (> x 2)) '(1 2 3 4 5) :key 'identity))) + (should (equal result 3))) + (let ((result (cl-count-if #'cl-evenp '(1 2 3 4 5) :start 2))) + (should (equal result 1))) + (let ((result (cl-count-if #'cl-evenp '(1 2 3 4 5) :end 3))) + (should (equal result 1))) + (let ((result (cl-count-if #'cl-evenp '()))) + (should (equal result 0))) + (let ((result (cl-count-if #'(lambda (x) (numberp x)) '(1 "two" 3 4 "five" 6)))) + (should (equal result 4))) + (let ((result (cl-count-if (lambda (x) (and (numberp x) (> x 2))) '(1 2 3 4 5 6)))) + (should (equal result 4)))) + +(ert-deftest cl-count-if-not-test () + (let ((result (cl-count-if-not #'cl-evenp '(1 2 3 4 5)))) + (should (equal result 3))) + (let ((result (cl-count-if-not #'cl-oddp '(1 3 5)))) + (should (equal result 0))) + (let ((result (cl-count-if-not (lambda (x) t) '(1 2 3 4)))) + (should (equal result 0))) + (let ((result (cl-count-if-not (lambda (x) nil) '(1 2 3 4)))) + (should (equal result 4))) + (let ((result (cl-count-if-not #'(lambda (x) (> x 3)) '(1 2 3 4 5) :key 'identity))) + (should (equal result 3))) + (let ((result (cl-count-if-not #'cl-evenp '(1 2 3 4 5) :start 2))) + (should (equal result 2))) + (let ((result (cl-count-if-not #'cl-evenp '(1 2 3 4 5) :end 3))) + (should (equal result 2))) + (let ((result (cl-count-if-not #'cl-evenp '()))) + (should (equal result 0))) + (let ((result (cl-count-if-not #'(lambda (x) (numberp x)) '(1 "two" 3 4 "five" 6)))) + (should (equal result 2))) + (let ((result (cl-count-if-not (lambda (x) (and (numberp x) (> x 2))) '(1 2 3 4 5 6)))) + (should (equal result 2)))) + ;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end (ert-deftest cl-seq-mismatch-test () (let ((list '(1 2 3 4 5 2 6)) @@ -312,5 +487,536 @@ Body are forms defining the test." (should (eq (cl-assoc x a) (car a))) (should (eq (cl-rassoc x a) (cadr a)))))) +(ert-deftest cl-sort-test () + (let ((result (cl-sort '(3 1 4 1 5 9 2 6 5 3 5) '<))) + (should (equal result '(1 1 2 3 3 4 5 5 5 6 9)))) + (let ((result (cl-sort '(5 3 2 8 1 4) '>))) + (should (equal result '(8 5 4 3 2 1)))) + (let ((result (cl-sort '("banana" "apple" "cherry") 'string<))) + (should (equal result '("apple" "banana" "cherry")))) + (let ((result (cl-sort '("banana" "fig" "apple" "kiwi") (lambda (x y) (< (length x) (length y))) :key 'identity))) + (should (equal result '("fig" "kiwi" "apple" "banana")))) + (let ((result (cl-sort (vector 3 1 4 1 5) '<))) + (should (equal result (vector 1 1 3 4 5)))) + (let ((result (cl-sort '(1 2 3 4 5) '<))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-sort '(-3 1 4 -1 -5 9) '<))) + (should (equal result '(-5 -3 -1 1 4 9)))) + (let ((result (cl-sort '(1 2 3 4 5) (lambda (x y) (> x y))))) + (should (equal result '(5 4 3 2 1)))) + (let ((result (cl-sort '() '<))) + (should (equal result '()))) + (let ((result (cl-sort '("Banana" "apple" "cherry") 'string< :key 'downcase))) + (should (equal result '("apple" "Banana" "cherry")))) ) + +(ert-deftest cl-stable-sort-test () + (let ((result (cl-stable-sort '(3 1 4 1 5 9 2 6 5 3 5) '<))) + (should (equal result '(1 1 2 3 3 4 5 5 5 6 9)))) + (let ((result (cl-stable-sort '(5 3 2 8 1 4) '>))) + (should (equal result '(8 5 4 3 2 1)))) + (let ((result (cl-stable-sort '("banana" "apple" "cherry") 'string<))) + (should (equal result '("apple" "banana" "cherry")))) + (let ((result (cl-stable-sort '("banana" "fig" "apple" "kiwi") (lambda (x y) (< (length x) (length y))) :key 'identity))) + (should (equal result '("fig" "kiwi" "apple" "banana")))) + (let ((result (cl-stable-sort (vector 3 1 4 1 5) '<))) + (should (equal result (vector 1 1 3 4 5)))) + (let ((result (cl-stable-sort '(1 2 3 4 5) '<))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-stable-sort '(-3 1 4 -1 -5 9) '<))) + (should (equal result '(-5 -3 -1 1 4 9)))) + (let ((result (cl-stable-sort '(1 2 3 4 5) (lambda (x y) (> x y))))) + (should (equal result '(5 4 3 2 1)))) + (let ((result (cl-stable-sort '() '<))) + (should (equal result '()))) + (let ((result (cl-stable-sort '("Banana" "apple" "cherry") 'string< :key 'downcase))) + (should (equal result '("apple" "Banana" "cherry")))) ) + +(ert-deftest cl-merge-test () + (let ((result (cl-merge 'list '(1 3 5) '(2 4 6) '<))) + (should (equal result '(1 2 3 4 5 6)))) + (let ((result (cl-merge 'list '(1 3 3 5) '(2 3 4 6) '<))) + (should (equal result '(1 2 3 3 3 4 5 6)))) + (let ((result (cl-merge 'list '() '(2 4 6) '<))) + (should (equal result '(2 4 6)))) + (let ((result (cl-merge 'list '(1 3 5) '() '<))) + (should (equal result '(1 3 5)))) + (let ((result (cl-merge 'list '() '() '<))) + (should (equal result '()))) + (let ((result (cl-merge 'list '(1 4 6) '(2 3 5) '< :key (lambda (x) x)))) + (should (equal result '(1 2 3 4 5 6)))) + (let ((result (cl-merge 'vector (vector 1 3 5) (vector 2 4 6) '<))) + (should (equal result (vector 1 2 3 4 5 6)))) + (let ((result (cl-merge 'list '(5 3 1) '(6 4 2) '>))) + (should (equal result '(6 5 4 3 2 1)))) + (let ((result (cl-merge 'list '(1 2 3) '(1 2 3) '>))) + (should (equal result '(1 2 3 1 2 3)))) + (let ((result (cl-merge 'list '(1 2) '(3 4 5) '<))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-merge 'list '(4 5 6) '(1 2 3) '<))) + (should (equal result '(1 2 3 4 5 6)))) + (let ((result (cl-merge 'list '(1 2 3) '(1.5 2.5 3.5) '<))) + (should (equal result '(1 1.5 2 2.5 3 3.5)))) + (let ((result (cl-merge 'list '(1 2 3) '(10 20 30) '< :key (lambda (x) (* x 10))))) + (should (equal result '(1 2 3 10 20 30))))) + +(ert-deftest cl-member-test () + (let ((result (cl-member 'b '(a b c d)))) + (should (equal result '(b c d)))) + (let ((result (cl-member 'x '(a b c d)))) + (should (equal result nil))) + (let ((result (cl-member 'a '(a b a c d)))) + (should (equal result '(a b a c d)))) + (let ((result (cl-member "test" '("test" "not-test" "test2") :test 'string=))) + (should (equal result '("test" "not-test" "test2")))) + (let ((result (cl-member 'x '(a b c d) :test-not 'eq))) + (should (equal result '(a b c d)))) + (let ((result (cl-member 3 '(1 2 3 4 5) :key 'identity))) + (should (equal result '(3 4 5)))) + (let ((result (cl-member 2.5 '(1 2 2.5 3) :test 'equal))) + (should (equal result '(2.5 3)))) + (let ((result (cl-member 'a '(a a a a) :test 'eq))) + (should (equal result '(a a a a)))) + (let ((result (cl-member 'a '()))) + (should (equal result nil))) + (let ((result (cl-member 'b '(a c d) :test-not 'eq))) + (should (equal result '(a c d)))) + (let ((result (cl-member 3 '(1 2 3 4 5) :key '1+))) + (should (equal result '(2 3 4 5))))) + +(ert-deftest cl-member-if-test () + (let ((result (cl-member-if #'cl-evenp '(1 2 3 4 5)))) + (should (equal result '(2 3 4 5)))) + (let ((result (cl-member-if #'(lambda (x) nil) '(1 2 3 4 5)))) + (should (equal result nil))) + (let ((result (cl-member-if #'(lambda (x) t) '(1 2 3 4 5)))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-member-if #'(lambda (x) (= x 1)) '(1 2 3 4 5)))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-member-if #'(lambda (x) (and (numberp x) (cl-evenp x))) '(1 3 5 4 2)))) + (should (equal result '(4 2)))) + (let ((result (cl-member-if (lambda (x) (string= (number-to-string x) "3")) '(1 2 3 4 5) :key 'identity))) + (should (equal result '(3 4 5)))) + (let ((result (cl-member-if #'(lambda (x) (eq x 'a)) '(a a a a)))) + (should (equal result '(a a a a)))) + (let ((result (cl-member-if #'cl-evenp '()))) + (should (equal result nil))) + (let ((result (cl-member-if #'(lambda (x) (< x 0)) '(1 2 3 4 5)))) + (should (equal result nil))) + (let ((result (cl-member-if (lambda (x) (and (numberp x) (<= x 2))) '(1 "two" 3 0)))) + (should (equal result '(1 "two" 3 0)))) + (let ((result (cl-member-if (lambda (x) (> x 5)) '(1 2 3 6 7 8) :key 'identity))) + (should (equal result '(6 7 8))))) + +(ert-deftest cl-member-if-not-test () + (let ((result (cl-member-if-not #'cl-evenp '(1 2 3 4 5)))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-member-if-not #'cl-evenp '(2 4 6 8 10 11)))) + (should (equal result '(11)))) + (let ((result (cl-member-if-not #'(lambda (x) (> x 5)) '(1 2 3 4 5)))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-member-if-not #'(lambda (x) t) '(1 2 3 4 5)))) + (should (equal result nil))) + (let ((result (cl-member-if-not #'(lambda (x) (= x 1)) '(1 2 3 4 5)))) + (should (equal result '(2 3 4 5)))) + (let ((result (cl-member-if-not (lambda (x) (string= (number-to-string x) "2")) '(1 2 3 4 5) :key 'identity))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-member-if-not #'cl-evenp '()))) + (should (equal result nil))) + (let ((result (cl-member-if-not #'(lambda (x) (eq x 'a)) '(a a a a)))) + (should (equal result nil))) + (let ((result (cl-member-if-not #'(lambda (x) (< x 0)) '(1 2 3 4 5)))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-member-if-not #'(lambda (x) (or (numberp x) (stringp x) (eq x 'b))) '(a "b" 3 nil)))) + (should (equal result '(a "b" 3 nil)))) + (let ((result (cl-member-if-not (lambda (x) (numberp x)) '(1 "two" 3 "four" 5) :key 'identity))) + (should (equal result '("two" 3 "four" 5))))) + +(ert-deftest cl-assoc-test () + (let ((result (cl-assoc 'b '((a . 1) (b . 2) (c . 3))))) + (should (equal result '(b . 2)))) + (let ((result (cl-assoc 'x '((a . 1) (b . 2) (c . 3))))) + (should (equal result nil))) + (let ((result (cl-assoc "key" '(("key" . 1) ("not-key" . 2)) :test 'string=))) + (should (equal result '("key" . 1)))) + (let ((result (cl-assoc 'a '((a . 1) (b . 2) (c . 3)) :test-not 'eq))) + (should (equal result '(b . 2)))) + (let ((result (cl-assoc '2 '((1 . 'a) (2 . 'b) (3 . 'c)) :key 'identity))) + (should (equal result '(2 . 'b)))) + (let ((result (cl-assoc 'a '((a . 1) (a . 2) (a . 3)) :test 'eq))) + (should (equal result '(a . 1)))) + (let ((result (cl-assoc 'a '()))) + (should (equal result nil))) + (let ((result (cl-assoc 'b '((a . 1) (b . 2) (b . 3) (c . 4))))) + (should (equal result '(b . 2))))) + +(ert-deftest cl-assoc-if-test () + (let ((result (cl-assoc-if #'cl-evenp '((1 . "odd") (2 . "even") (3 . "odd") (4 . "even"))))) + (should (equal result '(2 . "even")))) + (let ((result (cl-assoc-if #'(lambda (x) (= x 5)) '((1 . "one") (2 . "two") (3 . "three"))))) + (should (equal result nil))) + (let ((result (cl-assoc-if #'(lambda (x) (= x 1)) '((1 . "one") (2 . "two") (3 . "three"))))) + (should (equal result '(1 . "one")))) + (let ((result (cl-assoc-if #'(lambda (x) (string= x "baz")) '((foo . 1) (bar . 2) (baz . 3))))) + (should (equal result '(baz . 3)))) + (let ((result (cl-assoc-if (lambda (x) (and (numberp x) (> x 2))) '((1 . "one") (3 . "three") (4 . "four"))))) + (should (equal result '(3 . "three")))) + (let ((result (cl-assoc-if #'(lambda (x) (> x 1)) '((0 . "zero") (1 . "one") (2 . "two"))))) + (should (equal result '(2 . "two")))) + (let ((result (cl-assoc-if #'cl-evenp '()))) + (should (equal result nil))) + (let ((result (cl-assoc-if #'(lambda (x) (eq x 'a)) '((a . "first") (a . "second") (b . "third"))))) + (should (equal result '(a . "first")))) + (let ((result (cl-assoc-if #'(lambda (x) (and (symbolp x) (not (eq x 'b)))) '((b . "b") (c . "c") (d . "d"))))) + (should (equal result '(c . "c")))) + (let ((result (cl-assoc-if (lambda (x) (and (listp x) (> (length x) 1))) '(((1 2) . "pair 1") ((1) . "pair 2"))))) + (should (equal result '((1 2) . "pair 1"))))) + +(ert-deftest cl-assoc-if-not-test () + (let ((result (cl-assoc-if-not #'cl-evenp '((1 . "odd") (2 . "even") (3 . "odd") (4 . "even"))))) + (should (equal result '(1 . "odd")))) + (let ((result (cl-assoc-if-not #'(lambda (x) (> x 0)) '((1 . "one") (2 . "two") (3 . "three"))))) + (should (equal result nil))) + (let ((result (cl-assoc-if-not #'(lambda (x) (< x 5)) '((1 . "one") (2 . "two") (3 . "three"))))) + (should (equal result nil))) + (let ((result (cl-assoc-if-not #'(lambda (x) (= x 1)) '((1 . "one") (2 . "two") (3 . "three"))))) + (should (equal result '(2 . "two")))) + (let ((result (cl-assoc-if-not #'(lambda (x) (string= x "baz")) '((foo . "first") (bar . "second") (baz . "third"))))) + (should (equal result '(foo . "first")))) + (let ((result (cl-assoc-if-not (lambda (x) (and (numberp x) (> x 2))) '((1 . "one") (3 . "three") (4 . "four"))))) + (should (equal result '(1 . "one")))) + (let ((result (cl-assoc-if-not #'(lambda (x) (symbolp x)) '((1 . "one") (b . "bee") (2 . "two"))))) + (should (equal result '(1 . "one")))) + (let ((result (cl-assoc-if-not #'cl-evenp '()))) + (should (equal result nil))) + (let ((result (cl-assoc-if-not #'(lambda (x) (eq x 'a)) '((a . "first") (a . "second") (b . "third"))))) + (should (equal result '(b . "third"))))) + +(ert-deftest cl-rassoc-test () + (let ((result (cl-rassoc 2 '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result (cons "two" 2)))) + (let ((result (cl-rassoc 4 '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result nil))) + (let ((result (cl-rassoc 2 '(( "one" . 1) ("two" . 2) ("baz" . 2)) :test 'equal))) + (should (equal result (cons "two" 2)))) + (let ((result (cl-rassoc 2 '(( "one" . 1) ("two" . 2) ("three" . 3)) :test-not 'equal))) + (should (equal result (cons "one" 1)))) + (let ((result (cl-rassoc 1 '()))) + (should (equal result nil))) + (let ((result (cl-rassoc 1 '(( "first" . 1) ("second" . 1) ("third" . 1))))) + (should (equal result (cons "first" 1)))) + (let ((result (cl-rassoc 3 '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result (cons "three" 3)))) + (let ((result (cl-rassoc 'found '((( "pair 1") . 1) ( "pair 2" . 2) ( "pair 3" . 3))))) + (should (equal result nil)))) + +(ert-deftest cl-rassoc-if-test () + (let ((result (cl-rassoc-if #'cl-evenp '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("two" . 2)))) + (let ((result (cl-rassoc-if #'cl-evenp '(( "one" . 1) ("three" . 3) ("five" . 5))))) + (should (equal result nil))) + (let ((result (cl-rassoc-if #'(lambda (x) (= x 1)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("one" . 1)))) + (let ((result (cl-rassoc-if (lambda (x) (> x 1)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("two" . 2)))) + (let ((result (cl-rassoc-if #'(lambda (x) (and (numberp x) (< x 3))) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("one" . 1)))) + (let ((result (cl-rassoc-if #'cl-evenp '()))) + (should (equal result nil))) + (let ((result (cl-rassoc-if #'(lambda (x) (> x 0)) '(( "first" . 1) ("second" . 2) ("third" . 3))))) + (should (equal result '("first" . 1)))) + (let ((result (cl-rassoc-if #'(lambda (x) (string= (number-to-string x) "two")) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result nil))) + (let ((result (cl-rassoc-if #'(lambda (x) (stringp x)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result nil)))) + +(ert-deftest cl-rassoc-if-not-test () + (let ((result (cl-rassoc-if-not #'cl-evenp '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("one" . 1)))) + (let ((result (cl-rassoc-if-not #'(lambda (x) (> x 0)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result nil))) + (let ((result (cl-rassoc-if-not #'(lambda (x) (< x 5)) '(( "one" . 1) ("two" . 2) ("six" . 6))))) + (should (equal result '( "six" . 6)))) + (let ((result (cl-rassoc-if-not #'(lambda (x) (= x 1)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("two" . 2)))) + (let ((result (cl-rassoc-if-not #'(lambda (x) (> x 2)) '(( "one" . 1) ("two" . 1) ("three" . 3))))) + (should (equal result '("one" . 1)))) + (let ((result (cl-rassoc-if-not #'(lambda (x) (and (numberp x) (< x 3))) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("three" . 3)))) + (let ((result (cl-rassoc-if-not #'(lambda (x) (equal x 2)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("one" . 1)))) + (let ((result (cl-rassoc-if-not #'cl-evenp '()))) + (should (equal result nil))) + (let ((result (cl-rassoc-if-not #'(lambda (x) (numberp x)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result nil))) + (let ((result (cl-rassoc-if-not (lambda (x) (and (listp x) (= (length x) 1))) '(((1 2) . 1) ((3 4) . 2) ((5) . 2))))) + (should (equal result '((1 2) . 1))))) + +(ert-deftest cl-intersection-test () + (let ((result (cl-intersection '(1 2 3 4) '(3 4 5 6)))) + (should (equal result '(4 3)))) + (let ((result (cl-intersection '(1 2) '(3 4)))) + (should (equal result '()))) + (let ((result (cl-intersection '(1 2 3) '(1 2 3)))) + (should (equal result '(1 2 3)))) + (let ((result (cl-intersection '(1 1 2 3) '(1 2 2 3 4)))) + (should (equal result '(3 2 1 1)))) + (let ((result (cl-intersection '(1 "two" 3) '(3 "two" 4)))) + (should (equal result '(3)))) + (let ((result (cl-intersection '(1 2 3) '(3 2 1) :test 'equal))) + (should (equal result '(1 2 3)))) + (let ((result (cl-intersection '(1 2 3) '(3 4 5) :key #'identity))) + (should (equal result '(3)))) + (let ((result (cl-intersection '() '(1 2 3)))) + (should (equal result '()))) + (let ((result (cl-intersection '() '()))) + (should (equal result '()))) + (let ((result (cl-intersection '(1 2 3 4 5) '(3 4 5 6 7 8)))) + (should (equal result '(5 4 3))))) + +(ert-deftest cl-nintersection-test () + (let ((list1 '(1 2 3 4)) + (list2 '(3 4 5 6))) + (let ((result (cl-nintersection list1 list2))) + (should (equal result '(4 3))) + (should (equal list1 '(1 2 3 4))) + (should (equal list2 '(3 4 5 6))))) + (let ((list1 '(1 2)) + (list2 '(3 4))) + (let ((result (cl-nintersection list1 list2))) + (should (equal result '())) + (should (equal list1 '(1 2))) + (should (equal list2 '(3 4))))) + (let ((list1 '(1 2 3)) + (list2 '(1 2 3))) + (let ((result (cl-nintersection list1 list2))) + (should (equal result '(1 2 3))) + (should (equal list1 '(1 2 3))) + (should (equal list2 '(1 2 3))))) + (let ((list1 '(1 1 2 2 3)) + (list2 '(2 2 3 4))) + (let ((result (cl-nintersection list1 list2))) + (should (equal result '(3 2 2))) + (should (equal list1 '(1 1 2 2 3))) + (should (equal list2 '(2 2 3 4))))) + (let ((list1 '(1 "two" 3)) + (list2 '(3 "two" 4))) + (let ((result (cl-nintersection list1 list2))) + (should (equal result '(3))) + (should (equal list1 '(1 "two" 3))) + (should (equal list2 '(3 "two" 4))))) + (let ((list1 '(1 2 3)) + (list2 '(3 2 1))) + (let ((result (cl-nintersection list1 list2 :test 'equal))) + (should (equal result '(1 2 3))) + (should (equal list1 '(1 2 3))) + (should (equal list2 '(3 2 1))))) + (let ((list1 '()) + (list2 '(1 2 3))) + (let ((result (cl-nintersection list1 list2))) + (should (equal result '())) + (should (equal list1 '())) + (should (equal list2 '(1 2 3))))) + (let ((list1 '()) + (list2 '())) + (let ((result (cl-nintersection list1 list2))) + (should (equal result '()))))) + +(ert-deftest cl-set-difference-test () + (let ((result (cl-set-difference '(1 2 3 4) '(3 4 5 6)))) + (should (equal result '(1 2)))) + (let ((result (cl-set-difference '(1 2 3) '()))) + (should (equal result '(1 2 3)))) + (let ((result (cl-set-difference '(1 2 3) '(1 2 3)))) + (should (equal result '()))) + (let ((result (cl-set-difference '(1 1 2 3 4) '(3 4 5)))) + (should (equal result '(1 1 2)))) + (let ((result (cl-set-difference '(1 2 3) '(3 2 4)))) + (should (equal result '(1)))) + (let ((result (cl-set-difference '(1 2 3) '(3 2 1) :test 'equal))) + (should (equal result '()))) + (let ((result (cl-set-difference '((1 . "one") (2 . "two") (3 . "three")) + '((1 . "uno") (2 . "dos")) + :key 'car))) + (should (equal result '((3 . "three"))))) + (let ((result (cl-set-difference '() '(1 2 3)))) + (should (equal result '()))) + (let ((result (cl-set-difference '(1 2 3) '()))) + (should (equal result '(1 2 3)))) + (let ((result (cl-set-difference '(1 2 3 4 5) '(3 4 5 6 7)))) + (should (equal result '(1 2)))) + (let ((list1 '(1 2 3)) + (list2 '(2 3 4))) + (cl-set-difference list1 list2) + (should (equal list1 '(1 2 3))) + (should (equal list2 '(2 3 4))))) + +(ert-deftest cl-nset-difference-test () + (let ((list1 '(1 2 3 4)) + (list2 '(3 4 5 6))) + (let ((result (cl-nset-difference list1 list2))) + (should (equal result '(1 2))) + (should (equal list1 '(1 2 3 4))) + (should (equal list2 '(3 4 5 6))))) + (let ((list1 '(1 2 3)) + (list2 '())) + (let ((result (cl-nset-difference list1 list2))) + (should (equal result '(1 2 3))) + (should (equal list1 '(1 2 3))) + (should (equal list2 '())))) + (let ((list1 '(1 2 3)) + (list2 '(1 2 3))) + (let ((result (cl-nset-difference list1 list2))) + (should (equal result '())) + (should (equal list1 '(1 2 3))) + (should (equal list2 '(1 2 3))))) + (let ((list1 '(1 1 2 2 3)) + (list2 '(3 4 5))) + (let ((result (cl-nset-difference list1 list2))) + (should (equal result '(1 1 2 2))) + (should (equal list1 '(1 1 2 2 3))) + (should (equal list2 '(3 4 5))))) + (let ((list1 '(1 2 3)) + (list2 '(3 2 4))) + (let ((result (cl-nset-difference list1 list2))) + (should (equal result '(1))) + (should (equal list1 '(1 2 3))) + (should (equal list2 '(3 2 4))))) + (let ((list1 '(1 2 3)) + (list2 '(3 2 1))) + (let ((result (cl-nset-difference list1 list2 :test 'equal))) + (should (equal result '())) + (should (equal list1 '(1 2 3))) + (should (equal list2 '(3 2 1))))) + (let ((list1 '()) + (list2 '(1 2 3))) + (let ((result (cl-nset-difference list1 list2))) + (should (equal result '())) + (should (equal list1 '())) + (should (equal list2 '(1 2 3))))) + (let ((list1 '()) + (list2 '())) + (let ((result (cl-nset-difference list1 list2))) + (should (equal result '())))) + (let ((list1 '(1 2 3 4 5)) + (list2 '(3 4 5 6 7))) + (let ((result (cl-nset-difference list1 list2))) + (should (equal result '(1 2))) + (should (equal list1 '(1 2 3 4 5))) + (should (equal list2 '(3 4 5 6 7)))))) + +(ert-deftest cl-set-exclusive-or-test () + (let ((result (cl-set-exclusive-or '(1 2 3) '(3 4 5)))) + (should (equal result '(1 2 4 5)))) + (let ((result (cl-set-exclusive-or '(1 2 3) '()))) + (should (equal result '(1 2 3)))) + (let ((result (cl-set-exclusive-or '() '(3 4 5)))) + (should (equal result '(3 4 5)))) + (let ((result (cl-set-exclusive-or '(1 2 3) '(1 2 3)))) + (should (equal result nil))) + (let ((result (cl-set-exclusive-or '(1 1 2 3) '(3 4 5)))) + (should (equal result '(1 1 2 4 5)))) + (let ((result (cl-set-exclusive-or '(1 2 3) '(3 3 4 5)))) + (should (equal result '(1 2 4 5)))) + (let ((result (cl-set-exclusive-or '(1 2 3) '(3 2 4)))) + (should (equal result '(1 4)))) + (let ((result (cl-set-exclusive-or '(1 2 3) '(3 2 1) :test 'equal))) + (should (equal result '()))) + (let ((result (cl-set-exclusive-or '() '()))) + (should (equal result '()))) + (let ((result (cl-set-exclusive-or '(1 2 3 4 5) '(3 4 5 6 7))) + (list1 '(1 2 3 4 5)) + (list2 '(3 4 5 6 7))) + (should (equal result '(1 2 6 7))) + (should (equal list1 '(1 2 3 4 5))) + (should (equal list2 '(3 4 5 6 7))))) + +(ert-deftest cl-nset-exclusive-or-test () + (let ((list1 '(1 2 3)) + (list2 '(3 4 5))) + (let ((result (cl-nset-exclusive-or list1 list2))) + (should (equal result '(1 2 4 5))) + (should (equal list1 '(1 2 3))) + (should (equal list2 '(3 4 5))))) + (let ((list1 '(1 2 3)) + (list2 '())) + (let ((result (cl-nset-exclusive-or list1 list2))) + (should (equal result '(1 2 3))) + (should (equal list1 '(1 2 3))) + (should (equal list2 '())))) + (let ((list1 '(1 2 3)) + (list2 '(1 2 3))) + (let ((result (cl-nset-exclusive-or list1 list2))) + (should (equal result nil))) + (should (equal list1 '(1 2 3))) + (should (equal list2 '(1 2 3)))) + (let ((list1 '(1 1 2 2 3)) + (list2 '(3 4 5))) + (let ((result (cl-nset-exclusive-or list1 list2))) + (should (equal result '(1 1 2 2 4 5))) + (should (equal list1 '(1 1 2 2 3))) + (should (equal list2 '(3 4 5))))) + (let ((list1 '(1 2 3)) + (list2 '(3 3 4 5))) + (let ((result (cl-nset-exclusive-or list1 list2))) + (should (equal result '(1 2 4 5))) + (should (equal list1 '(1 2 3))) + (should (equal list2 '(3 3 4 5))))) + (let ((list1 '(1 2 3)) + (list2 '(3 2 4))) + (let ((result (cl-nset-exclusive-or list1 list2))) + (should (equal result '(1 4))) + (should (equal list1 '(1 2 3))) + (should (equal list2 '(3 2 4))))) + (let ((list1 '(1 2 3)) + (list2 '(3 2 1))) + (let ((result (cl-nset-exclusive-or list1 list2 :test 'equal))) + (should (equal result '())) + (should (equal list1 '(1 2 3))) + (should (equal list2 '(3 2 1))))) + (let ((list1 '()) + (list2 '(1 2 3))) + (let ((result (cl-nset-exclusive-or list1 list2))) + (should (equal result '(1 2 3))) + (should (equal list1 '())) + (should (equal list2 '(1 2 3))))) + (let ((list1 '()) + (list2 '())) + (let ((result (cl-nset-exclusive-or list1 list2))) + (should (equal result '())))) + (let ((list1 '(1 2 3 4 5)) + (list2 '(3 4 5 6 7))) + (let ((result (cl-nset-exclusive-or list1 list2))) + (should (equal result '(1 2 6 7))) + (should (equal list1 '(1 2 3 4 5))) + (should (equal list2 '(3 4 5 6 7)))))) + +(ert-deftest cl-subsetp-test () + (let ((result (cl-subsetp '(1 2) '(1 2 3 4)))) + (should (equal result t))) + (let ((result (cl-subsetp '() '(1 2 3 4)))) + (should (equal result t))) + (let ((result (cl-subsetp '(1 2) '()))) + (should (equal result nil))) + (let ((result (cl-subsetp '(1 2 3) '(1 2 3)))) + (should (equal result t))) + (let ((result (cl-subsetp '(1 1 2) '(1 2 3)))) + (should (equal result t))) + (let ((result (cl-subsetp '(1 2) '(1 1 2 3 4)))) + (should (equal result t))) + (let ((result (cl-subsetp '(1 "two" 3) '(3 "two" 1)))) + (should (equal result nil))) + (let ((result (cl-subsetp '(1 2) '(2 1) :test 'equal))) + (should (equal result t))) + (let ((result (cl-subsetp '((1 . "one") (2 . "two")) '((1 . "uno") (2 . "dos")) :key 'car))) + (should (equal result t))) + (let ((result (cl-subsetp '(1 2) '(3 4 2 1) :test 'eq))) + (should (equal result t))) + (let ((result (cl-subsetp '((1 2) (3)) '((1 2 . "found") (3 . "found")) :key 'car))) + (should (equal result t))) + (let ((result (cl-subsetp '(1 2) '(1 2 3 2)))) + (should (equal result t))) + (let ((result (cl-subsetp '() '()))) + (should (equal result t)))) + (provide 'cl-seq-tests) ;;; cl-seq-tests.el ends here diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-74245.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-74245.pl new file mode 100644 index 00000000000..44d1e49bd36 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-74245.pl @@ -0,0 +1,16 @@ +# This resource file can be run with cperl--run-testcases from +# cperl-tests.el and works with both perl-mode and cperl-mode. + +# -------- signature where last parameter is ignored: input ------- +package P { +use v5.36; +sub ignore ($first, $) {} +ignore(qw(first second)); +} +# -------- signature where last parameter is ignored: expected output ------- +package P { + use v5.36; + sub ignore ($first, $) {} + ignore(qw(first second)); +} +# -------- signature where last parameter is ignored: end ------- diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 0d8bdb8c419..a9cd9531e5a 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -622,10 +622,9 @@ Also includes valid cases with whitespace in strange places." "Test subroutine signatures." (skip-unless (eq cperl-test-mode #'cperl-mode)) (let ((valid - '("()" "( )" "($self, %params)" "(@params)")) + '("()" "( )" "($self, %params)" "(@params)" "($first,$)")) (invalid '("$self" ; missing paren - "($)" ; a subroutine signature "($!)" ; globals not permitted in a signature "(@par,%options)" ; two slurpy parameters "{$self}"))) ; wrong type of paren @@ -1590,6 +1589,16 @@ and the slash, then we have a division." (should (equal (nth 8 (cperl-test-ppss code "/")) 9))) ) +(ert-deftest cperl-test-bug-74245 () + "Verify that a bare \"$\" can appear at the end of a subroutine signature. +It must not be mistaken for \"$)\"." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (cperl--run-test-cases + (ert-resource-file "cperl-bug-74245.pl") + (while (null (eobp)) + (cperl-indent-command) + (forward-line 1)))) + (ert-deftest test-indentation () (ert-test-erts-file (ert-resource-file "cperl-indents.erts"))) diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index c3c5c6ab770..f9c64f792d1 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -697,58 +697,60 @@ visible_end.)" (with-temp-buffer (let ((parser (treesit-parser-create 'json))) (insert "11111111111111111111") - (treesit-parser-set-included-ranges parser '((1 . 20))) + (treesit-parser-set-included-ranges parser (copy-tree '((1 . 20)))) (treesit-parser-root-node parser) (should (equal (treesit-parser-included-ranges parser) - '((1 . 20)))) + (copy-tree '((1 . 20))))) (narrow-to-region 5 15) (should (equal (treesit-parser-included-ranges parser) - '((5 . 15)))) + (copy-tree '((5 . 15))))) (widen) ;; Trickier ranges ;; 11111111111111111111 ;; [ ] [ ] ;; { narrow } - (treesit-parser-set-included-ranges parser '((1 . 7) (10 . 15))) + (treesit-parser-set-included-ranges + parser (copy-tree '((1 . 7) (10 . 15)))) (should (equal (treesit-parser-included-ranges parser) - '((1 . 7) (10 . 15)))) + (copy-tree '((1 . 7) (10 . 15))))) (narrow-to-region 5 13) (should (equal (treesit-parser-included-ranges parser) - '((5 . 7) (10 . 13)))) + (copy-tree '((5 . 7) (10 . 13))))) ;; Narrow in front, and discard the last one. (widen) (treesit-parser-set-included-ranges - parser '((4 . 10) (12 . 14) (16 . 20))) + parser (copy-tree '((4 . 10) (12 . 14) (16 . 20)))) ;; 11111111111111111111 ;; [ ] [ ] [ ] ;; { } narrow (narrow-to-region 1 8) (should (equal (treesit-parser-included-ranges parser) - '((4 . 8)))) + (copy-tree '((4 . 8))))) ;; Narrow in back, and discard the first one. (widen) (treesit-parser-set-included-ranges - parser '((1 . 5) (7 . 9) (11 . 17))) + parser (copy-tree '((1 . 5) (7 . 9) (11 . 17)))) ;; 11111111111111111111 ;; [ ] [ ] [ ] ;; { } narrow (narrow-to-region 15 20) (should (equal (treesit-parser-included-ranges parser) - '((15 . 17)))) + (copy-tree '((15 . 17))))) ;; No overlap (widen) - (treesit-parser-set-included-ranges parser '((15 . 20))) + (treesit-parser-set-included-ranges + parser (copy-tree '((15 . 20)))) ;; 11111111111111111111 ;; [ ] ;; { } narrow (narrow-to-region 1 10) (should (equal (treesit-parser-included-ranges parser) - '((1 . 1))))))) + (copy-tree '((1 . 1)))))))) ;;; Multiple language @@ -1275,11 +1277,11 @@ This tests bug#60355." (ert-deftest treesit-imenu () "Test imenu functions." (should (equal (treesit--imenu-merge-entries - '(("Function" . (f1 f2)) - ("Function" . (f3 f4 f5)) - ("Class" . (c1 c2 c3)) - ("Variables" . (v1 v2)) - ("Class" . (c4)))) + (copy-tree '(("Function" . (f1 f2)) + ("Function" . (f3 f4 f5)) + ("Class" . (c1 c2 c3)) + ("Variables" . (v1 v2)) + ("Class" . (c4))))) '(("Function" . (f1 f2 f3 f4 f5)) ("Class" . (c1 c2 c3 c4)) ("Variables" . (v1 v2))))))