commit e7505ca213d77ea2f34caeb01d185e340641b5f4 (HEAD, refs/remotes/origin/master) Author: Elías Gabriel Pérez Date: Thu Oct 30 13:04:46 2025 -0600 Add option to auto-refresh the lossage buffer. (Bug#79732) * lisp/help.el (view-lossage-auto-refresh): New user option. (help--lossage-update): New variable. (help--lossage-make-recent-keys, help--refresh-lossage-buffer): New functions. (view-lossage): Rework. * doc/emacs/help.texi (Misc Help): * etc/NEWS: Document change. diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 6ea7b5783c2..879967ddfb2 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -716,8 +716,14 @@ use @kbd{C-h l} (@code{view-lossage}). @kbd{C-h l} displays your last input keystrokes and the commands they invoked. By default, Emacs stores the last 300 keystrokes; if you wish, you can change this number with the command @code{lossage-size}. -If you see commands that you are not familiar with, you can use @kbd{C-h k} or -@kbd{C-h f} to find out what they do. +If you see commands that you are not familiar with, use +@kbd{C-h k}, or press @kbd{RET} or click on them to find out what they do. + +@vindex view-lossage-auto-refresh +By default, after the lossage buffer is displayed it will not show the +most recent keystroke and command that you are currently typing, to +change this set the variable @code{view-lossage-auto-refresh} to +@code{t}. @kindex C-h e @findex view-echo-area-messages diff --git a/etc/NEWS b/etc/NEWS index 81117951302..7345c08218b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -690,6 +690,12 @@ or strings. If set to 'on-mismatch', mismatched parens inside comments and strings will not be highlighted. If set to nil (the default), highlight the parens wherever they are. ++++ +** New user option 'view-lossage-auto-refresh'. +If this option is non-nil, the lossage buffer in 'view-lossage' will be +refreshed automatically for each new input keystroke and command +performed. + ** Change in SVG foreground color handling. SVG images no longer have the 'fill' attribute set to the value of ':foreground' or the current text foreground color. The 'currentcolor' diff --git a/lisp/help.el b/lisp/help.el index 4ba99868c4a..8cf91faf174 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -517,6 +517,67 @@ If that doesn't give a function, return nil." (setq sym (intern-soft (match-string 1 str))) (and (fboundp sym) sym)))))))) + +;;; Lossage + +(defcustom view-lossage-auto-refresh nil + "Whether to auto-refresh the lossage buffer. +If non-nil, the lossage buffer will be refreshed automatically for each +new input keystroke and command performed." + :type 'boolean + :group 'help + :version "31.1") + +(defvar-local help--lossage-update nil + "Variable used to determine if lossage buffer should be refreshed.") + +(defun help--lossage-make-recent-keys (&optional most-recent) + "Return a string containing all the recent keys and its commands. +If MOST-RECENT is non-nil, only return the most recent key and its +command." + (let ((keys + (if most-recent + `[,@(this-single-command-raw-keys) (nil . ,this-command)] + (recent-keys 'include-cmds)))) + (mapconcat + (lambda (key) + (cond + ((and (consp key) (null (car key))) + (concat + ";; " + (if (symbolp (cdr key)) + (buttonize + (symbol-name (cdr key)) + (lambda (&rest _) + (interactive) + (describe-function (cdr key))) + "mouse-1: go to the documentation for this command.") + (propertize "anonymous-command" 'face 'shadow)) + "\n")) + ((or (integerp key) (symbolp key) (listp key)) + (propertize (single-key-description key) + 'face 'help-key-binding + 'rear-nonsticky t)) + (t + (propertize (prin1-to-string key nil) + 'face 'help-key-binding + 'rear-nonsticky t)))) + keys + " "))) + +(defun help--refresh-lossage-buffer () + (if-let* ((buf (get-buffer "*Help*")) + (_ (buffer-local-value 'help--lossage-update buf))) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-max)) + (insert-before-markers + (concat " " (help--lossage-make-recent-keys :most-recent))) + (forward-line -1) + (comment-indent)))) + (remove-hook 'post-command-hook #'help--refresh-lossage-buffer))) + ;;; `User' help functions @@ -692,43 +753,50 @@ the variable `message-log-max'." (interactive) (info "(efaq)Packages that do not come with Emacs")) -(defun view-lossage () +(defun view-lossage (&optional auto-refresh) "Display last few input keystrokes and the commands run. For convenience this uses the same format as `edit-last-kbd-macro'. See `lossage-size' to update the number of recorded keystrokes. +With argument, auto-refresh the lossage buffer for each new input +keystroke, see also `view-lossage-auto-refresh'. + To record all your input, use `open-dribble-file'." - (interactive) - (let ((help-buffer-under-preparation t)) - (help-setup-xref (list #'view-lossage) - (called-interactively-p 'interactive)) + (interactive "P") + (let ((help-buffer-under-preparation t) + (view-lossage-auto-refresh + (if auto-refresh t view-lossage-auto-refresh))) + (unless view-lossage-auto-refresh + ;; `view-lossage-auto-refresh' conflicts with xref buttons, add + ;; them if `view-lossage-auto-refresh' is nil. + (help-setup-xref (list #'view-lossage) + (called-interactively-p 'interactive))) (with-help-window (help-buffer) (princ " ") - (princ (mapconcat (lambda (key) - (cond - ((and (consp key) (null (car key))) - (format ";; %s\n" (if (symbolp (cdr key)) (cdr key) - "anonymous-command"))) - ((or (integerp key) (symbolp key) (listp key)) - (single-key-description key)) - (t - (prin1-to-string key nil)))) - (recent-keys 'include-cmds) - " ")) + (insert (help--lossage-make-recent-keys)) (with-current-buffer standard-output (goto-char (point-min)) - (let ((comment-start ";; ") - ;; Prevent 'comment-indent' from handling a single - ;; semicolon as the beginning of a comment. - (comment-start-skip ";; ") - (comment-use-syntax nil) - (comment-column 24)) - (while (not (eobp)) - (comment-indent) - (forward-line 1))) + (setq-local comment-start ";; " + ;; Prevent 'comment-indent' from handling a single + ;; semicolon as the beginning of a comment. + comment-start-skip ";; " + comment-use-syntax nil + comment-column 24) + (while (not (eobp)) + (comment-indent) + (forward-line 1)) ;; Show point near the end of "lossage", as we did in Emacs 24. - (set-marker help-window-point-marker (point)))))) + (set-marker help-window-point-marker (point)) + + (when view-lossage-auto-refresh + (setq-local help--lossage-update t) + (add-hook 'post-command-hook #'help--refresh-lossage-buffer)))) + + ;; `help-make-xrefs' adds a newline at the end of the buffer, which + ;; makes impossible to reposition point in `with-help-window'. + (when view-lossage-auto-refresh + (set-window-point (get-buffer-window (help-buffer)) (point-max))))) ;; Key bindings commit 2f6e5d2eda006cfa65a6f4e2aa0d63e20a47c0ec Author: Juri Linkov Date: Wed Nov 5 09:14:43 2025 +0200 * test/lisp/emacs-lisp/map-ynp-tests.el: Use 'eval-expression-debug-on-error'. (test-map-ynp-kmacro): Bind 'eval-expression-debug-on-error' to nil instead of silencing 'backtrace-print'. diff --git a/test/lisp/emacs-lisp/map-ynp-tests.el b/test/lisp/emacs-lisp/map-ynp-tests.el index 6a9c8213791..4e88e5865fe 100644 --- a/test/lisp/emacs-lisp/map-ynp-tests.el +++ b/test/lisp/emacs-lisp/map-ynp-tests.el @@ -33,7 +33,7 @@ (ert-deftest test-map-ynp-kmacro () "Test that `map-y-or-n-p' in a kmacro terminates on end of input." - (cl-letf* (((symbol-function #'backtrace-print) (lambda ()))) ;; bug#67836 + (let ((eval-expression-debug-on-error nil)) ;; bug#67836 (execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET y")) (should-error (execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET"))) commit e54fd7c012c9fb3bbccf64a128fb81a411c4310f Author: Po Lu Date: Wed Nov 5 11:10:11 2025 +0800 Fix compilation on Android SDK 20 and earlier * configure.ac (gl_PREREQ_NPROC): Disable ac_cv_header_mntent_h if on Android and setmntent is not declared. diff --git a/configure.ac b/configure.ac index 44d9cae1e7e..ccc8719c091 100644 --- a/configure.ac +++ b/configure.ac @@ -1599,6 +1599,12 @@ AC_DEFUN([gl_CRYPTO_CHECK]) # Avoid gnulib's tests for HAVE_WORKING_O_NOATIME and HAVE_WORKING_O_NOFOLLOW, # as we don't use them. AC_DEFUN([gl_FCNTL_O_FLAGS]) +# Disable nproc.c's usage of mntent.h if setmntent is undefined, as on +# Android SDK <= 20. +AC_DEFUN([gl_PREREQ_NPROC], + [AS_IF([test "$opsys" = "android"], + [AC_CHECK_DECL([setmntent], [], [ac_cv_header_mntent_h=no], + [[#include ]])])]m4_defn([gl_PREREQ_NPROC])) # Avoid gnulib's test for pthread_sigmask. funcs= for func in $ac_func_list; do commit 240355949e3d7b5ca944b057f6c21020b9ba5254 Author: Po Lu Date: Wed Nov 5 10:32:52 2025 +0800 Fix the Android port * configure.ac (gl_cv_onwards_func_tzalloc): Don't disable on Android SDK 35. * src/conf_post.h (tzalloc): Don't override Gnulib-selected identifier on Android SDK 35. diff --git a/configure.ac b/configure.ac index 6bec1adf63f..44d9cae1e7e 100644 --- a/configure.ac +++ b/configure.ac @@ -49,11 +49,6 @@ if test "$XCONFIGURE" = "android"; then CFLAGS="$CFLAGS -D_FILE_OFFSET_BITS=32" enable_largefile=no enable_year2038=no]) - # Gnulib should not attempt not to reimplement tzalloc, as strftime - # attempts to link with symbols that are only present in the Gnulib - # replacement. - AS_IF([test "$ANDROID_SDK" -ge "35"], - [gl_cv_onwards_func_tzalloc="future OS version"]) fi dnl Set emacs_config_options to the options of 'configure', quoted for the shell, diff --git a/src/conf_post.h b/src/conf_post.h index cf2e6dca4e5..aaf4fb59ffb 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -396,14 +396,3 @@ extern int emacs_setenv_TZ (char const *); : S_ISCHR (mode) ? DT_CHR : S_ISFIFO (mode) ? DT_FIFO \ : S_ISSOCK (mode) ? DT_SOCK : DT_UNKNOWN) #endif /* MSDOS */ - -#if defined __ANDROID__ && __ANDROID_API__ >= 35 -#define _GL_TIME_H -#include -#undef _GL_TIME_H - -/* Redefine tzalloc so as not to conflict with its - system-provided version, which is incompatible. - Do not redefine tzfree, as Gnulib does that. */ -#define tzalloc rpl_tzalloc -#endif /* defined __ANDROID__ && __ANDROID_API__ >= 35 */ commit abcc099c732489354f8f2be70b9a919fffeb3d84 Author: Po Lu Date: Wed Nov 5 10:06:23 2025 +0800 Fix the MS-DOS port and reading of symlink targets * doc/misc/eglot.texi (Eglot Features): Add comma after @xref. * msdos/sed2v2.inp (GNULIB_ISSYMLINK): Define to 1. * msdos/sedlibmk.inp (HAVE_RANDOM_H): Undefine, in line with its deletion from gnulib.mk. (GL_GNULIB_STRINGEQ): Define to 1. * src/msdos.c (careadlinkat): NULL terminate at the end of the data written, not one character beyond the same. diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 449b871b776..93268ce7c15 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -449,7 +449,7 @@ command (@pxref{Eglot Commands}). On-the-fly succinct informative annotations, so-called @dfn{inlay hints}. Eglot adds special intangible text nearby certain identifiers, be it the type of a variable, or the name of a formal parameter in a -function call. @xref{Eglot Commands} and the +function call. @xref{Eglot Commands}, and the @code{eglot-inlay-hints-mode} minor mode. @item diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index cb44aea4634..34ad3cc5a8d 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -140,6 +140,7 @@ s/^#undef HAVE_DECL_STRTOIMAX *$/#define HAVE_DECL_STRTOIMAX 1/ s/^#undef HAVE_PDUMPER *$/#define HAVE_PDUMPER 1/ s/^#undef HAVE_STRTOLL *$/#define HAVE_STRTOLL 1/ s/^#undef HAVE_STRTOULL *$/#define HAVE_STRTOULL 1/ +s/^#undef GNULIB_ISSYMLINK *$/#define GNULIB_ISSYMLINK 1/ /^#undef ALIGNOF_INT *$/s/^.*$/#define ALIGNOF_INT 4/ /^#undef ALIGNOF_LONG *$/s/^.*$/#define ALIGNOF_LONG 4/ /^#undef ALIGNOF_LONG_LONG *$/s/^.*$/#define ALIGNOF_LONG_LONG 4/ diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index 234943aa57e..b4368e06e9b 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -189,6 +189,7 @@ s/@PACKAGE@/emacs/ /^GL_GNULIB_MKOSTEMP *=/s/@GL_GNULIB_MKOSTEMP@/1/ /^GL_GNULIB_MKTIME *=/s/@GL_GNULIB_MKTIME@/1/ /^GL_GNULIB_SIGDESCR_NP *=/s/@GL_GNULIB_SIGDESCR_NP@/1/ +/^GL_GNULIB_STRINGEQ *=/s/@GL_GNULIB_STRINGEQ@/1/ /^GL_GNULIB_TIME_R *=/s/@GL_GNULIB_TIME_R@/1/ /^GL_GNULIB_TIMEGM *=/s/@GL_GNULIB_TIMEGM@/1/ /^GL_GNULIB_TIME_RZ *=/s/@GL_GNULIB_TIME_RZ@/1/ @@ -240,7 +241,6 @@ s/@PACKAGE@/emacs/ /^HAVE_PCLOSE *=/s/@HAVE_PCLOSE@/1/ /^HAVE_POPEN *=/s/@HAVE_POPEN@/1/ /^HAVE_POSIX_SIGNALBLOCKING *=/s/@HAVE_POSIX_SIGNALBLOCKING@/1/ -/^HAVE_RANDOM_H *=/s/@HAVE_RANDOM_H@/1/ /^HAVE_RAISE *=/s/@HAVE_RAISE@/1/ /^HAVE_RANDOM *=/s/@HAVE_RANDOM@/1/ /^HAVE_READDIR *=/s/@HAVE_READDIR@/1/ diff --git a/src/msdos.c b/src/msdos.c index ec36d0b2df3..0563e9b2422 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -3996,12 +3996,12 @@ careadlinkat (int fd, char const *filename, } else { - ssize_t len = preadlinkat (fd, filename, buffer, buffer_size); + ssize_t len = (*preadlinkat) (fd, filename, buffer, buffer_size); if (len < 0 || len == buffer_size) buffer = NULL; else - buffer[len + 1] = '\0'; + buffer[len] = '\0'; } return buffer; } commit 6ab56a31a52903e78da72e1122a72411a533e682 Author: Paul Eggert Date: Tue Nov 4 09:21:07 2025 -0800 Simplify tzfree use * src/timefns.c (Fdecode_time, Fencode_time) (Fcurrent_time_string): Do not bother to preserve errno around tzfree calls, as Gnulib now does that for us. diff --git a/src/timefns.c b/src/timefns.c index 75efea3560d..9176659cef1 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -1565,11 +1565,10 @@ usage: (decode-time &optional TIME ZONE FORM) */) struct tm local_tm, gmt_tm; timezone_t tz = tzlookup (zone, false); struct tm *tm = emacs_localtime_rz (tz, &time_spec, &local_tm); - int localtime_errno = errno; xtzfree (tz); if (!tm) - time_error (localtime_errno); + time_error (errno); /* Let YEAR = LOCAL_TM.tm_year + TM_YEAR_BASE. */ Lisp_Object year; @@ -1760,11 +1759,10 @@ usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) timezone_t tz = tzlookup (zone, false); tm.tm_wday = -1; time_t value = mktime_z (tz, &tm); - int mktime_errno = errno; xtzfree (tz); if (tm.tm_wday < 0) - time_error (mktime_errno); + time_error (errno); if (BASE_EQ (hz, make_fixnum (1))) return (current_time_list @@ -1875,10 +1873,9 @@ without consideration for daylight saving time. */) range -999 .. 9999. */ struct tm tm; struct tm *tmp = emacs_localtime_rz (tz, &value, &tm); - int localtime_errno = errno; xtzfree (tz); if (! tmp) - time_error (localtime_errno); + time_error (errno); static char const wday_name[][4] = { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }; commit 59fbaca6b9b48c217c60fc5ab21240ba104059e8 Author: Paul Eggert Date: Tue Nov 4 09:14:54 2025 -0800 Update from Gnulib by running admin/merge-gnulib * admin/merge-gnulib (GNULIB_MODULES): Add stringeq. With current Gnulib it is already present as in indirect dependency; listing it here because Emacs now depends on it directly. * lib-src/ebrowse.c, lib-src/etags.c: (streq): Remove, as Gnulib defines this now. * lib/fseterr.c, lib/fseterr.h, lib/issymlink.c, lib/issymlink.h: * lib/issymlinkat.c, lib/stdio-consolesafe.c, lib/string.c: * m4/fseterr.m4, m4/gettext_h.m4, m4/stringeq.m4: New files from Gnulib. * src/conf_post.h (tzfree) [__ANDROID_API__ >= 35]: Remove. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index ae852401eaf..61c386c3e35 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -49,7 +49,7 @@ GNULIB_MODULES=' sig2str sigdescr_np socklen stat-time std-gnu11 stdc_bit_width stdc_count_ones stdc_trailing_zeros stdckdint-h stddef-h stdio-h - stpcpy strnlen strnlen strtoimax symlink sys_stat-h sys_time-h + stpcpy stringeq strnlen strnlen strtoimax symlink sys_stat-h sys_time-h tempname time-h time_r time_rz timegm timer-time timespec-add timespec-sub update-copyright unlocked-io utimensat vla warnings year2038 diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 64dddad8290..d432325279c 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2025-07-31.19} +\def\texinfoversion{2025-10-25.20} % % Copyright 1985, 1986, 1988, 1990-2025 Free Software Foundation, Inc. % @@ -9952,7 +9952,7 @@ % node and anchor labels. And \xrdef uses it to construct the % lists of floats. % - \edef\tmp{\noexpand\setref{\floatlabel}{Yfloat}% + \edef\tmp{\noexpand\setref{\noexpand\floatlabel}{Yfloat}% {\floatmagic=\safefloattype}}% \tmp }% diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c index 61a45622933..391ca1151db 100644 --- a/lib-src/ebrowse.c +++ b/lib-src/ebrowse.c @@ -35,14 +35,6 @@ along with GNU Emacs. If not, see . */ enum { READ_CHUNK_SIZE = 100 * 1024 }; -/* Value is true if strings X and Y compare equal. */ - -static bool -streq (char const *x, char const *y) -{ - return strcmp (x, y) == 0; -} - static bool filename_eq (char const *x, char const *y) { diff --git a/lib-src/etags.c b/lib-src/etags.c index 6dde9c42e13..8c9d7336c8a 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -147,12 +147,6 @@ memcpyz (void *dest, void const *src, ptrdiff_t len) *e = '\0'; } -static bool -streq (char const *s, char const *t) -{ - return strcmp (s, t) == 0; -} - static bool strcaseeq (char const *s, char const *t) { diff --git a/lib/acl-internal.c b/lib/acl-internal.c index 6c50feacbb8..b8a6ed06c31 100644 --- a/lib/acl-internal.c +++ b/lib/acl-internal.c @@ -31,7 +31,7 @@ # include #endif -#if USE_ACL && HAVE_ACL_GET_FILE /* Linux, FreeBSD, NetBSD >= 10, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ +#if USE_ACL && HAVE_ACL_GET_FILE /* Linux, FreeBSD, NetBSD >= 10, Mac OS X, Cygwin >= 2.5 */ # if HAVE_ACL_TYPE_EXTENDED /* Mac OS X */ @@ -45,7 +45,7 @@ acl_extended_nontrivial (acl_t acl) return (acl_entries (acl) > 0); } -# else /* Linux, FreeBSD, NetBSD >= 10, IRIX, Tru64, Cygwin >= 2.5 */ +# else /* Linux, FreeBSD, NetBSD >= 10, Cygwin >= 2.5 */ /* ACL is an ACL, from a file, stored as type ACL_TYPE_ACCESS. Return 1 if the given ACL is non-trivial. @@ -118,9 +118,9 @@ acl_access_nontrivial (acl_t acl) - S-1-5-32-545 (group "Users") Cf. and look at the output of the 'mkgroup' command. */ - ignorable = (strcmp (group_sid, "S-1-5-18") == 0 - || strcmp (group_sid, "S-1-5-32-544") == 0 - || strcmp (group_sid, "S-1-5-32-545") == 0); + ignorable = (streq (group_sid, "S-1-5-18") + || streq (group_sid, "S-1-5-32-544") + || streq (group_sid, "S-1-5-32-545")); } } if (!ignorable) @@ -137,46 +137,6 @@ acl_access_nontrivial (acl_t acl) } return got_one; -# elif HAVE_ACL_TO_SHORT_TEXT /* IRIX */ - /* Don't use acl_get_entry: it is undocumented. */ - - int count = acl->acl_cnt; - int i; - - for (i = 0; i < count; i++) - { - acl_entry_t ace = &acl->acl_entry[i]; - acl_tag_t tag = ace->ae_tag; - - if (!(tag == ACL_USER_OBJ || tag == ACL_GROUP_OBJ - || tag == ACL_OTHER_OBJ)) - return 1; - } - return 0; - -# elif HAVE_ACL_FREE_TEXT /* Tru64 */ - /* Don't use acl_get_entry: it takes only one argument and does not work. */ - - int count = acl->acl_num; - acl_entry_t ace; - - for (ace = acl->acl_first; count > 0; ace = ace->next, count--) - { - acl_tag_t tag; - acl_perm_t perm; - - tag = ace->entry->acl_type; - if (!(tag == ACL_USER_OBJ || tag == ACL_GROUP_OBJ || tag == ACL_OTHER)) - return 1; - - perm = ace->entry->acl_perm; - /* On Tru64, perm can also contain non-standard bits such as - PERM_INSERT, PERM_DELETE, PERM_MODIFY, PERM_LOOKUP, ... */ - if ((perm & ~(ACL_READ | ACL_WRITE | ACL_EXECUTE)) != 0) - return 1; - } - return 0; - # else errno = ENOSYS; @@ -548,7 +508,7 @@ void free_permission_context (struct permission_context *ctx) { #if USE_ACL -# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, NetBSD >= 10, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ +# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, NetBSD >= 10, Mac OS X, Cygwin >= 2.5 */ if (ctx->acl) acl_free (ctx->acl); # if !HAVE_ACL_TYPE_EXTENDED diff --git a/lib/acl-internal.h b/lib/acl-internal.h index cb969e9797e..cf41e050ec4 100644 --- a/lib/acl-internal.h +++ b/lib/acl-internal.h @@ -68,7 +68,7 @@ _GL_INLINE_HEADER_BEGIN # if HAVE_ACL_GET_FILE /* POSIX 1003.1e (draft 17 -- abandoned) specific version. */ -/* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ +/* Linux, FreeBSD, Mac OS X, Cygwin >= 2.5 */ # ifndef MIN_ACL_ENTRIES # define MIN_ACL_ENTRIES 4 @@ -76,17 +76,7 @@ _GL_INLINE_HEADER_BEGIN /* POSIX 1003.1e (draft 17) */ # ifdef HAVE_ACL_GET_FD -/* Most platforms have a 1-argument acl_get_fd, only OSF/1 has a 2-argument - macro(!). */ -# if HAVE_ACL_FREE_TEXT /* OSF/1 */ -ACL_INTERNAL_INLINE acl_t -rpl_acl_get_fd (int fd) -{ - return acl_get_fd (fd, ACL_TYPE_ACCESS); -} -# undef acl_get_fd -# define acl_get_fd rpl_acl_get_fd -# endif +/* acl_get_fd takes one argument. */ # else # define HAVE_ACL_GET_FD false # undef acl_get_fd @@ -95,17 +85,7 @@ rpl_acl_get_fd (int fd) /* POSIX 1003.1e (draft 17) */ # ifdef HAVE_ACL_SET_FD -/* Most platforms have a 2-argument acl_set_fd, only OSF/1 has a 3-argument - macro(!). */ -# if HAVE_ACL_FREE_TEXT /* OSF/1 */ -ACL_INTERNAL_INLINE int -rpl_acl_set_fd (int fd, acl_t acl) -{ - return acl_set_fd (fd, ACL_TYPE_ACCESS, acl); -} -# undef acl_set_fd -# define acl_set_fd rpl_acl_set_fd -# endif +/* acl_set_fd takes two arguments. */ # else # define HAVE_ACL_SET_FD false # undef acl_set_fd @@ -136,7 +116,7 @@ rpl_acl_set_fd (int fd, acl_t acl) # endif /* Set to 0 if a file's mode is stored independently from the ACL. */ -# if (HAVE_ACL_COPY_EXT_NATIVE && HAVE_ACL_CREATE_ENTRY_NP) || defined __sgi /* Mac OS X, IRIX */ +# if HAVE_ACL_COPY_EXT_NATIVE && HAVE_ACL_CREATE_ENTRY_NP /* Mac OS X */ # define MODE_INSIDE_ACL 0 # endif @@ -260,7 +240,7 @@ extern int acl_nontrivial (int count, struct acl *entries); struct permission_context { mode_t mode; #if USE_ACL -# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ +# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, Cygwin >= 2.5 */ acl_t acl; # if !HAVE_ACL_TYPE_EXTENDED acl_t default_acl; diff --git a/lib/acl_entries.c b/lib/acl_entries.c index 57b7b4998c0..b78ba18a656 100644 --- a/lib/acl_entries.c +++ b/lib/acl_entries.c @@ -22,7 +22,7 @@ #include "acl-internal.h" /* This file assumes POSIX-draft like ACLs - (Linux, FreeBSD, NetBSD >= 10, Mac OS X, IRIX, Tru64, Cygwin >= 2.5). */ + (Linux, FreeBSD, NetBSD >= 10, Mac OS X, Cygwin >= 2.5). */ /* Return the number of entries in ACL. Return -1 and set errno upon failure to determine it. */ @@ -34,8 +34,7 @@ acl_entries (acl_t acl) if (acl != NULL) { -#if HAVE_ACL_FIRST_ENTRY /* Linux, FreeBSD, NetBSD >= 10, Mac OS X, Cygwin >= 2.5 */ -# if HAVE_ACL_TYPE_EXTENDED /* Mac OS X */ +#if HAVE_ACL_TYPE_EXTENDED /* Mac OS X */ /* acl_get_entry returns 0 when it successfully fetches an entry, and -1/EINVAL at the end. */ acl_entry_t ace; @@ -45,7 +44,7 @@ acl_entries (acl_t acl) got_one >= 0; got_one = acl_get_entry (acl, ACL_NEXT_ENTRY, &ace)) count++; -# else /* Linux, FreeBSD, NetBSD >= 10, Cygwin >= 2.5 */ +#else /* Linux, FreeBSD, NetBSD >= 10, Cygwin >= 2.5 */ /* acl_get_entry returns 1 when it successfully fetches an entry, and 0 at the end. */ acl_entry_t ace; @@ -57,17 +56,6 @@ acl_entries (acl_t acl) count++; if (got_one < 0) return -1; -# endif -#else /* IRIX, Tru64 */ -# if HAVE_ACL_TO_SHORT_TEXT /* IRIX */ - /* Don't use acl_get_entry: it is undocumented. */ - count = acl->acl_cnt; -# endif -# if HAVE_ACL_FREE_TEXT /* Tru64 */ - /* Don't use acl_get_entry: it takes only one argument and does not - work. */ - count = acl->acl_num; -# endif #endif } diff --git a/lib/boot-time.c b/lib/boot-time.c index 9104bae16ed..65d7aeaa4ac 100644 --- a/lib/boot-time.c +++ b/lib/boot-time.c @@ -88,7 +88,7 @@ get_boot_time_uncached (struct timespec *p_boot_time) /* Try to find the boot time in the /var/run/utmp file. */ -# if defined UTMP_NAME_FUNCTION /* glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, IRIX, Solaris, Cygwin, Android */ +# if defined UTMP_NAME_FUNCTION /* glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, Solaris, Cygwin, Android */ /* Ignore the return value for now. Solaris' utmpname returns 1 upon success -- which is contrary @@ -120,13 +120,13 @@ get_boot_time_uncached (struct timespec *p_boot_time) found_boot_time = ts; # if defined __linux__ && !defined __ANDROID__ - if (memcmp (UT_USER (ut), "runlevel", strlen ("runlevel") + 1) == 0 - && memcmp (ut->ut_line, "~", strlen ("~") + 1) == 0) + if (memeq (UT_USER (ut), "runlevel", strlen ("runlevel") + 1) + && memeq (ut->ut_line, "~", strlen ("~") + 1)) runlevel_ts = ts; # endif # if defined __minix if (UT_USER (ut)[0] == '\0' - && memcmp (ut->ut_line, "run-level ", strlen ("run-level ")) == 0) + && memeq (ut->ut_line, "run-level ", strlen ("run-level "))) runlevel_ts = ts; # endif } diff --git a/lib/byteswap.in.h b/lib/byteswap.in.h index 1227f01d144..6b4fbabf283 100644 --- a/lib/byteswap.in.h +++ b/lib/byteswap.in.h @@ -23,13 +23,16 @@ #error "Please include config.h first." #endif -#include - -_GL_INLINE_HEADER_BEGIN +/* Define this now, rather than after including stdint.h, in case + stdint.h recursively includes us. This is for Gnulib endian.h. */ #ifndef _GL_BYTESWAP_INLINE # define _GL_BYTESWAP_INLINE _GL_INLINE #endif +#include + +_GL_INLINE_HEADER_BEGIN + #ifdef __cplusplus extern "C" { #endif diff --git a/lib/c++defs.h b/lib/c++defs.h index df98a5ae57c..b77979a3259 100644 --- a/lib/c++defs.h +++ b/lib/c++defs.h @@ -310,7 +310,7 @@ _GL_CXXALIASWARN_1 (func, GNULIB_NAMESPACE) # define _GL_CXXALIASWARN_1(func,namespace) \ _GL_CXXALIASWARN_2 (func, namespace) -/* To work around GCC bug , +/* To work around GCC bug , we enable the warning only when not optimizing. */ # if !(defined __GNUC__ && !defined __clang__ && __OPTIMIZE__) # define _GL_CXXALIASWARN_2(func,namespace) \ @@ -338,7 +338,7 @@ GNULIB_NAMESPACE) # define _GL_CXXALIASWARN1_1(func,rettype,parameters_and_attributes,namespace) \ _GL_CXXALIASWARN1_2 (func, rettype, parameters_and_attributes, namespace) -/* To work around GCC bug , +/* To work around GCC bug , we enable the warning only when not optimizing. */ # if !(defined __GNUC__ && !defined __clang__ && __OPTIMIZE__) # define _GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \ diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c index 9ec3ca33224..8f4a3c1a70f 100644 --- a/lib/careadlinkat.c +++ b/lib/careadlinkat.c @@ -45,7 +45,7 @@ enum { STACK_BUF_SIZE = 1024 }; If GCC_LINT is defined, do not inline this function with GCC 10.1 and later, to avoid creating a pointer to the stack that GCC -Wreturn-local-addr incorrectly complains about. See: - https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93644 + https://gcc.gnu.org/PR93644 Although the noinline attribute can hurt performance a bit, no better way to pacify GCC is known; even an explicit #pragma does not pacify GCC. When the GCC bug is fixed this workaround should be limited to the @@ -174,7 +174,7 @@ careadlinkat (int fd, char const *filename, shrinking realloc. */ #ifdef GCC_BOGUS_WRETURN_LOCAL_ADDR #warning "GCC might issue a bogus -Wreturn-local-addr warning here." - #warning "See ." + #warning "See ." #endif char stack_buf[STACK_BUF_SIZE]; return readlink_stk (fd, filename, buffer, buffer_size, alloc, diff --git a/lib/cdefs.h b/lib/cdefs.h index 2682c092f0e..dce5739d235 100644 --- a/lib/cdefs.h +++ b/lib/cdefs.h @@ -277,10 +277,10 @@ */ #endif -/* GCC and clang have various useful declarations that can be made with - the '__attribute__' syntax. All of the ways we use this do fine if - they are omitted for compilers that don't understand it. */ -#if !(defined __GNUC__ || defined __clang__) +/* GCC, clang, and compatible compilers have various useful declarations + that can be made with the '__attribute__' syntax. All of the ways we use + this do fine if they are omitted for compilers that don't understand it. */ +#if !(defined __GNUC__ || defined __clang__ || defined __TINYC__) # define __attribute__(xyz) /* Ignore */ #endif diff --git a/lib/copy-file-range.c b/lib/copy-file-range.c index 2465a558028..208750bca6e 100644 --- a/lib/copy-file-range.c +++ b/lib/copy-file-range.c @@ -76,9 +76,9 @@ copy_file_range (int infd, off_t *pinoff, if (ok) { -# if defined __GLIBC__ && ! (2 < __GLIBC__ + (43 <= __GLIBC_MINOR__)) +# if defined __GLIBC__ && ! (2 < __GLIBC__ + (43 <= __GLIBC_MINOR__)) /* Work around glibc bug 33245 - . + . This bug is present in glibc 2.42 (2025) and fixed in 2.43, so this workaround, and the configure-time check for glibc, can be removed once glibc 2.42 and earlier is no longer a diff --git a/lib/dirent.in.h b/lib/dirent.in.h index 9d3bffa97ff..e6c59e5a41d 100644 --- a/lib/dirent.in.h +++ b/lib/dirent.in.h @@ -101,40 +101,6 @@ static_assert (DT_UNKNOWN != DT_FIFO && DT_UNKNOWN != DT_CHR /* Other optional information about a directory entry. */ #define _GL_DT_NOTDIR 0x100 /* Not a directory */ -/* Conversion between S_IF* and DT_* file types. */ -#if ! (defined IFTODT && defined DTTOIF) -# include -# ifdef S_ISWHT -# define _GL_DIRENT_S_ISWHT(mode) S_ISWHT(mode) -# else -# define _GL_DIRENT_S_ISWHT(mode) 0 -# endif -# ifdef S_IFWHT -# define _GL_DIRENT_S_IFWHT S_IFWHT -# else -# define _GL_DIRENT_S_IFWHT (DT_WHT << 12) /* just a guess */ -# endif -#endif -/* Conversion from a 'stat' mode to a DT_* value. */ -#ifndef IFTODT -# define IFTODT(mode) \ - (S_ISREG (mode) ? DT_REG : S_ISDIR (mode) ? DT_DIR \ - : S_ISLNK (mode) ? DT_LNK : S_ISBLK (mode) ? DT_BLK \ - : S_ISCHR (mode) ? DT_CHR : S_ISFIFO (mode) ? DT_FIFO \ - : S_ISSOCK (mode) ? DT_SOCK \ - : _GL_DIRENT_S_ISWHT (mode) ? DT_WHT : DT_UNKNOWN) -#endif -/* Conversion from a DT_* value to a 'stat' mode. */ -#ifndef DTTOIF -# define DTTOIF(dirtype) \ - ((dirtype) == DT_REG ? S_IFREG : (dirtype) == DT_DIR ? S_IFDIR \ - : (dirtype) == DT_LNK ? S_IFLNK : (dirtype) == DT_BLK ? S_IFBLK \ - : (dirtype) == DT_CHR ? S_IFCHR : dirtype == DT_FIFO ? S_IFIFO \ - : (dirtype) == DT_SOCK ? S_IFSOCK \ - : (dirtype) == DT_WHT ? _GL_DIRENT_S_IFWHT \ - : (dirtype) << 12 /* just a guess */) -#endif - #if !@DIR_HAS_FD_MEMBER@ # if !GNULIB_defined_DIR /* struct gl_directory is a type with a field 'int fd_to_close'. @@ -426,5 +392,44 @@ _GL_WARN_ON_USE (alphasort, "alphasort is unportable - " #endif +/* Includes that provide only macros that don't need to be overridden. + (Includes that are needed for type definitions and function declarations + have their place above, before the function overrides.) */ + +/* Conversion between S_IF* and DT_* file types. */ +#if ! (defined IFTODT && defined DTTOIF) +# include +# ifdef S_ISWHT +# define _GL_DIRENT_S_ISWHT(mode) S_ISWHT(mode) +# else +# define _GL_DIRENT_S_ISWHT(mode) 0 +# endif +# ifdef S_IFWHT +# define _GL_DIRENT_S_IFWHT S_IFWHT +# else +# define _GL_DIRENT_S_IFWHT (DT_WHT << 12) /* just a guess */ +# endif +#endif +/* Conversion from a 'stat' mode to a DT_* value. */ +#ifndef IFTODT +# define IFTODT(mode) \ + (S_ISREG (mode) ? DT_REG : S_ISDIR (mode) ? DT_DIR \ + : S_ISLNK (mode) ? DT_LNK : S_ISBLK (mode) ? DT_BLK \ + : S_ISCHR (mode) ? DT_CHR : S_ISFIFO (mode) ? DT_FIFO \ + : S_ISSOCK (mode) ? DT_SOCK \ + : _GL_DIRENT_S_ISWHT (mode) ? DT_WHT : DT_UNKNOWN) +#endif +/* Conversion from a DT_* value to a 'stat' mode. */ +#ifndef DTTOIF +# define DTTOIF(dirtype) \ + ((dirtype) == DT_REG ? S_IFREG : (dirtype) == DT_DIR ? S_IFDIR \ + : (dirtype) == DT_LNK ? S_IFLNK : (dirtype) == DT_BLK ? S_IFBLK \ + : (dirtype) == DT_CHR ? S_IFCHR : dirtype == DT_FIFO ? S_IFIFO \ + : (dirtype) == DT_SOCK ? S_IFSOCK \ + : (dirtype) == DT_WHT ? _GL_DIRENT_S_IFWHT \ + : (dirtype) << 12 /* just a guess */) +#endif + + #endif /* _@GUARD_PREFIX@_DIRENT_H */ #endif /* _@GUARD_PREFIX@_DIRENT_H */ diff --git a/lib/endian.in.h b/lib/endian.in.h index e81aa7da8ce..03f541967fb 100644 --- a/lib/endian.in.h +++ b/lib/endian.in.h @@ -109,6 +109,15 @@ _GL_INLINE_HEADER_BEGIN extern "C" { #endif +/* These declarations are needed if Gnulib byteswap.h -> stdint.h -> + sys/types.h -> endian.h -> Gnulib byteswap.h, the last of which is blocked + by its include guard so the functions are not yet declared. */ +#ifdef _GL_BYTESWAP_INLINE +_GL_BYTESWAP_INLINE uint_least16_t bswap_16 (uint_least16_t); +_GL_BYTESWAP_INLINE uint_least32_t bswap_32 (uint_least32_t); +_GL_BYTESWAP_INLINE uint_least64_t bswap_64 (uint_least64_t); +#endif + /* Big endian to host. */ _GL_ENDIAN_INLINE uint16_t diff --git a/lib/errno.in.h b/lib/errno.in.h index ba5dd371005..3db2853cf10 100644 --- a/lib/errno.in.h +++ b/lib/errno.in.h @@ -148,27 +148,11 @@ # endif -/* On OSF/1 5.1, when _XOPEN_SOURCE_EXTENDED is not defined, the macros - EMULTIHOP, ENOLINK, EOVERFLOW are not defined. */ -# if @EMULTIHOP_HIDDEN@ -# define EMULTIHOP @EMULTIHOP_VALUE@ -# define GNULIB_defined_EMULTIHOP 1 -# endif -# if @ENOLINK_HIDDEN@ -# define ENOLINK @ENOLINK_VALUE@ -# define GNULIB_defined_ENOLINK 1 -# endif -# if @EOVERFLOW_HIDDEN@ -# define EOVERFLOW @EOVERFLOW_VALUE@ -# define GNULIB_defined_EOVERFLOW 1 -# endif - - /* On OpenBSD 4.0 and on native Windows, the macros ENOMSG, EIDRM, ENOLINK, EPROTO, EMULTIHOP, EBADMSG, EOVERFLOW, ENOTSUP, ECANCELED are not defined. Likewise, on NonStop Kernel, EDQUOT is not defined. Define them here. Values >= 2000 seem safe to use: Solaris ESTALE = 151, - HP-UX EWOULDBLOCK = 246, IRIX EDQUOT = 1133. + HP-UX EWOULDBLOCK = 246. Note: When one of these systems defines some of these macros some day, binaries will have to be recompiled so that they recognizes the new diff --git a/lib/euidaccess.c b/lib/euidaccess.c index 05e1f2a6ddd..67b9a94544f 100644 --- a/lib/euidaccess.c +++ b/lib/euidaccess.c @@ -79,7 +79,7 @@ euidaccess (const char *file, int mode) { #if HAVE_FACCESSAT /* glibc, AIX 7, Solaris 11, Cygwin 1.7 */ return faccessat (AT_FDCWD, file, mode, AT_EACCESS); -#elif defined EFF_ONLY_OK /* IRIX, OSF/1, Interix */ +#elif defined EFF_ONLY_OK /* Interix */ return access (file, mode | EFF_ONLY_OK); #elif defined ACC_SELF /* AIX */ return accessx (file, mode, ACC_SELF); diff --git a/lib/faccessat.c b/lib/faccessat.c index abb912090a9..743f3728871 100644 --- a/lib/faccessat.c +++ b/lib/faccessat.c @@ -22,7 +22,7 @@ #define _GL_INCLUDING_UNISTD_H #include -/* Specification. */ +/* Get the original definition of faccessat. */ #include #include @@ -40,14 +40,8 @@ orig_faccessat (int fd, char const *name, int mode, int flag) } #endif -#ifdef __osf__ -/* Write "unistd.h" here, not , otherwise OSF/1 5.1 DTK cc - eliminates this include because of the preliminary #include - above. */ -# include "unistd.h" -#else -# include -#endif +/* Specification. */ +#include #ifndef HAVE_ACCESS /* Mingw lacks access, but it also lacks real vs. effective ids, so diff --git a/lib/fchmodat.c b/lib/fchmodat.c index 8853d7a3ae8..9151778b8e3 100644 --- a/lib/fchmodat.c +++ b/lib/fchmodat.c @@ -22,7 +22,7 @@ #define __need_system_sys_stat_h #include -/* Specification. */ +/* Get the original definition of fchmodat. */ #include #undef __need_system_sys_stat_h @@ -41,17 +41,13 @@ orig_fchmodat (int dir, char const *file, mode_t mode, int flags) #include #include -#ifdef __osf__ -/* Write "sys/stat.h" here, not , otherwise OSF/1 5.1 DTK cc - eliminates this include because of the preliminary #include - above. */ -# include "sys/stat.h" -#else -# include -#endif +/* Specification. */ +#include #include +#include "issymlink.h" + /* Invoke chmod or lchmod on FILE, using mode MODE, in the directory open on descriptor FD. If possible, do it without changing the working directory. Otherwise, resort to using save_cwd/fchdir, @@ -84,29 +80,30 @@ fchmodat (int dir, char const *file, mode_t mode, int flags) if (flags == AT_SYMLINK_NOFOLLOW) { # if HAVE_READLINKAT - char readlink_buf[1]; - # ifdef O_PATH /* Open a file descriptor with O_NOFOLLOW, to make sure we don't follow symbolic links, if /proc is mounted. O_PATH is used to avoid a failure if the file is not readable. - Cf. */ + Cf. */ int fd = openat (dir, file, O_PATH | O_NOFOLLOW | O_CLOEXEC); if (fd < 0) return fd; int err; - if (0 <= readlinkat (fd, "", readlink_buf, sizeof readlink_buf)) - err = EOPNOTSUPP; - else if (errno == EINVAL) - { - static char const fmt[] = "/proc/self/fd/%d"; - char buf[sizeof fmt - sizeof "%d" + INT_BUFSIZE_BOUND (int)]; - sprintf (buf, fmt, fd); - err = chmod (buf, mode) == 0 ? 0 : errno == ENOENT ? -1 : errno; - } - else - err = errno == ENOENT ? -1 : errno; + { + int ret = issymlinkat (fd, ""); + if (ret > 0) + err = EOPNOTSUPP; + else if (ret == 0) + { + static char const fmt[] = "/proc/self/fd/%d"; + char buf[sizeof fmt - sizeof "%d" + INT_BUFSIZE_BOUND (int)]; + sprintf (buf, fmt, fd); + err = chmod (buf, mode) == 0 ? 0 : errno == ENOENT ? -1 : errno; + } + else + err = errno == ENOENT ? -1 : errno; + } close (fd); @@ -117,7 +114,7 @@ fchmodat (int dir, char const *file, mode_t mode, int flags) /* O_PATH + /proc is not supported. */ - if (0 <= readlinkat (dir, file, readlink_buf, sizeof readlink_buf)) + if (issymlinkat (dir, file) > 0) { errno = EOPNOTSUPP; return -1; diff --git a/lib/fcntl.c b/lib/fcntl.c index 69cac9a5951..f47ebde105c 100644 --- a/lib/fcntl.c +++ b/lib/fcntl.c @@ -376,12 +376,6 @@ fcntl (int fd, int action, /* arg */...) #ifdef F_NOTIFY /* Linux */ case F_NOTIFY: #endif - #ifdef F_OPLKACK /* IRIX */ - case F_OPLKACK: - #endif - #ifdef F_OPLKREG /* IRIX */ - case F_OPLKREG: - #endif #ifdef F_RDAHEAD /* macOS */ case F_RDAHEAD: #endif diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h index c5068ed48a0..3fbbf4b0e4a 100644 --- a/lib/fcntl.in.h +++ b/lib/fcntl.in.h @@ -249,6 +249,46 @@ _GL_WARN_ON_USE (openat, "openat is not portable - " # endif #endif +#if @GNULIB_OPENAT2@ +# if !defined RESOLVE_NO_XDEV && defined __has_include +# if __has_include () +# include +# endif +# endif +# ifndef RESOLVE_NO_XDEV +struct open_how +{ +# ifdef __UINT64_TYPE__ + __UINT64_TYPE__ flags, mode, resolve; +# else + unsigned long long int flags, mode, resolve; +# endif +}; +# define RESOLVE_NO_XDEV 0x01 +# define RESOLVE_NO_MAGICLINKS 0x02 +# define RESOLVE_NO_SYMLINKS 0x04 +# define RESOLVE_BENEATH 0x08 +# define RESOLVE_IN_ROOT 0x10 +# define RESOLVE_CACHED 0x20 +# endif + +# if !@HAVE_OPENAT2@ +_GL_FUNCDECL_SYS (openat2, int, + (int fd, char const *file, struct open_how const *how, + size_t size), + _GL_ARG_NONNULL ((2, 3))); +# endif +_GL_CXXALIAS_SYS (openat2, int, + (int fd, char const *file, struct open_how const *how, + size_t size)); +_GL_CXXALIASWARN (openat2); +#elif defined GNULIB_POSIXCHECK +# undef openat2 +# if HAVE_RAW_DECL_OPENAT2 +_GL_WARN_ON_USE (openat2, "openat2 is not portable - " + "use gnulib module openat2 for portability"); +# endif +#endif /* Fix up the FD_* macros, only known to be missing on mingw. */ @@ -293,11 +333,6 @@ _GL_WARN_ON_USE (openat, "openat is not portable - " # endif #endif -#if !defined O_DIRECT && defined O_DIRECTIO -/* Tru64 spells it 'O_DIRECTIO'. */ -# define O_DIRECT O_DIRECTIO -#endif - #if !defined O_CLOEXEC && defined O_NOINHERIT /* Mingw spells it 'O_NOINHERIT'. */ # define O_CLOEXEC O_NOINHERIT diff --git a/lib/file-has-acl.c b/lib/file-has-acl.c index a9cfbf3a16e..d2fa69a2834 100644 --- a/lib/file-has-acl.c +++ b/lib/file-has-acl.c @@ -261,7 +261,7 @@ get_aclinfo (int fd, char const *name, struct aclinfo *ai, int flags) first case, and ENODATA in the latter. */ if (r == 0) scontext_err = ENOTSUP; - if (r == 10 && memcmp (ai->scontext, "unlabeled", 10) == 0) + if (r == 10 && memeq (ai->scontext, "unlabeled", 10)) { freecon (ai->scontext); scontext_err = ENODATA; @@ -364,9 +364,9 @@ acl_nfs4_nontrivial (uint32_t *xattr, ssize_t nbytes) /* For a trivial ACL, max 6 (typically 3) ACEs, 3 allow, 3 deny. Check that there is at most one ACE of each TYPE and WHO. */ int who2 - = (wholen == 6 && memcmp (xattr, "OWNER@", 6) == 0 ? 0 - : wholen == 6 && memcmp (xattr, "GROUP@", 6) == 0 ? 2 - : wholen == 9 && memcmp (xattr, "EVERYONE@", 9) == 0 ? 4 + = (wholen == 6 && memeq (xattr, "OWNER@", 6) ? 0 + : wholen == 6 && memeq (xattr, "GROUP@", 6) ? 2 + : wholen == 9 && memeq (xattr, "EVERYONE@", 9) ? 4 : -1); if (who2 < 0) return 1; @@ -384,9 +384,9 @@ acl_nfs4_nontrivial (uint32_t *xattr, ssize_t nbytes) #if (!USE_LINUX_XATTR && USE_ACL && HAVE_ACL_GET_FILE \ && !HAVE_ACL_EXTENDED_FILE && !HAVE_ACL_TYPE_EXTENDED) -/* FreeBSD, NetBSD >= 10, IRIX, Tru64, Cygwin >= 2.5 */ +/* FreeBSD, NetBSD >= 10, Cygwin >= 2.5 */ -# if HAVE_ACL_GET_FD && !HAVE_ACL_GET_LINK_NP /* IRIX, Tru64, Cygwin >= 2.5 */ +# if HAVE_ACL_GET_FD && !HAVE_ACL_GET_LINK_NP /* Cygwin >= 2.5 */ # include # ifdef O_PATH # define acl_get_fd_np(fd, type) acl_get_fd (fd) @@ -522,7 +522,7 @@ fdfile_has_aclinfo (MAYBE_UNUSED int fd, { /* POSIX 1003.1e (draft 17 -- abandoned) specific version. */ - /* Linux, FreeBSD, NetBSD >= 10, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ + /* Linux, FreeBSD, NetBSD >= 10, Mac OS X, Cygwin >= 2.5 */ int ret; # if HAVE_ACL_EXTENDED_FILE /* Linux */ @@ -553,7 +553,7 @@ fdfile_has_aclinfo (MAYBE_UNUSED int fd, } else ret = -1; -# else /* FreeBSD, NetBSD >= 10, IRIX, Tru64, Cygwin >= 2.5 */ +# else /* FreeBSD, NetBSD >= 10, Cygwin >= 2.5 */ acl_t acl = acl_get_fdfile (fd, name, ACL_TYPE_ACCESS, flags); if (acl) @@ -562,12 +562,7 @@ fdfile_has_aclinfo (MAYBE_UNUSED int fd, int saved_errno = errno; acl_free (acl); errno = saved_errno; -# if HAVE_ACL_FREE_TEXT /* Tru64 */ - /* On OSF/1, acl_get_file (name, ACL_TYPE_DEFAULT) always - returns NULL with errno not set. There is no point in - making this call. */ -# else /* FreeBSD, NetBSD >= 10, IRIX, Cygwin >= 2.5 */ - /* On Linux, FreeBSD, NetBSD, IRIX, + /* On Linux, FreeBSD, NetBSD, acl_get_file (name, ACL_TYPE_ACCESS) and acl_get_file (name, ACL_TYPE_DEFAULT) on a directory either both succeed or both fail; it depends on the @@ -580,26 +575,25 @@ fdfile_has_aclinfo (MAYBE_UNUSED int fd, acl = acl_get_fdfile (fd, name, ACL_TYPE_DEFAULT, flags); if (acl) { -# ifdef __CYGWIN__ /* Cygwin >= 2.5 */ +# ifdef __CYGWIN__ /* Cygwin >= 2.5 */ ret = acl_access_nontrivial (acl); saved_errno = errno; acl_free (acl); errno = saved_errno; -# else +# else ret = (0 < acl_entries (acl)); acl_free (acl); -# endif +# endif } else { ret = -1; -# ifdef __CYGWIN__ /* Cygwin >= 2.5 */ +# ifdef __CYGWIN__ /* Cygwin >= 2.5 */ if (d_type == DT_UNKNOWN) ret = 0; -# endif +# endif } } -# endif } else ret = -1; diff --git a/lib/fpending.c b/lib/fpending.c index 529bc7f6517..5aaa33f58a4 100644 --- a/lib/fpending.c +++ b/lib/fpending.c @@ -25,8 +25,8 @@ #include "stdio-impl.h" /* This file is not used on systems that already have the __fpending function, - namely glibc >= 2.2, Solaris >= 7, UnixWare >= 7.1.4.MP4, Cygwin >= 1.7.34, - Android API >= 23, musl libc, Haiku >= hrev58760. */ + namely glibc >= 2.2, OpenBSD >= 7.6, Solaris >= 7, UnixWare >= 7.1.4.MP4, + Cygwin >= 1.7.34, Android API >= 23, musl libc, Haiku >= hrev58760. */ /* Return the number of pending (aka buffered, unflushed) bytes on the stream, FP, that is open for writing. */ @@ -39,14 +39,14 @@ __fpending (FILE *fp) #if defined _IO_EOF_SEEN || defined _IO_ftrylockfile || __GNU_LIBRARY__ == 1 /* GNU libc, BeOS, Haiku, Linux libc5 */ return fp->_IO_write_ptr - fp->_IO_write_base; -#elif defined __sferror || defined __OpenBSD__ || defined __DragonFly__ || defined __ANDROID__ - /* FreeBSD, NetBSD, OpenBSD, DragonFly, Mac OS X, Cygwin < 1.7.34, Minix 3, Android */ +#elif defined __sferror || defined __DragonFly__ || defined __ANDROID__ + /* FreeBSD, NetBSD, OpenBSD < 7.6, DragonFly, Mac OS X, Cygwin < 1.7.34, Minix 3, Android */ return fp_->_p - fp_->_bf._base; #elif defined __EMX__ /* emx+gcc */ return fp->_ptr - fp->_buffer; #elif defined __minix /* Minix */ return fp_->_ptr - fp_->_buf; -#elif defined _IOERR /* AIX, HP-UX, IRIX, OSF/1, Solaris, OpenServer, UnixWare, mingw, MSVC, NonStop Kernel, OpenVMS */ +#elif defined _IOERR /* AIX, HP-UX, Solaris, OpenServer, UnixWare, mingw, MSVC, NonStop Kernel, OpenVMS */ return (fp_->_ptr ? fp_->_ptr - fp_->_base : 0); #elif defined __UCLIBC__ /* uClibc */ return (fp->__modeflags & __FLAG_WRITING ? fp->__bufpos - fp->__bufstart : 0); diff --git a/lib/free.c b/lib/free.c index 98ceafd7da2..394d8d13905 100644 --- a/lib/free.c +++ b/lib/free.c @@ -33,7 +33,7 @@ rpl_free (void *p) { # if defined __GNUC__ && !defined __clang__ /* An invalid GCC optimization - + would optimize away the assignments in the code below, when link-time optimization (LTO) is enabled. Make the code more complicated, so that GCC does not grok how to optimize it. */ diff --git a/lib/fseterr.c b/lib/fseterr.c new file mode 100644 index 00000000000..40aca95c8eb --- /dev/null +++ b/lib/fseterr.c @@ -0,0 +1,84 @@ +/* Set the error indicator of a stream. + Copyright (C) 2007-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 . */ + +#include + +/* Specification. */ +#include "fseterr.h" + +#include + +#include "stdio-impl.h" + +/* This file is not used on systems that have the __fseterr function, + namely OpenBSD >= 7.6, musl libc, Haiku >= hrev58760. */ + +void +fseterr (FILE *fp) +{ + /* Most systems provide FILE as a struct and the necessary bitmask in + , because they need it for implementing getc() and putc() as + fast macros. */ +#if defined _IO_EOF_SEEN || defined _IO_ftrylockfile || __GNU_LIBRARY__ == 1 + /* GNU libc, BeOS, Haiku, Linux libc5 */ + fp->_flags |= _IO_ERR_SEEN; +#elif defined __sferror || defined __DragonFly__ || defined __ANDROID__ + /* FreeBSD, NetBSD, OpenBSD < 7.6, DragonFly, Mac OS X, Cygwin, Minix 3, Android */ + fp_->_flags |= __SERR; +#elif defined __EMX__ /* emx+gcc */ + fp->_flags |= _IOERR; +#elif defined __minix /* Minix */ + fp->_flags |= _IOERR; +#elif defined _IOERR /* AIX, HP-UX, Solaris, OpenServer, UnixWare, mingw, MSVC, NonStop Kernel, OpenVMS */ + fp_->_flag |= _IOERR; +#elif defined __UCLIBC__ /* uClibc */ + fp->__modeflags |= __FLAG_ERROR; +#elif defined __QNX__ /* QNX */ + fp->_Mode |= 0x200 /* _MERR */; +#elif defined __MINT__ /* Atari FreeMiNT */ + fp->__error = 1; +#elif defined EPLAN9 /* Plan9 */ + if (fp->state != 0 /* CLOSED */) + fp->state = 5 /* ERR */; +#elif 0 /* unknown */ + /* Portable fallback, based on an idea by Rich Felker. + Wow! 6 system calls for something that is just a bit operation! + Not activated on any system, because there is no way to repair FP when + the sequence of system calls fails, and library code should not call + abort(). */ + int saved_errno; + int fd; + int fd2; + + saved_errno = errno; + fflush (fp); + fd = fileno (fp); + fd2 = dup (fd); + if (fd2 >= 0) + { + close (fd); + fputc ('\0', fp); /* This should set the error indicator. */ + fflush (fp); /* Or this. */ + if (dup2 (fd2, fd) < 0) + /* Whee... we botched the stream and now cannot restore it! */ + abort (); + close (fd2); + } + errno = saved_errno; +#else + #error "Please port gnulib fseterr.c to your platform! Look at the definitions of ferror and clearerr on your system, then report this to bug-gnulib." +#endif +} diff --git a/lib/fseterr.h b/lib/fseterr.h new file mode 100644 index 00000000000..57c30ef3d75 --- /dev/null +++ b/lib/fseterr.h @@ -0,0 +1,55 @@ +/* Set the error indicator of a stream. + Copyright (C) 2007, 2009-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 . */ + +#ifndef _FSETERR_H +#define _FSETERR_H + +/* This file uses HAVE___FSETERR. */ +#if !_GL_CONFIG_H_INCLUDED + #error "Please include config.h first." +#endif + +#include + +/* Set the error indicator of the stream FP. + The "error indicator" is set when an I/O operation on the stream fails, and + is cleared (together with the "end-of-file" indicator) by clearerr (FP). */ + +#if HAVE___FSETERR /* musl libc */ + +/* Haiku has __fseterr but does not declare it. */ +# if defined __HAIKU__ +extern void __fseterr (FILE *fp); +# endif + +# include +# define fseterr(fp) __fseterr (fp) + +#else + +# ifdef __cplusplus +extern "C" { +# endif + +extern void fseterr (FILE *fp); + +# ifdef __cplusplus +} +# endif + +#endif + +#endif /* _FSETERR_H */ diff --git a/lib/fstatat.c b/lib/fstatat.c index 36dd5e9a200..6029de78842 100644 --- a/lib/fstatat.c +++ b/lib/fstatat.c @@ -36,14 +36,8 @@ orig_fstatat (int fd, char const *filename, struct stat *buf, int flags) } #endif -#ifdef __osf__ -/* Write "sys/stat.h" here, not , otherwise OSF/1 5.1 DTK cc - eliminates this include because of the preliminary #include - above. */ -# include "sys/stat.h" -#else -# include -#endif +/* Specification. */ +#include #include "stat-time.h" diff --git a/lib/fsusage.c b/lib/fsusage.c index e26bda88aa6..64a12c5d48e 100644 --- a/lib/fsusage.c +++ b/lib/fsusage.c @@ -148,15 +148,6 @@ get_fs_usage (char const *file, char const *disk, struct fs_usage *fsp) ? PROPAGATE_ALL_ONES (fsd.f_frsize) : PROPAGATE_ALL_ONES (fsd.f_bsize)); -#elif defined STAT_STATFS3_OSF1 /* OSF/1 */ - - struct statfs fsd; - - if (statfs (file, &fsd, sizeof (struct statfs)) != 0) - return -1; - - fsp->fsu_blocksize = PROPAGATE_ALL_ONES (fsd.f_fsize); - #elif defined STAT_STATFS2_FRSIZE /* 2.6 < glibc/Linux < 2.6.36 */ struct statfs fsd; @@ -201,7 +192,7 @@ get_fs_usage (char const *file, char const *disk, struct fs_usage *fsp) fsp->fsu_blocksize = PROPAGATE_ALL_ONES (fsd.f_fsize); -#elif defined STAT_STATFS4 /* SVR3, old Irix */ +#elif defined STAT_STATFS4 /* SVR3 */ struct statfs fsd; diff --git a/lib/get-permissions.c b/lib/get-permissions.c index f9e96afbe45..9b904e8ca22 100644 --- a/lib/get-permissions.c +++ b/lib/get-permissions.c @@ -38,9 +38,9 @@ get_permissions (const char *name, int desc, mode_t mode, #if USE_ACL && HAVE_ACL_GET_FILE /* POSIX 1003.1e (draft 17 -- abandoned) specific version. */ - /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ + /* Linux, FreeBSD, Mac OS X, Cygwin >= 2.5 */ # if !HAVE_ACL_TYPE_EXTENDED - /* Linux, FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */ + /* Linux, FreeBSD, Cygwin >= 2.5 */ if (HAVE_ACL_GET_FD && desc != -1) ctx->acl = acl_get_fd (desc); diff --git a/lib/getdelim.c b/lib/getdelim.c index 2576d376f06..4cd5eca1895 100644 --- a/lib/getdelim.c +++ b/lib/getdelim.c @@ -65,7 +65,13 @@ getdelim (char **lineptr, size_t *n, int delimiter, FILE *fp) ssize_t result; size_t cur_len = 0; - if (lineptr == NULL || n == NULL || fp == NULL) + if (lineptr == NULL || n == NULL + /* glibc already declares this function as __nonnull ((4)). + Avoid a gcc warning "‘nonnull’ argument ‘fp’ compared to NULL". */ +#if !(__GLIBC__ >= 2) + || fp == NULL +#endif + ) { errno = EINVAL; return -1; diff --git a/lib/getloadavg.c b/lib/getloadavg.c index 752ec1f5ae7..1e3e215360b 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c @@ -140,21 +140,6 @@ # define SUNOS_5 # endif -# if defined (__osf__) && defined (__alpha) -# define OSF_ALPHA -# include -# include -# include -# include -/* Tru64 4.0D's table.h redefines sys */ -# undef sys -# endif - -# if defined (__osf__) && (defined (mips) || defined (__mips__)) -# define OSF_MIPS -# include -# endif - /* VAX C can't handle multi-line #ifs, or lines longer than 256 chars. */ # ifndef LOAD_AVE_TYPE @@ -167,31 +152,16 @@ # define LOAD_AVE_TYPE long # endif -# ifdef sgi -# define LOAD_AVE_TYPE long -# endif - # ifdef SVR4 # define LOAD_AVE_TYPE long # endif -# ifdef OSF_ALPHA -# define LOAD_AVE_TYPE long -# endif - # if defined _AIX && ! defined HAVE_LIBPERFSTAT # define LOAD_AVE_TYPE long # endif # endif /* No LOAD_AVE_TYPE. */ -# ifdef OSF_ALPHA -/* defines an incorrect value for FSCALE on Alpha OSF/1, - according to ghazi@noc.rutgers.edu. */ -# undef FSCALE -# define FSCALE 1024.0 -# endif - # ifndef FSCALE @@ -324,10 +294,6 @@ # endif # endif /* NeXT */ -# ifdef sgi -# include -# endif /* sgi */ - # ifdef UMAX # include # include @@ -389,7 +355,7 @@ static bool getloadavg_initialized; /* Offset in kmem to seek to read load average, or 0 means invalid. */ static long offset; -# if ! defined __VMS && ! defined sgi && ! (defined __linux__ || defined __ANDROID__) +# if ! defined __VMS && ! (defined __linux__ || defined __ANDROID__) static struct nlist name_list[2]; # endif @@ -781,18 +747,6 @@ getloadavg (double loadavg[], int nelem) } # endif /* __MSDOS__ || WINDOWS32 */ -# if !defined (LDAV_DONE) && defined (OSF_ALPHA) /* OSF/1 */ -# define LDAV_DONE - - struct tbl_loadavg load_ave; - table (TBL_LOADAVG, 0, &load_ave, 1, sizeof (load_ave)); - for (elem = 0; elem < nelem; elem++) - loadavg[elem] - = (load_ave.tl_lscale == 0 - ? load_ave.tl_avenrun.d[elem] - : (load_ave.tl_avenrun.l[elem] / (double) load_ave.tl_lscale)); -# endif /* OSF_ALPHA */ - # if ! defined LDAV_DONE && defined __VMS /* VMS */ /* VMS specific code -- read from the Load Ave driver. */ @@ -837,7 +791,7 @@ getloadavg (double loadavg[], int nelem) # endif /* ! defined LDAV_DONE && defined __VMS */ # if ! defined LDAV_DONE && defined LOAD_AVE_TYPE && ! defined __VMS - /* IRIX, other old systems */ + /* other old systems */ /* UNIX-specific code -- read the average from /dev/kmem. */ @@ -848,41 +802,35 @@ getloadavg (double loadavg[], int nelem) /* Get the address of LDAV_SYMBOL. */ if (offset == 0) { -# ifndef sgi -# if ! defined NLIST_STRUCT || ! defined N_NAME_POINTER +# if ! defined NLIST_STRUCT || ! defined N_NAME_POINTER strcpy (name_list[0].n_name, LDAV_SYMBOL); strcpy (name_list[1].n_name, ""); -# else /* NLIST_STRUCT */ -# ifdef HAVE_STRUCT_NLIST_N_UN_N_NAME +# else /* NLIST_STRUCT */ +# ifdef HAVE_STRUCT_NLIST_N_UN_N_NAME name_list[0].n_un.n_name = LDAV_SYMBOL; name_list[1].n_un.n_name = 0; -# else /* not HAVE_STRUCT_NLIST_N_UN_N_NAME */ +# else /* not HAVE_STRUCT_NLIST_N_UN_N_NAME */ name_list[0].n_name = LDAV_SYMBOL; name_list[1].n_name = 0; -# endif /* not HAVE_STRUCT_NLIST_N_UN_N_NAME */ -# endif /* NLIST_STRUCT */ +# endif /* not HAVE_STRUCT_NLIST_N_UN_N_NAME */ +# endif /* NLIST_STRUCT */ -# ifndef SUNOS_5 +# ifndef SUNOS_5 if ( -# if !defined (_AIX) +# if !defined (_AIX) nlist (KERNEL_FILE, name_list) -# else /* _AIX */ +# else /* _AIX */ knlist (name_list, 1, sizeof (name_list[0])) -# endif +# endif >= 0) /* Omit "&& name_list[0].n_type != 0 " -- it breaks on Sun386i. */ { -# ifdef FIXUP_KERNEL_SYMBOL_ADDR +# ifdef FIXUP_KERNEL_SYMBOL_ADDR FIXUP_KERNEL_SYMBOL_ADDR (name_list); -# endif +# endif offset = name_list[0].n_value; } -# endif /* !SUNOS_5 */ -# else /* sgi */ - ptrdiff_t ldav_off = sysmp (MP_KERNADDR, MPKA_AVENRUN); - if (ldav_off != -1) - offset = (long int) ldav_off & 0x7fffffff; -# endif /* sgi */ +# endif /* !SUNOS_5 */ } /* Make sure we have /dev/kmem open. */ diff --git a/lib/getopt.c b/lib/getopt.c index 6b155e6c635..d61bf8619c0 100644 --- a/lib/getopt.c +++ b/lib/getopt.c @@ -42,7 +42,7 @@ # define funlockfile(fp) _IO_funlockfile (fp) #else # include "gettext.h" -# define _(msgid) dgettext ("gnulib", msgid) +# define _(msgid) dgettext (GNULIB_TEXT_DOMAIN, msgid) /* When used standalone, flockfile and funlockfile might not be available. */ # if (!defined _POSIX_THREAD_SAFE_FUNCTIONS \ diff --git a/lib/gettext.h b/lib/gettext.h index fd6c62b7eb7..0650abc9a3d 100644 --- a/lib/gettext.h +++ b/lib/gettext.h @@ -70,7 +70,12 @@ # pragma GCC diagnostic push # pragma GCC diagnostic ignored "-Wbuiltin-declaration-mismatch" # endif -__attribute__ ((__always_inline__, __gnu_inline__)) extern inline +# if __GNUC__ + (__GNUC_MINOR__ >= 2) > 4 +__attribute__ ((__always_inline__, __gnu_inline__)) +# else +__attribute__ ((__always_inline__)) +# endif +extern inline # if !defined(__sun) const # endif @@ -79,7 +84,12 @@ gettext (const char *msgid) { return msgid; } -__attribute__ ((__always_inline__, __gnu_inline__)) extern inline +# if __GNUC__ + (__GNUC_MINOR__ >= 2) > 4 +__attribute__ ((__always_inline__, __gnu_inline__)) +# else +__attribute__ ((__always_inline__)) +# endif +extern inline # if !defined(__sun) const # endif @@ -89,7 +99,12 @@ dgettext (const char *domain, const char *msgid) (void) domain; return msgid; } -__attribute__ ((__always_inline__, __gnu_inline__)) extern inline +# if __GNUC__ + (__GNUC_MINOR__ >= 2) > 4 +__attribute__ ((__always_inline__, __gnu_inline__)) +# else +__attribute__ ((__always_inline__)) +# endif +extern inline # if !defined(__sun) const # endif diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index fa800300a42..f158acef91f 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -269,14 +269,8 @@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EMACSRES = @EMACSRES@ EMACS_MANIFEST = @EMACS_MANIFEST@ -EMULTIHOP_HIDDEN = @EMULTIHOP_HIDDEN@ -EMULTIHOP_VALUE = @EMULTIHOP_VALUE@ ENDIAN_H = @ENDIAN_H@ ENDIAN_H_JUST_MISSING_STDINT = @ENDIAN_H_JUST_MISSING_STDINT@ -ENOLINK_HIDDEN = @ENOLINK_HIDDEN@ -ENOLINK_VALUE = @ENOLINK_VALUE@ -EOVERFLOW_HIDDEN = @EOVERFLOW_HIDDEN@ -EOVERFLOW_VALUE = @EOVERFLOW_VALUE@ ERRNO_H = @ERRNO_H@ EUIDACCESS_LIBGEN = @EUIDACCESS_LIBGEN@ EXECINFO_H = @EXECINFO_H@ @@ -313,6 +307,7 @@ GL_COND_OBJ_FCNTL_CONDITION = @GL_COND_OBJ_FCNTL_CONDITION@ GL_COND_OBJ_FDOPENDIR_CONDITION = @GL_COND_OBJ_FDOPENDIR_CONDITION@ GL_COND_OBJ_FPENDING_CONDITION = @GL_COND_OBJ_FPENDING_CONDITION@ GL_COND_OBJ_FREE_CONDITION = @GL_COND_OBJ_FREE_CONDITION@ +GL_COND_OBJ_FSETERR_CONDITION = @GL_COND_OBJ_FSETERR_CONDITION@ GL_COND_OBJ_FSTATAT_CONDITION = @GL_COND_OBJ_FSTATAT_CONDITION@ GL_COND_OBJ_FSUSAGE_CONDITION = @GL_COND_OBJ_FSUSAGE_CONDITION@ GL_COND_OBJ_FSYNC_CONDITION = @GL_COND_OBJ_FSYNC_CONDITION@ @@ -344,6 +339,7 @@ GL_COND_OBJ_REALLOC_POSIX_CONDITION = @GL_COND_OBJ_REALLOC_POSIX_CONDITION@ GL_COND_OBJ_REGEX_CONDITION = @GL_COND_OBJ_REGEX_CONDITION@ GL_COND_OBJ_SIG2STR_CONDITION = @GL_COND_OBJ_SIG2STR_CONDITION@ GL_COND_OBJ_SIGDESCR_NP_CONDITION = @GL_COND_OBJ_SIGDESCR_NP_CONDITION@ +GL_COND_OBJ_STDIO_CONSOLESAFE_CONDITION = @GL_COND_OBJ_STDIO_CONSOLESAFE_CONDITION@ GL_COND_OBJ_STDIO_READ_CONDITION = @GL_COND_OBJ_STDIO_READ_CONDITION@ GL_COND_OBJ_STDIO_WRITE_CONDITION = @GL_COND_OBJ_STDIO_WRITE_CONDITION@ GL_COND_OBJ_STPCPY_CONDITION = @GL_COND_OBJ_STPCPY_CONDITION@ @@ -352,7 +348,6 @@ GL_COND_OBJ_STRTOIMAX_CONDITION = @GL_COND_OBJ_STRTOIMAX_CONDITION@ GL_COND_OBJ_STRTOLL_CONDITION = @GL_COND_OBJ_STRTOLL_CONDITION@ GL_COND_OBJ_SYMLINK_CONDITION = @GL_COND_OBJ_SYMLINK_CONDITION@ GL_COND_OBJ_TIMEGM_CONDITION = @GL_COND_OBJ_TIMEGM_CONDITION@ -GL_COND_OBJ_TIME_RZ_CONDITION = @GL_COND_OBJ_TIME_RZ_CONDITION@ GL_COND_OBJ_TIME_R_CONDITION = @GL_COND_OBJ_TIME_R_CONDITION@ GL_COND_OBJ_UTIMENSAT_CONDITION = @GL_COND_OBJ_UTIMENSAT_CONDITION@ GL_GENERATE_ALLOCA_H_CONDITION = @GL_GENERATE_ALLOCA_H_CONDITION@ @@ -559,6 +554,7 @@ GL_GNULIB_OBSTACK_PRINTF_POSIX = @GL_GNULIB_OBSTACK_PRINTF_POSIX@ GL_GNULIB_OBSTACK_ZPRINTF = @GL_GNULIB_OBSTACK_ZPRINTF@ GL_GNULIB_OPEN = @GL_GNULIB_OPEN@ GL_GNULIB_OPENAT = @GL_GNULIB_OPENAT@ +GL_GNULIB_OPENAT2 = @GL_GNULIB_OPENAT2@ GL_GNULIB_OPENDIR = @GL_GNULIB_OPENDIR@ GL_GNULIB_OVERRIDES_STRUCT_STAT = @GL_GNULIB_OVERRIDES_STRUCT_STAT@ GL_GNULIB_PCLOSE = @GL_GNULIB_PCLOSE@ @@ -629,6 +625,7 @@ GL_GNULIB_STRERRORNAME_NP = @GL_GNULIB_STRERRORNAME_NP@ GL_GNULIB_STRERROR_L = @GL_GNULIB_STRERROR_L@ GL_GNULIB_STRERROR_R = @GL_GNULIB_STRERROR_R@ GL_GNULIB_STRFTIME = @GL_GNULIB_STRFTIME@ +GL_GNULIB_STRINGEQ = @GL_GNULIB_STRINGEQ@ GL_GNULIB_STRNCAT = @GL_GNULIB_STRNCAT@ GL_GNULIB_STRNDUP = @GL_GNULIB_STRNDUP@ GL_GNULIB_STRNLEN = @GL_GNULIB_STRNLEN@ @@ -769,6 +766,7 @@ HAVE_DECL_IMAXABS = @HAVE_DECL_IMAXABS@ HAVE_DECL_IMAXDIV = @HAVE_DECL_IMAXDIV@ HAVE_DECL_INITSTATE = @HAVE_DECL_INITSTATE@ HAVE_DECL_LOCALTIME_R = @HAVE_DECL_LOCALTIME_R@ +HAVE_DECL_MEMEQ = @HAVE_DECL_MEMEQ@ HAVE_DECL_MEMMEM = @HAVE_DECL_MEMMEM@ HAVE_DECL_MEMRCHR = @HAVE_DECL_MEMRCHR@ HAVE_DECL_OBSTACK_PRINTF = @HAVE_DECL_OBSTACK_PRINTF@ @@ -780,6 +778,7 @@ HAVE_DECL_SETHOSTNAME = @HAVE_DECL_SETHOSTNAME@ HAVE_DECL_SETSTATE = @HAVE_DECL_SETSTATE@ HAVE_DECL_SNPRINTF = @HAVE_DECL_SNPRINTF@ HAVE_DECL_STRDUP = @HAVE_DECL_STRDUP@ +HAVE_DECL_STREQ = @HAVE_DECL_STREQ@ HAVE_DECL_STRERROR_R = @HAVE_DECL_STRERROR_R@ HAVE_DECL_STRNDUP = @HAVE_DECL_STRNDUP@ HAVE_DECL_STRNLEN = @HAVE_DECL_STRNLEN@ @@ -862,6 +861,7 @@ HAVE_NANOSLEEP = @HAVE_NANOSLEEP@ HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@ HAVE_OFF64_T = @HAVE_OFF64_T@ HAVE_OPENAT = @HAVE_OPENAT@ +HAVE_OPENAT2 = @HAVE_OPENAT2@ HAVE_OPENDIR = @HAVE_OPENDIR@ HAVE_OS_H = @HAVE_OS_H@ HAVE_PCLOSE = @HAVE_PCLOSE@ @@ -886,7 +886,6 @@ HAVE_PWRITE = @HAVE_PWRITE@ HAVE_QSORT_R = @HAVE_QSORT_R@ HAVE_RAISE = @HAVE_RAISE@ HAVE_RANDOM = @HAVE_RANDOM@ -HAVE_RANDOM_H = @HAVE_RANDOM_H@ HAVE_RANDOM_R = @HAVE_RANDOM_R@ HAVE_RAWMEMCHR = @HAVE_RAWMEMCHR@ HAVE_READDIR = @HAVE_READDIR@ @@ -1500,6 +1499,8 @@ gl_GNULIB_ENABLED_fd38c7e463b54744b77b98aeafb4fa7c_CONDITION = @gl_GNULIB_ENABLE gl_GNULIB_ENABLED_getdelim_CONDITION = @gl_GNULIB_ENABLED_getdelim_CONDITION@ gl_GNULIB_ENABLED_getdtablesize_CONDITION = @gl_GNULIB_ENABLED_getdtablesize_CONDITION@ gl_GNULIB_ENABLED_getgroups_CONDITION = @gl_GNULIB_ENABLED_getgroups_CONDITION@ +gl_GNULIB_ENABLED_issymlink_CONDITION = @gl_GNULIB_ENABLED_issymlink_CONDITION@ +gl_GNULIB_ENABLED_issymlinkat_CONDITION = @gl_GNULIB_ENABLED_issymlinkat_CONDITION@ gl_GNULIB_ENABLED_lchmod_CONDITION = @gl_GNULIB_ENABLED_lchmod_CONDITION@ gl_GNULIB_ENABLED_open_CONDITION = @gl_GNULIB_ENABLED_open_CONDITION@ gl_GNULIB_ENABLED_rawmemchr_CONDITION = @gl_GNULIB_ENABLED_rawmemchr_CONDITION@ @@ -2015,12 +2016,6 @@ errno.h: errno.in.h $(top_builddir)/config.status -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -e 's|@''NEXT_ERRNO_H''@|$(NEXT_ERRNO_H)|g' \ - -e 's|@''EMULTIHOP_HIDDEN''@|$(EMULTIHOP_HIDDEN)|g' \ - -e 's|@''EMULTIHOP_VALUE''@|$(EMULTIHOP_VALUE)|g' \ - -e 's|@''ENOLINK_HIDDEN''@|$(ENOLINK_HIDDEN)|g' \ - -e 's|@''ENOLINK_VALUE''@|$(ENOLINK_VALUE)|g' \ - -e 's|@''EOVERFLOW_HIDDEN''@|$(EOVERFLOW_HIDDEN)|g' \ - -e 's|@''EOVERFLOW_VALUE''@|$(EOVERFLOW_VALUE)|g' \ $(srcdir)/errno.in.h > $@-t $(AM_V_at)mv $@-t $@ else @@ -2129,10 +2124,12 @@ fcntl.h: fcntl.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) -e 's/@''GNULIB_NONBLOCKING''@/$(GL_GNULIB_NONBLOCKING)/g' \ -e 's/@''GNULIB_OPEN''@/$(GL_GNULIB_OPEN)/g' \ -e 's/@''GNULIB_OPENAT''@/$(GL_GNULIB_OPENAT)/g' \ + -e 's/@''GNULIB_OPENAT2''@/$(GL_GNULIB_OPENAT2)/g' \ -e 's/@''GNULIB_MDA_CREAT''@/$(GL_GNULIB_MDA_CREAT)/g' \ -e 's/@''GNULIB_MDA_OPEN''@/$(GL_GNULIB_MDA_OPEN)/g' \ -e 's|@''HAVE_FCNTL''@|$(HAVE_FCNTL)|g' \ -e 's|@''HAVE_OPENAT''@|$(HAVE_OPENAT)|g' \ + -e 's|@''HAVE_OPENAT2''@|$(HAVE_OPENAT2)|g' \ -e 's|@''REPLACE_CREAT''@|$(REPLACE_CREAT)|g' \ -e 's|@''REPLACE_FCNTL''@|$(REPLACE_FCNTL)|g' \ -e 's|@''REPLACE_OPEN''@|$(REPLACE_OPEN)|g' \ @@ -2231,6 +2228,18 @@ endif endif ## end gnulib module free-posix +## begin gnulib module fseterr +ifeq (,$(OMIT_GNULIB_MODULE_fseterr)) + +ifneq (,$(GL_COND_OBJ_FSETERR_CONDITION)) +libgnu_a_SOURCES += fseterr.c +endif + +EXTRA_DIST += fseterr.h stdio-impl.h + +endif +## end gnulib module fseterr + ## begin gnulib module fstatat ifeq (,$(OMIT_GNULIB_MODULE_fstatat)) @@ -2617,6 +2626,30 @@ EXTRA_DIST += inttypes.in.h endif ## end gnulib module inttypes-h-incomplete +## begin gnulib module issymlink +ifeq (,$(OMIT_GNULIB_MODULE_issymlink)) + +ifneq (,$(gl_GNULIB_ENABLED_issymlink_CONDITION)) +libgnu_a_SOURCES += issymlink.c + +endif +EXTRA_DIST += issymlink.h + +endif +## end gnulib module issymlink + +## begin gnulib module issymlinkat +ifeq (,$(OMIT_GNULIB_MODULE_issymlinkat)) + +ifneq (,$(gl_GNULIB_ENABLED_issymlinkat_CONDITION)) +libgnu_a_SOURCES += issymlinkat.c + +endif +EXTRA_DIST += issymlink.h + +endif +## end gnulib module issymlinkat + ## begin gnulib module lchmod ifeq (,$(OMIT_GNULIB_MODULE_lchmod)) @@ -3469,6 +3502,9 @@ stdio.h: stdio.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(AM_V_at)mv $@-t3 $@ MOSTLYCLEANFILES += stdio.h stdio.h-t1 stdio.h-t2 stdio.h-t3 +ifneq (,$(GL_COND_OBJ_STDIO_CONSOLESAFE_CONDITION)) +libgnu_a_SOURCES += stdio-consolesafe.c +endif ifneq (,$(GL_COND_OBJ_STDIO_READ_CONDITION)) libgnu_a_SOURCES += stdio-read.c endif @@ -3576,7 +3612,6 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's|@''HAVE_PTSNAME_R''@|$(HAVE_PTSNAME_R)|g' \ -e 's|@''HAVE_QSORT_R''@|$(HAVE_QSORT_R)|g' \ -e 's|@''HAVE_RANDOM''@|$(HAVE_RANDOM)|g' \ - -e 's|@''HAVE_RANDOM_H''@|$(HAVE_RANDOM_H)|g' \ -e 's|@''HAVE_RANDOM_R''@|$(HAVE_RANDOM_R)|g' \ -e 's|@''HAVE_REALLOCARRAY''@|$(HAVE_REALLOCARRAY)|g' \ -e 's|@''HAVE_REALPATH''@|$(HAVE_REALPATH)|g' \ @@ -3708,6 +3743,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's/@''GNULIB_STPNCPY''@/$(GL_GNULIB_STPNCPY)/g' \ -e 's/@''GNULIB_STRCHRNUL''@/$(GL_GNULIB_STRCHRNUL)/g' \ -e 's/@''GNULIB_STRDUP''@/$(GL_GNULIB_STRDUP)/g' \ + -e 's/@''GNULIB_STRINGEQ''@/$(GL_GNULIB_STRINGEQ)/g' \ -e 's/@''GNULIB_STRNCAT''@/$(GL_GNULIB_STRNCAT)/g' \ -e 's/@''GNULIB_STRNDUP''@/$(GL_GNULIB_STRNDUP)/g' \ -e 's/@''GNULIB_STRNLEN''@/$(GL_GNULIB_STRNLEN)/g' \ @@ -3735,6 +3771,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''HAVE_FFSL''@|$(HAVE_FFSL)|g' \ -e 's|@''HAVE_FFSLL''@|$(HAVE_FFSLL)|g' \ -e 's|@''HAVE_MBSLEN''@|$(HAVE_MBSLEN)|g' \ + -e 's|@''HAVE_DECL_MEMEQ''@|$(HAVE_DECL_MEMEQ)|g' \ -e 's|@''HAVE_DECL_MEMMEM''@|$(HAVE_DECL_MEMMEM)|g' \ -e 's|@''HAVE_MEMPCPY''@|$(HAVE_MEMPCPY)|g' \ -e 's|@''HAVE_DECL_MEMRCHR''@|$(HAVE_DECL_MEMRCHR)|g' \ @@ -3744,6 +3781,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''HAVE_STPNCPY''@|$(HAVE_STPNCPY)|g' \ -e 's|@''HAVE_STRCHRNUL''@|$(HAVE_STRCHRNUL)|g' \ -e 's|@''HAVE_DECL_STRDUP''@|$(HAVE_DECL_STRDUP)|g' \ + -e 's|@''HAVE_DECL_STREQ''@|$(HAVE_DECL_STREQ)|g' \ -e 's|@''HAVE_DECL_STRNDUP''@|$(HAVE_DECL_STRNDUP)|g' \ -e 's|@''HAVE_DECL_STRNLEN''@|$(HAVE_DECL_STRNLEN)|g' \ -e 's|@''HAVE_STRPBRK''@|$(HAVE_STRPBRK)|g' \ @@ -3793,6 +3831,14 @@ EXTRA_DIST += string.in.h endif ## end gnulib module string-h +## begin gnulib module stringeq +ifeq (,$(OMIT_GNULIB_MODULE_stringeq)) + +libgnu_a_SOURCES += string.c + +endif +## end gnulib module stringeq + ## begin gnulib module strnlen ifeq (,$(OMIT_GNULIB_MODULE_strnlen)) @@ -4136,9 +4182,7 @@ endif ## begin gnulib module time_rz ifeq (,$(OMIT_GNULIB_MODULE_time_rz)) -ifneq (,$(GL_COND_OBJ_TIME_RZ_CONDITION)) libgnu_a_SOURCES += time_rz.c -endif EXTRA_DIST += time-internal.h diff --git a/lib/intprops-internal.h b/lib/intprops-internal.h index 62de3c889ec..2609803094b 100644 --- a/lib/intprops-internal.h +++ b/lib/intprops-internal.h @@ -29,10 +29,6 @@ Do not evaluate E. */ #define _GL_INT_CONVERT(e, v) ((1 ? 0 : (e)) + (v)) -/* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see - . */ -#define _GL_INT_NEGATE_CONVERT(e, v) ((1 ? 0 : (e)) - (v)) - /* The extra casts in the following macros work around compiler bugs, e.g., in Cray C 5.0.3.0. */ @@ -41,7 +37,7 @@ /* Return 1 if the real expression E, after promotion, has a signed or floating type. Do not evaluate E. */ -#define _GL_EXPR_SIGNED(e) (_GL_INT_NEGATE_CONVERT (e, 1) < 0) +#define _GL_EXPR_SIGNED(e) (_GL_INT_CONVERT (e, -1) < 0) /* Minimum and maximum values for integer types and expressions. */ @@ -60,7 +56,7 @@ #define _GL_INT_MAXIMUM(e) \ (_GL_EXPR_SIGNED (e) \ ? _GL_SIGNED_INT_MAXIMUM (e) \ - : _GL_INT_NEGATE_CONVERT (e, 1)) + : _GL_INT_CONVERT (e, -1)) #define _GL_SIGNED_INT_MAXIMUM(e) \ (((_GL_INT_CONVERT (e, 1) << (_GL_TYPE_WIDTH (+ (e)) - 2)) - 1) * 2 + 1) @@ -112,7 +108,7 @@ #elif defined __has_builtin # define _GL_HAS_BUILTIN_ADD_OVERFLOW __has_builtin (__builtin_add_overflow) /* __builtin_{add,sub}_overflow exists but is not reliable in GCC 5.x and 6.x, - see . */ + see . */ #elif 7 <= __GNUC__ # define _GL_HAS_BUILTIN_ADD_OVERFLOW 1 #else @@ -184,7 +180,7 @@ #endif /* Nonzero if this compiler has GCC bug 68193 or Clang bug 25390. See: - https://gcc.gnu.org/bugzilla/show_bug.cgi?id=68193 + https://gcc.gnu.org/PR68193 https://llvm.org/bugs/show_bug.cgi?id=25390 For now, assume GCC < 14 and all Clang versions generate bogus warnings for _Generic. This matters only for compilers that diff --git a/lib/intprops.h b/lib/intprops.h index 2f9fa0a0222..72e866ff5bd 100644 --- a/lib/intprops.h +++ b/lib/intprops.h @@ -205,11 +205,11 @@ || INT_MULTIPLY_RANGE_OVERFLOW (a, b, min, max)) #endif #define _GL_DIVIDE_OVERFLOW(a, b, min, max) \ - ((min) < 0 ? (b) == _GL_INT_NEGATE_CONVERT (min, 1) && (a) < - (max) \ + ((min) < 0 ? (b) == _GL_INT_CONVERT (min, -1) && (a) < - (max) \ : (a) < 0 ? (b) <= (a) + (b) - 1 \ : (b) < 0 && (a) + (b) <= (a)) #define _GL_REMAINDER_OVERFLOW(a, b, min, max) \ - ((min) < 0 ? (b) == _GL_INT_NEGATE_CONVERT (min, 1) && (a) < - (max) \ + ((min) < 0 ? (b) == _GL_INT_CONVERT (min, -1) && (a) < - (max) \ : (a) < 0 ? (a) % (b) != ((max) - (b) + 1) % (b) \ : (b) < 0 && ! _GL_UNSIGNED_NEG_MULTIPLE (a, b, max)) diff --git a/lib/issymlink.c b/lib/issymlink.c new file mode 100644 index 00000000000..dbf56c037c4 --- /dev/null +++ b/lib/issymlink.c @@ -0,0 +1,20 @@ +/* Test whether a file is a symbolic link. + Copyright (C) 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 . */ + +#include + +#define _GL_ISSYMLINK_INLINE _GL_EXTERN_INLINE +#include "issymlink.h" diff --git a/lib/issymlink.h b/lib/issymlink.h new file mode 100644 index 00000000000..af6dc965645 --- /dev/null +++ b/lib/issymlink.h @@ -0,0 +1,103 @@ +/* Test whether a file is a symbolic link. + Copyright (C) 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 . */ + +#ifndef _ISSYMLINK_H +#define _ISSYMLINK_H + +/* This file uses _GL_ARG_NONNULL, _GL_INLINE. */ +#if !_GL_CONFIG_H_INCLUDED + #error "Please include config.h first." +#endif + +#include +#include /* for readlink, readlinkat */ + + +_GL_INLINE_HEADER_BEGIN + +#ifndef _GL_ISSYMLINK_INLINE +# define _GL_ISSYMLINK_INLINE _GL_INLINE +#endif +#ifndef _GL_ISSYMLINKAT_INLINE +# define _GL_ISSYMLINKAT_INLINE _GL_INLINE +#endif + +#if GNULIB_ISSYMLINK +/* Tests whether FILENAME represents a symbolic link. + This function is more reliable than lstat() / fstatat() followed by S_ISLNK, + because it avoids possible EOVERFLOW errors. + Returns + 1 if FILENAME is a symbolic link, + 0 if FILENAME exists and is not a symbolic link, + -1 with errno set if determination failed, in particular + -1 with errno = ENOENT or ENOTDIR if FILENAME does not exist. */ +# ifdef __cplusplus +extern "C" { +# endif +_GL_ISSYMLINK_INLINE int issymlink (const char *filename) + _GL_ARG_NONNULL ((1)); +_GL_ISSYMLINK_INLINE int +issymlink (const char *filename) +{ + char linkbuf[1]; + if (readlink (filename, linkbuf, sizeof (linkbuf)) >= 0) + return 1; + if (errno == EINVAL) + return 0; + else + return -1; +} +# ifdef __cplusplus +} +# endif +#endif + +#if GNULIB_ISSYMLINKAT +/* Tests whether FILENAME represents a symbolic link. + This function is more reliable than lstat() / fstatat() followed by S_ISLNK, + because it avoids possible EOVERFLOW errors. + If FILENAME is a relative file name, it is interpreted as relative to the + directory referred to by FD (where FD = AT_FDCWD denotes the current + directory). + Returns + 1 if FILENAME is a symbolic link, + 0 if FILENAME exists and is not a symbolic link, + -1 with errno set if determination failed, in particular + -1 with errno = ENOENT or ENOTDIR if FILENAME does not exist. */ +# ifdef __cplusplus +extern "C" { +# endif +_GL_ISSYMLINKAT_INLINE int issymlinkat (int fd, const char *filename) + _GL_ARG_NONNULL ((2)); +_GL_ISSYMLINKAT_INLINE int +issymlinkat (int fd, const char *filename) +{ + char linkbuf[1]; + if (readlinkat (fd, filename, linkbuf, sizeof (linkbuf)) >= 0) + return 1; + if (errno == EINVAL) + return 0; + else + return -1; +} +# ifdef __cplusplus +} +# endif +#endif + +_GL_INLINE_HEADER_END + +#endif /* _ISSYMLINK_H */ diff --git a/lib/issymlinkat.c b/lib/issymlinkat.c new file mode 100644 index 00000000000..8286356c8a2 --- /dev/null +++ b/lib/issymlinkat.c @@ -0,0 +1,20 @@ +/* Test whether a file is a symbolic link. + Copyright (C) 2025 Free Software Foundation, Inc. + + This file is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published + by the Free Software Foundation, either version 3 of the License, + or (at your option) any later version. + + This 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 General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +#include + +#define _GL_ISSYMLINKAT_INLINE _GL_EXTERN_INLINE +#include "issymlink.h" diff --git a/lib/lchmod.c b/lib/lchmod.c index 4391a4aa940..deba4c50f5b 100644 --- a/lib/lchmod.c +++ b/lib/lchmod.c @@ -29,6 +29,7 @@ #include #include +#include "issymlink.h" /* Work like chmod, except when FILE is a symbolic link. In that case, on systems where permissions on symbolic links are unsupported @@ -37,29 +38,30 @@ int lchmod (char const *file, mode_t mode) { - char readlink_buf[1]; - #ifdef O_PATH /* Open a file descriptor with O_NOFOLLOW, to make sure we don't follow symbolic links, if /proc is mounted. O_PATH is used to avoid a failure if the file is not readable. - Cf. */ + Cf. */ int fd = open (file, O_PATH | O_NOFOLLOW | O_CLOEXEC); if (fd < 0) return fd; int err; - if (0 <= readlinkat (fd, "", readlink_buf, sizeof readlink_buf)) - err = EOPNOTSUPP; - else if (errno == EINVAL) - { - static char const fmt[] = "/proc/self/fd/%d"; - char buf[sizeof fmt - sizeof "%d" + INT_BUFSIZE_BOUND (int)]; - sprintf (buf, fmt, fd); - err = chmod (buf, mode) == 0 ? 0 : errno == ENOENT ? -1 : errno; - } - else - err = errno == ENOENT ? -1 : errno; + { + int ret = issymlinkat (fd, ""); + if (ret > 0) + err = EOPNOTSUPP; + else if (ret == 0) + { + static char const fmt[] = "/proc/self/fd/%d"; + char buf[sizeof fmt - sizeof "%d" + INT_BUFSIZE_BOUND (int)]; + sprintf (buf, fmt, fd); + err = chmod (buf, mode) == 0 ? 0 : errno == ENOENT ? -1 : errno; + } + else + err = errno == ENOENT ? -1 : errno; + } close (fd); @@ -83,7 +85,7 @@ lchmod (char const *file, mode_t mode) /* O_PATH + /proc is not supported. */ - if (0 <= readlink (file, readlink_buf, sizeof readlink_buf)) + if (issymlink (file) > 0) { errno = EOPNOTSUPP; return -1; diff --git a/lib/limits.in.h b/lib/limits.in.h index c33c59e13bd..693df9984c2 100644 --- a/lib/limits.in.h +++ b/lib/limits.in.h @@ -47,7 +47,7 @@ #ifndef LLONG_MIN # if defined LONG_LONG_MIN /* HP-UX 11.31 */ # define LLONG_MIN LONG_LONG_MIN -# elif defined LONGLONG_MIN /* IRIX 6.5 */ +# elif defined LONGLONG_MIN /* AIX, BeOS */ # define LLONG_MIN LONGLONG_MIN # elif defined __GNUC__ # define LLONG_MIN (- __LONG_LONG_MAX__ - 1LL) @@ -56,7 +56,7 @@ #ifndef LLONG_MAX # if defined LONG_LONG_MAX /* HP-UX 11.31 */ # define LLONG_MAX LONG_LONG_MAX -# elif defined LONGLONG_MAX /* IRIX 6.5 */ +# elif defined LONGLONG_MAX /* AIX, BeOS */ # define LLONG_MAX LONGLONG_MAX # elif defined __GNUC__ # define LLONG_MAX __LONG_LONG_MAX__ @@ -65,7 +65,7 @@ #ifndef ULLONG_MAX # if defined ULONG_LONG_MAX /* HP-UX 11.31 */ # define ULLONG_MAX ULONG_LONG_MAX -# elif defined ULONGLONG_MAX /* IRIX 6.5 */ +# elif defined ULONGLONG_MAX /* AIX, BeOS */ # define ULLONG_MAX ULONGLONG_MAX # elif defined __GNUC__ # define ULLONG_MAX (__LONG_LONG_MAX__ * 2ULL + 1ULL) diff --git a/lib/lstat.c b/lib/lstat.c index bb4a59f1749..f5fda4af771 100644 --- a/lib/lstat.c +++ b/lib/lstat.c @@ -42,14 +42,7 @@ orig_lstat (const char *filename, struct stat *buf) } /* Specification. */ -# ifdef __osf__ -/* Write "sys/stat.h" here, not , otherwise OSF/1 5.1 DTK cc - eliminates this include because of the preliminary #include - above. */ -# include "sys/stat.h" -# else -# include -# endif +# include # include "stat-time.h" diff --git a/lib/md5-stream.c b/lib/md5-stream.c index fdbf97a682b..a5d6a3109a4 100644 --- a/lib/md5-stream.c +++ b/lib/md5-stream.c @@ -87,7 +87,7 @@ md5_stream (FILE *stream, void *resblock) or the fread() in afalg_stream may have gotten EOF. We need to avoid a subsequent fread() as EOF may not be sticky. For details of such systems, see: - https://sourceware.org/bugzilla/show_bug.cgi?id=1190 */ + https://sourceware.org/PR1190 */ if (feof (stream)) goto process_partial_block; diff --git a/lib/mini-gmp.c b/lib/mini-gmp.c index c97dc7e6cfa..9f3812b31bd 100644 --- a/lib/mini-gmp.c +++ b/lib/mini-gmp.c @@ -51,7 +51,11 @@ see https://www.gnu.org/licenses/. */ #include "mini-gmp.h" -#if !defined(MINI_GMP_DONT_USE_FLOAT_H) +#ifndef MINI_GMP_ENABLE_FLOAT +#define MINI_GMP_ENABLE_FLOAT 1 +#endif + +#if MINI_GMP_ENABLE_FLOAT #include #endif @@ -1705,6 +1709,7 @@ mpz_roinit_n (mpz_t x, mp_srcptr xp, mp_size_t xs) } +#if MINI_GMP_ENABLE_FLOAT /* Conversions and comparison to double. */ void mpz_set_d (mpz_t r, double x) @@ -1861,6 +1866,7 @@ mpz_cmp_d (const mpz_t x, double d) return mpz_cmpabs_d (x, d); } } +#endif /* MINI_GMP_ENABLE_FLOAT */ /* MPZ comparisons and the like. */ @@ -4515,6 +4521,11 @@ mpz_import (mpz_t r, size_t count, int order, size_t size, int endian, assert (order == 1 || order == -1); assert (endian >= -1 && endian <= 1); + if (count == 0) + { + r->_mp_size = 0; + return; + } if (endian == 0) endian = gmp_detect_endian (); diff --git a/lib/minmax.h b/lib/minmax.h index 355de4b1c3f..7cafcea3818 100644 --- a/lib/minmax.h +++ b/lib/minmax.h @@ -19,8 +19,8 @@ #define _MINMAX_H /* Note: MIN, MAX are also defined in on some systems - (glibc, IRIX, HP-UX, OSF/1). Therefore you might get warnings about - MIN, MAX macro redefinitions on some systems; the workaround is to + (glibc, HP-UX). Therefore you might get warnings about MIN, MAX + macro redefinitions on some systems; the workaround is to #include this file as the last one among the #include list. */ /* This file uses HAVE_MINMAX_IN_LIMITS_H, HAVE_MINMAX_IN_SYS_PARAM_H. */ diff --git a/lib/nproc.c b/lib/nproc.c index 83439aa0eb2..e899ff17620 100644 --- a/lib/nproc.c +++ b/lib/nproc.c @@ -22,7 +22,12 @@ #include #include +#if HAVE_MNTENT_H +# include +#endif #include +#include +#include #include #if HAVE_PTHREAD_GETAFFINITY_NP && 0 @@ -39,10 +44,6 @@ # include #endif -#if HAVE_SYS_SYSMP_H -# include -#endif - #if HAVE_SYS_PARAM_H # include #endif @@ -62,6 +63,8 @@ #define ARRAY_SIZE(a) (sizeof (a) / sizeof ((a)[0])) +#define NPROC_MINIMUM 1 + /* Return the number of processors available to the current process, based on a modern system call that returns the "affinity" between the current process and each CPU. Return 0 if unknown or if such a system call does @@ -244,7 +247,7 @@ num_processors_via_affinity_mask (void) /* Return the total number of processors. Here QUERY must be one of NPROC_ALL, NPROC_CURRENT. The result is guaranteed to be at least 1. */ static unsigned long int -num_processors_ignoring_omp (enum nproc_query query) +num_processors_available (enum nproc_query query) { /* On systems with a modern affinity mask system call, we have sysconf (_SC_NPROCESSORS_CONF) @@ -258,7 +261,7 @@ num_processors_ignoring_omp (enum nproc_query query) the /sys and /proc file systems (see glibc/sysdeps/unix/sysv/linux/getsysstats.c). In some situations these file systems are not mounted, and the sysconf call - returns 1 or 2 (), + returns 1 or 2 (), which does not reflect the reality. */ if (query == NPROC_CURRENT) @@ -272,8 +275,8 @@ num_processors_ignoring_omp (enum nproc_query query) } #if defined _SC_NPROCESSORS_ONLN - { /* This works on glibc, Mac OS X 10.5, FreeBSD, AIX, OSF/1, Solaris, - Cygwin, Haiku. */ + { /* This works on glibc, Mac OS X 10.5, FreeBSD, AIX, Solaris, Cygwin, + Haiku. */ long int nprocs = sysconf (_SC_NPROCESSORS_ONLN); if (nprocs > 0) return nprocs; @@ -283,8 +286,8 @@ num_processors_ignoring_omp (enum nproc_query query) else /* query == NPROC_ALL */ { #if defined _SC_NPROCESSORS_CONF - { /* This works on glibc, Mac OS X 10.5, FreeBSD, AIX, OSF/1, Solaris, - Cygwin, Haiku. */ + { /* This works on glibc, Mac OS X 10.5, FreeBSD, AIX, Solaris, Cygwin, + Haiku. */ long int nprocs = sysconf (_SC_NPROCESSORS_CONF); # if __GLIBC__ >= 2 && defined __linux__ @@ -330,20 +333,6 @@ num_processors_ignoring_omp (enum nproc_query query) } #endif -#if HAVE_SYSMP && defined MP_NAPROCS && defined MP_NPROCS - { /* This works on IRIX. */ - /* MP_NPROCS yields the number of installed processors. - MP_NAPROCS yields the number of processors available to unprivileged - processes. */ - int nprocs = - sysmp (query == NPROC_CURRENT && getuid () != 0 - ? MP_NAPROCS - : MP_NPROCS); - if (nprocs > 0) - return nprocs; - } -#endif - /* Finally, as fallback, use the APIs that don't distinguish between NPROC_CURRENT and NPROC_ALL. */ @@ -377,7 +366,159 @@ num_processors_ignoring_omp (enum nproc_query query) } #endif - return 1; + return NPROC_MINIMUM; +} + +#if defined __linux__ || defined __ANDROID__ +/* Identify the cgroup2 mount point, + initially at the usual location for efficiency, + resorting to searching mount points otherwise. + Return NULL if the mount point is not found. + The returned string can be freed. */ +static char * +cgroup2_mount (void) +{ + FILE *fp; + char *ret = NULL; + + /* Check the usual location first. */ + if (access ("/sys/fs/cgroup/cgroup.controllers", F_OK) == 0) + return strdup ("/sys/fs/cgroup"); + +#if HAVE_MNTENT_H + /* Otherwise look for the mount point. */ + struct mntent *mnt; + if (! (fp = setmntent ("/proc/mounts", "r"))) + return NULL; + while ((mnt = getmntent (fp)) != NULL) + { + if (streq (mnt->mnt_type, "cgroup2")) + { + ret = strdup (mnt->mnt_dir); + break; + } + } + endmntent (fp); +#endif + + return ret; +} + +/* Return the minimum configured cgroupv2 CPU quota for the current process. + Return ULONG_MAX if quota can't be read. + Returned value will be >= 1. */ +static unsigned long int +get_cgroup2_cpu_quota (void) +{ + unsigned long int cpu_quota = ULONG_MAX; + FILE *fp; + + fp = fopen ("/proc/self/cgroup", "r"); + if (! fp) + return cpu_quota; + + /* Get our cgroupv2 (unififed) hierarchy. */ + char *cgroup = NULL; + char *cgroup_str = NULL; + size_t cgroup_size = 0; + ssize_t read; + while ((read = getline (&cgroup_str, &cgroup_size, fp)) != -1) + { + if (strncmp (cgroup_str, "0::/", 4) == 0) + { + char *end = cgroup_str + read - 1; + if (*end == '\n') + *end = '\0'; + cgroup = cgroup_str + 3; + break; + } + } + fclose (fp); + + char *mount = NULL; + if (cgroup && ! (mount = cgroup2_mount ())) + cgroup = NULL; + + /* Find the lowest quota in the hierarchy. */ + char *quota_str = NULL; + size_t quota_size = 0; + while (cgroup && *cgroup) + { + /* Walk back up the nested cgroup hierarchy + to find the lowest cpu quota as defined in a cpu.max file. + Note this file may not be present if the cpu controller + is not enabled for that part of the hierarchy. */ + + char cpu_max_file[PATH_MAX]; + snprintf (cpu_max_file, sizeof (cpu_max_file), + "%s%s/cpu.max", mount, cgroup); + + if ((fp = fopen (cpu_max_file, "r")) + && getline ("a_str, "a_size, fp) != -1 + && strncmp (quota_str, "max", 3) != 0) + { + long quota, period; + if (sscanf (quota_str, "%ld %ld", "a, &period) == 2 && period) + { + double ncpus = (double)quota / period; + if (cpu_quota == ULONG_MAX || ncpus < cpu_quota) + { + cpu_quota = MAX (1, (long)(ncpus + 0.5)); + /* nproc will return 1 minimum, so no point going lower */ + if (cpu_quota == 1) + *cgroup = '\0'; + } + } + } + + if (fp) + fclose (fp); + + char *last_sep = strrchr (cgroup, '/'); + if (! last_sep) + break; + if (last_sep == cgroup && *(cgroup + 1)) + *(cgroup + 1) = '\0'; /* Iterate on "/" also. */ + else + *last_sep = '\0'; + } + + free (quota_str); + free (mount); + free (cgroup_str); + + return cpu_quota; +} +#endif + + +/* Return the cgroupv2 CPU quota if the current scheduler honors it. + Otherwise return ULONG_MAX. + Returned value will be >= 1. */ +static unsigned long int +cpu_quota (void) +{ + unsigned long int quota = ULONG_MAX; + +#if defined __linux__ || defined __ANDROID__ +# if HAVE_SCHED_GETAFFINITY_LIKE_GLIBC && defined SCHED_DEADLINE + /* We've a new enough sched.h */ + switch (sched_getscheduler (0)) + { + case -1: + case SCHED_FIFO: + case SCHED_RR: + case SCHED_DEADLINE: + quota = ULONG_MAX; + break; + default: + quota = get_cgroup2_cpu_quota (); + break; + } +# endif +#endif + + return quota; } /* Parse OMP environment variables without dependence on OMP. @@ -416,13 +557,13 @@ parse_omp_threads (char const* threads) unsigned long int num_processors (enum nproc_query query) { - unsigned long int omp_env_limit = ULONG_MAX; + unsigned long int nproc_limit = ULONG_MAX; + /* Honor the OpenMP environment variables, recognized also by all + programs that are based on OpenMP. */ if (query == NPROC_CURRENT_OVERRIDABLE) { - unsigned long int omp_env_threads; - /* Honor the OpenMP environment variables, recognized also by all - programs that are based on OpenMP. */ + unsigned long int omp_env_threads, omp_env_limit; omp_env_threads = parse_omp_threads (getenv ("OMP_NUM_THREADS")); omp_env_limit = parse_omp_threads (getenv ("OMP_THREAD_LIMIT")); if (! omp_env_limit) @@ -431,14 +572,22 @@ num_processors (enum nproc_query query) if (omp_env_threads) return MIN (omp_env_threads, omp_env_limit); + nproc_limit = omp_env_limit; query = NPROC_CURRENT; } - /* Here query is one of NPROC_ALL, NPROC_CURRENT. */ - if (omp_env_limit == 1) - /* No need to even call num_processors_ignoring_omp (query). */ - return 1; - { - unsigned long nprocs = num_processors_ignoring_omp (query); - return MIN (nprocs, omp_env_limit); - } + + /* Honor any CPU quotas. */ + if (query == NPROC_CURRENT && nproc_limit > NPROC_MINIMUM) + { + unsigned long int quota = cpu_quota (); + nproc_limit = MIN (quota, nproc_limit); + } + + if (nproc_limit > NPROC_MINIMUM) + { + unsigned long nprocs = num_processors_available (query); + nproc_limit = MIN (nprocs, nproc_limit); + } + + return nproc_limit; } diff --git a/lib/open.c b/lib/open.c index d76372fd603..fceacfcc00f 100644 --- a/lib/open.c +++ b/lib/open.c @@ -38,13 +38,7 @@ orig_open (const char *filename, int flags, mode_t mode) } /* Specification. */ -#ifdef __osf__ -/* Write "fcntl.h" here, not , otherwise OSF/1 5.1 DTK cc eliminates - this include because of the preliminary #include above. */ -# include "fcntl.h" -#else -# include -#endif +#include #include "cloexec.h" @@ -100,7 +94,7 @@ open (const char *filename, int flags, ...) #endif #if defined _WIN32 && ! defined __CYGWIN__ - if (strcmp (filename, "/dev/null") == 0) + if (streq (filename, "/dev/null")) filename = "NUL"; #endif diff --git a/lib/pthread_sigmask.c b/lib/pthread_sigmask.c index a4968f7df40..0d0a5c211da 100644 --- a/lib/pthread_sigmask.c +++ b/lib/pthread_sigmask.c @@ -26,10 +26,6 @@ # include #endif -#if PTHREAD_SIGMASK_UNBLOCK_BUG -# include -#endif - int pthread_sigmask (int how, const sigset_t *new_mask, sigset_t *old_mask) #undef pthread_sigmask @@ -58,7 +54,7 @@ pthread_sigmask (int how, const sigset_t *new_mask, sigset_t *old_mask) Don't cache the information: libpthread.so could be dynamically loaded after the program started and after pthread_sigmask was called for the first time. */ - if (memcmp (&omask_copy, &omask, sizeof omask) == 0 + if (memeq (&omask_copy, &omask, sizeof omask) && pthread_sigmask (1729, &omask_copy, NULL) == 0) { /* pthread_sigmask is currently ineffective. The program is not @@ -73,16 +69,6 @@ pthread_sigmask (int how, const sigset_t *new_mask, sigset_t *old_mask) # if PTHREAD_SIGMASK_FAILS_WITH_ERRNO if (ret == -1) return errno; -# endif -# if PTHREAD_SIGMASK_UNBLOCK_BUG - if (ret == 0 - && new_mask != NULL - && (how == SIG_UNBLOCK || how == SIG_SETMASK)) - { - /* Give the OS the opportunity to raise signals that were pending before - the pthread_sigmask call and have now been unblocked. */ - usleep (1); - } # endif return ret; #else diff --git a/lib/qcopy-acl.c b/lib/qcopy-acl.c index 282f4b2d2a5..e86e15544f6 100644 --- a/lib/qcopy-acl.c +++ b/lib/qcopy-acl.c @@ -50,9 +50,9 @@ is_attr_permissions (const char *name, struct error_context *ctx) { /* We need to explicitly test for the known extended attribute names, because at least on CentOS 7, attr_copy_action does not do it. */ - return strcmp (name, XATTR_NAME_POSIX_ACL_ACCESS) == 0 - || strcmp (name, XATTR_NAME_POSIX_ACL_DEFAULT) == 0 - || strcmp (name, XATTR_NAME_NFSV4_ACL) == 0 + return streq (name, XATTR_NAME_POSIX_ACL_ACCESS) + || streq (name, XATTR_NAME_POSIX_ACL_DEFAULT) + || streq (name, XATTR_NAME_NFSV4_ACL) || attr_copy_action (name, ctx) == ATTR_ACTION_PERMISSIONS; } diff --git a/lib/readutmp.h b/lib/readutmp.h index 60d63df9598..f186d99d68d 100644 --- a/lib/readutmp.h +++ b/lib/readutmp.h @@ -115,19 +115,19 @@ enum { UT_HOST_SIZE = -1 }; Field Type Platforms ---------- ------ --------- - ⎡ ut_user char[] glibc, musl, macOS, FreeBSD, AIX, HP-UX, IRIX, Solaris, Cygwin, Android + ⎡ ut_user char[] glibc, musl, macOS, FreeBSD, AIX, HP-UX, Solaris, Cygwin, Android ⎣ ut_name char[] NetBSD, Minix - ut_id char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android - ut_line char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android - ut_pid pid_t glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android - ut_type short glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android - ⎡ ut_tv struct glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android + ut_id char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, Solaris, Cygwin, Android + ut_line char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, Solaris, Cygwin, Android + ut_pid pid_t glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, Solaris, Cygwin, Android + ut_type short glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, Solaris, Cygwin, Android + ⎡ ut_tv struct glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, Solaris, Cygwin, Android ⎢ { tv_sec; tv_usec; } ⎣ ut_time time_t Cygwin - ut_host char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android - ut_exit struct glibc, musl, NetBSD, Minix, HP-UX, IRIX, Solaris, Android + ut_host char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, Solaris, Cygwin, Android + ut_exit struct glibc, musl, NetBSD, Minix, HP-UX, Solaris, Android { e_termination; e_exit; } - ut_session [long] int glibc, musl, NetBSD, Minix, IRIX, Solaris, Android + ut_session [long] int glibc, musl, NetBSD, Minix, Solaris, Android ⎡ ut_addr [long] int HP-UX, Cygwin ⎢ ut_addr_v6 [u]int[4] glibc, musl, Android ⎣ ut_ss struct sockaddr_storage NetBSD, Minix @@ -174,7 +174,7 @@ struct utmpx32 # define SET_UTMP_ENT setutxent # define GET_UTMP_ENT getutxent # define END_UTMP_ENT endutxent -# ifdef HAVE_UTMPXNAME /* glibc, musl, macOS, NetBSD, Minix, IRIX, Solaris, Cygwin */ +# ifdef HAVE_UTMPXNAME /* glibc, musl, macOS, NetBSD, Minix, Solaris, Cygwin */ # define UTMP_NAME_FUNCTION utmpxname # elif defined UTXDB_ACTIVE /* FreeBSD */ # define UTMP_NAME_FUNCTION(x) setutxdb (UTXDB_ACTIVE, x) @@ -190,17 +190,17 @@ struct utmpx32 Field Type Platforms ---------- ------ --------- - ⎡ ut_user char[] glibc, musl, AIX, HP-UX, IRIX, Solaris, Cygwin, Android + ⎡ ut_user char[] glibc, musl, AIX, HP-UX, Solaris, Cygwin, Android ⎣ ut_name char[] macOS, old FreeBSD, NetBSD, OpenBSD, Minix - ut_id char[] glibc, musl, AIX, HP-UX, IRIX, Solaris, Cygwin, Android - ut_line char[] glibc, musl, macOS, old FreeBSD, NetBSD, OpenBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android - ut_pid pid_t glibc, musl, AIX, HP-UX, IRIX, Solaris, Cygwin, Android - ut_type short glibc, musl, AIX, HP-UX, IRIX, Solaris, Cygwin, Android + ut_id char[] glibc, musl, AIX, HP-UX, Solaris, Cygwin, Android + ut_line char[] glibc, musl, macOS, old FreeBSD, NetBSD, OpenBSD, Minix, AIX, HP-UX, Solaris, Cygwin, Android + ut_pid pid_t glibc, musl, AIX, HP-UX, Solaris, Cygwin, Android + ut_type short glibc, musl, AIX, HP-UX, Solaris, Cygwin, Android ⎡ ut_tv struct glibc, musl, Android ⎢ { tv_sec; tv_usec; } - ⎣ ut_time time_t macOS, old FreeBSD, NetBSD, OpenBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin + ⎣ ut_time time_t macOS, old FreeBSD, NetBSD, OpenBSD, Minix, AIX, HP-UX, Solaris, Cygwin ut_host char[] glibc, musl, macOS, old FreeBSD, NetBSD, OpenBSD, Minix, AIX, HP-UX, Cygwin, Android - ut_exit struct glibc, musl, AIX, HP-UX, IRIX, Solaris, Android + ut_exit struct glibc, musl, AIX, HP-UX, Solaris, Android { e_termination; e_exit; } ut_session [long] int glibc, musl, Android ⎡ ut_addr [long] int HP-UX, Cygwin @@ -211,7 +211,7 @@ struct utmpx32 # define SET_UTMP_ENT setutent # define GET_UTMP_ENT getutent # define END_UTMP_ENT endutent -# ifdef HAVE_UTMPNAME /* glibc, musl, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android */ +# ifdef HAVE_UTMPNAME /* glibc, musl, NetBSD, Minix, AIX, HP-UX, Solaris, Cygwin, Android */ # define UTMP_NAME_FUNCTION utmpname # endif diff --git a/lib/realloc.c b/lib/realloc.c index 42375010975..62efd5a39ff 100644 --- a/lib/realloc.c +++ b/lib/realloc.c @@ -50,7 +50,7 @@ rpl_realloc (void *p, size_t n) undefined behavior even though C17 and earlier partially defined the behavior. Let the programmer know. When the undefined-behaviour sanitizers report this case, i.e. when - and + and have been closed and new releases of GCC and clang have been made, we can revisit this code. */ diff --git a/lib/regex.c b/lib/regex.c index f5f6552670d..1404dac7534 100644 --- a/lib/regex.c +++ b/lib/regex.c @@ -24,6 +24,7 @@ # if __GNUC_PREREQ (4, 6) # pragma GCC diagnostic ignored "-Wsuggest-attribute=pure" +# pragma GCC diagnostic ignored "-Wswitch-enum" # pragma GCC diagnostic ignored "-Wvla" # endif #endif diff --git a/lib/regex_internal.h b/lib/regex_internal.h index 1f2972999ad..03893b8630b 100644 --- a/lib/regex_internal.h +++ b/lib/regex_internal.h @@ -98,24 +98,14 @@ #endif /* This is for other GNU distributions with internationalized messages. */ -#if (HAVE_LIBINTL_H && ENABLE_NLS) || defined _LIBC +#ifdef _LIBC # include # undef gettext -# ifdef _LIBC -# define gettext(msgid) \ +# define gettext(msgid) \ __dcgettext (_libc_intl_domainname, msgid, LC_MESSAGES) -# else -# define gettext(msgid) dgettext ("gnulib", msgid) -# endif -#else -# undef gettext -# define gettext(msgid) (msgid) -#endif - -#ifndef gettext_noop -/* This define is so xgettext can find the internationalizable - strings. */ # define gettext_noop(String) String +#else +# include "gettext.h" #endif /* Number of ASCII characters. */ diff --git a/lib/set-permissions.c b/lib/set-permissions.c index 2da2e98e426..af0b5de228d 100644 --- a/lib/set-permissions.c +++ b/lib/set-permissions.c @@ -25,17 +25,13 @@ #include "minmax.h" #if USE_ACL -# if ! defined HAVE_ACL_FROM_MODE && defined HAVE_ACL_FROM_TEXT /* FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */ +# if ! defined HAVE_ACL_FROM_MODE && defined HAVE_ACL_FROM_TEXT /* FreeBSD, Cygwin >= 2.5 */ # if HAVE_ACL_GET_FILE && !HAVE_ACL_TYPE_EXTENDED static acl_t acl_from_mode (mode_t mode) { -# if HAVE_ACL_FREE_TEXT /* Tru64 */ - char acl_text[] = "u::---,g::---,o::---,"; -# else /* FreeBSD, IRIX, Cygwin >= 2.5 */ char acl_text[] = "u::---,g::---,o::---"; -# endif if (mode & S_IRUSR) acl_text[ 3] = 'r'; if (mode & S_IWUSR) acl_text[ 4] = 'w'; @@ -490,9 +486,9 @@ set_acls (struct permission_context *ctx, const char *name, int desc, # if HAVE_ACL_GET_FILE /* POSIX 1003.1e (draft 17 -- abandoned) specific version. */ - /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ + /* Linux, FreeBSD, Mac OS X, Cygwin >= 2.5 */ # if !HAVE_ACL_TYPE_EXTENDED - /* Linux, FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */ + /* Linux, FreeBSD, Cygwin >= 2.5 */ # ifndef HAVE_ACL_FROM_TEXT # error Must have acl_from_text (see POSIX 1003.1e draft 17). diff --git a/lib/sig2str.c b/lib/sig2str.c index e8c830c6daf..bf4d009578d 100644 --- a/lib/sig2str.c +++ b/lib/sig2str.c @@ -288,7 +288,7 @@ str2signum (char const *signame) { unsigned int i; for (i = 0; i < NUMNAME_ENTRIES; i++) - if (strcmp (numname_table[i].name, signame) == 0) + if (streq (numname_table[i].name, signame)) return numname_table[i].num; { diff --git a/lib/sigdescr_np.c b/lib/sigdescr_np.c index 46c746ae072..6715269e05e 100644 --- a/lib/sigdescr_np.c +++ b/lib/sigdescr_np.c @@ -26,7 +26,7 @@ const char * sigdescr_np (int sig) { - /* Note: Some platforms (glibc, FreeBSD, NetBSD, OpenBSD, AIX, IRIX, Haiku, + /* Note: Some platforms (glibc, FreeBSD, NetBSD, OpenBSD, AIX, Haiku, Android) have an array 'sys_siglist'. (On AIX, you need to declare it yourself, and it has fewer than NSIG elements.) Its contents varies depending on the OS. @@ -160,12 +160,7 @@ sigdescr_np (int sig) case SIGBREAK: return "Ctrl-Break"; #endif - /* IRIX */ - #if defined SIGCKPT - case SIGCKPT: - return "Checkpoint"; /* See man 1 cpr, man 3C atcheckpoint */ - #endif - /* Linux, IRIX, Cygwin */ + /* Linux, Cygwin */ #if defined SIGCLD && SIGCLD != SIGCHLD case SIGCLD: return "Child stopped or exited"; @@ -182,7 +177,7 @@ sigdescr_np (int sig) /* AIX: "Paging space low". */ return "Swap space nearly exhausted"; #endif - /* Mac OS X, FreeBSD, NetBSD, OpenBSD, Minix, AIX, IRIX, Cygwin, mingw */ + /* Mac OS X, FreeBSD, NetBSD, OpenBSD, Minix, AIX, Cygwin, mingw */ #if defined SIGEMT case SIGEMT: /* glibc/Hurd, *BSD: "EMT trap". Solaris: "Emulation trap". */ @@ -193,12 +188,12 @@ sigdescr_np (int sig) case SIGINFO: return "Information request"; #endif - /* Linux, Mac OS X, FreeBSD, NetBSD, OpenBSD, Minix, AIX, IRIX, Cygwin */ + /* Linux, Mac OS X, FreeBSD, NetBSD, OpenBSD, Minix, AIX, Cygwin */ #if defined SIGIO && SIGIO != SIGPOLL case SIGIO: return "I/O possible"; #endif - /* Linux, IRIX, Cygwin, mingw */ + /* Linux, Cygwin, mingw */ #if defined SIGIOT && SIGIOT != SIGABRT case SIGIOT: return "IOT instruction"; /* a PDP-11 instruction */ @@ -267,17 +262,7 @@ sigdescr_np (int sig) case SIGPRE: return "Programmed exception"; #endif - /* IRIX */ - #if defined SIGPTINTR - case SIGPTINTR: - return "Pthread interrupt"; - #endif - /* IRIX */ - #if defined SIGPTRESCHED - case SIGPTRESCHED: - return "Pthread rescheduling"; - #endif - /* Linux, NetBSD, Minix, AIX, IRIX, Cygwin */ + /* Linux, NetBSD, Minix, AIX, Cygwin */ #if defined SIGPWR case SIGPWR: /* glibc: "Power failure". NetBSD: "Power fail/restart". */ @@ -293,11 +278,6 @@ sigdescr_np (int sig) case SIGRECOVERY: return "Kernel recovery"; #endif - /* IRIX */ - #if defined SIGRESTART - case SIGRESTART: - return "Checkpoint restart"; /* See man 1 cpr, man 3C atrestart */ - #endif /* AIX */ #if defined SIGRETRACT case SIGRETRACT: @@ -347,11 +327,6 @@ sigdescr_np (int sig) /* OpenBSD: "Thread AST". */ return "Thread library interrupt"; #endif - /* IRIX */ - #if defined SIGUME - case SIGUME: - return "Uncorrectable memory error"; - #endif /* AIX */ #if defined SIGVIRT case SIGVIRT: @@ -363,7 +338,7 @@ sigdescr_np (int sig) /* AIX: "No runnable lwp". */ return "Thread waiting"; #endif - /* Linux, Mac OS X, FreeBSD, NetBSD, OpenBSD, Minix, AIX, IRIX, Cygwin, Haiku */ + /* Linux, Mac OS X, FreeBSD, NetBSD, OpenBSD, Minix, AIX, Cygwin, Haiku */ #if defined SIGWINCH case SIGWINCH: /* glibc: "Window changed". *BSD: "Window size changed" or "Window size changes". */ diff --git a/lib/signal.in.h b/lib/signal.in.h index a2549e84235..66e0c310ef8 100644 --- a/lib/signal.in.h +++ b/lib/signal.in.h @@ -66,14 +66,14 @@ # include #endif -/* Mac OS X 10.3, FreeBSD < 8.0, OpenBSD < 5.1, OSF/1 4.0, Solaris 2.6, Android, +/* Mac OS X 10.3, FreeBSD < 8.0, OpenBSD < 5.1, Solaris 2.6, Android, OS/2 kLIBC declare pthread_sigmask in , not in . But avoid namespace pollution on glibc systems.*/ #if (@GNULIB_PTHREAD_SIGMASK@ || defined GNULIB_POSIXCHECK) \ && ((defined __APPLE__ && defined __MACH__) \ || (defined __FreeBSD__ && __FreeBSD__ < 8) \ || (defined __OpenBSD__ && OpenBSD < 201205) \ - || defined __osf__ || defined __sun || defined __ANDROID__ \ + || defined __sun || defined __ANDROID__ \ || defined __KLIBC__) \ && ! defined __GLIBC__ # include diff --git a/lib/stddef.in.h b/lib/stddef.in.h index e8c55ff1cdc..9ad768d785b 100644 --- a/lib/stddef.in.h +++ b/lib/stddef.in.h @@ -32,7 +32,7 @@ || defined __need_wint_t) \ /* Avoid warning triggered by "gcc -std=gnu23 -Wsystem-headers" \ in GCC 13.3 and 14.2 \ - . */ \ + . */ \ && !@STDDEF_NOT_IDEMPOTENT@ /* Special invocation convention inside gcc header files. In particular, in some ancient versions of GCC blindly @@ -91,7 +91,7 @@ typedef long max_align_t; # if !defined _GCC_NULLPTR_T && !@NULLPTR_T_NEEDS_STDDEF@ /* Suppress unwanted nullptr_t typedef. See - . */ + . */ # define _GCC_NULLPTR_T # endif diff --git a/lib/stdint.in.h b/lib/stdint.in.h index ca566b303ee..4df6433338f 100644 --- a/lib/stdint.in.h +++ b/lib/stdint.in.h @@ -51,13 +51,6 @@ in public interfaces due to compiler differences. */ #if @HAVE_STDINT_H@ -# if defined __sgi && ! defined __c99 - /* Bypass IRIX's if in C89 mode, since it merely annoys users - with "This header file is to be used only for c99 mode compilations" - diagnostics. */ -# define __STDINT_H__ -# endif - /* Some pre-C++11 implementations need this. */ # ifdef __cplusplus # ifndef __STDC_CONSTANT_MACROS @@ -94,8 +87,8 @@ #if ! @HAVE_C99_STDINT_H@ -/* defines some of the stdint.h types as well, on glibc, - IRIX 6.5, and OpenBSD 3.8 (via ). +/* defines some of the stdint.h types as well, on glibc and + OpenBSD 3.8 (via ). AIX 5.2 isn't needed and causes troubles. Mac OS X 10.4.6 includes (which is us), but relies on the system definitions, so include @@ -584,11 +577,7 @@ typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t) # endif /* wchar_t limits */ -/* Get WCHAR_MIN, WCHAR_MAX. - This include is not on the top, above, because on OSF/1 4.0 we have a - sequence of nested includes - -> -> -> , and the latter includes - and assumes its types are already defined. */ +/* Get WCHAR_MIN, WCHAR_MAX. */ # if @HAVE_WCHAR_H@ && ! (defined WCHAR_MIN && defined WCHAR_MAX) # define _GL_JUST_INCLUDE_SYSTEM_WCHAR_H # include diff --git a/lib/stdio-consolesafe.c b/lib/stdio-consolesafe.c new file mode 100644 index 00000000000..fbea20be224 --- /dev/null +++ b/lib/stdio-consolesafe.c @@ -0,0 +1,149 @@ +/* msvcrt workarounds. + Copyright (C) 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 . */ + +#include + +/* Specification. */ +#include + +#include +#include +#include + +/* Outputs N bytes starting at S to FP. + These N bytes are known to be followed by a NUL. + Finally frees the string at S. + Returns the number of written bytes. */ +static size_t +workaround_fwrite0 (char *s, size_t n, FILE *fp) +{ + const char *ptr = s; + /* Use fputs instead of fwrite, which is buggy in msvcrt. */ + size_t written = 0; + while (n > 0) + { + size_t l = strlen (ptr); /* 0 <= l <= n */ + if (l > 0) + { + if (fputs (ptr, fp) == EOF) + break; + written += l; + n -= l; + } + if (n == 0) + break; + if (fputc ('\0', fp) == EOF) + break; + written++; + n--; + ptr += l + 1; + } + free (s); + return written; +} + +size_t +gl_consolesafe_fwrite (const void *ptr, size_t size, size_t nmemb, FILE *fp) +{ + size_t nbytes; + if (ckd_mul (&nbytes, size, nmemb) || nbytes == 0) + /* Overflow, or nothing to do. */ + return 0; + char *tmp = malloc (nbytes + 1); + if (tmp == NULL) + return 0; + memcpy (tmp, ptr, nbytes); + tmp[nbytes] = '\0'; + size_t written = workaround_fwrite0 (tmp, nbytes, fp); + return written / size; +} + +#if defined __MINGW32__ && __USE_MINGW_ANSI_STDIO + +# include "fseterr.h" + +/* Bypass the functions __mingw_[v][f]printf, that trigger a bug in msvcrt, + but without losing the support for modern format specifiers added by + __mingw_*printf. */ + +int +gl_consolesafe_fprintf (FILE *restrict fp, const char *restrict format, ...) +{ + va_list args; + char *tmpstring; + va_start (args, format); + int result = vasprintf (&tmpstring, format, args); + va_end (args); + if (result >= 0) + { + if (workaround_fwrite0 (tmpstring, result, fp) < result) + result = -1; + } + else + fseterr (fp); + return result; +} + +int +gl_consolesafe_printf (const char *restrict format, ...) +{ + va_list args; + char *tmpstring; + va_start (args, format); + int result = vasprintf (&tmpstring, format, args); + va_end (args); + if (result >= 0) + { + if (workaround_fwrite0 (tmpstring, result, stdout) < result) + result = -1; + } + else + fseterr (stdout); + return result; +} + +int +gl_consolesafe_vfprintf (FILE *restrict fp, + const char *restrict format, va_list args) +{ + char *tmpstring; + int result = vasprintf (&tmpstring, format, args); + if (result >= 0) + { + if (workaround_fwrite0 (tmpstring, result, fp) < result) + result = -1; + } + else + fseterr (fp); + return result; +} + +int +gl_consolesafe_vprintf (const char *restrict format, va_list args) +{ + char *tmpstring; + int result = vasprintf (&tmpstring, format, args); + if (result >= 0) + { + if (workaround_fwrite0 (tmpstring, result, stdout) < result) + result = -1; + } + else + fseterr (stdout); + return result; +} + +#endif diff --git a/lib/stdio-impl.h b/lib/stdio-impl.h index 4abf9e68b23..e4a69a8d11b 100644 --- a/lib/stdio-impl.h +++ b/lib/stdio-impl.h @@ -108,15 +108,59 @@ # define _flags pub._flags # define _r pub._r # define _w pub._w -# elif defined __ANDROID__ || defined __OpenBSD__ /* Android, OpenBSD */ -# if defined __LP64__ && !defined __OpenBSD__ +# elif defined __OpenBSD__ /* OpenBSD */ +# if defined __sferror /* OpenBSD <= 7.7 */ +# define _gl_flags_file_t short +# else /* OpenBSD >= 7.8 */ +# define _gl_flags_file_t int +# endif + /* Up to this commit from 2025-07-16 + + the innards of FILE were public. After this commit, the innards of FILE + are hidden. In this commit + + they were reshuffled. */ +# if defined __sferror /* OpenBSD <= 7.7 */ +# define fp_ ((struct { unsigned char *_p; \ + int _r; \ + int _w; \ + _gl_flags_file_t _flags; \ + _gl_flags_file_t _file; \ + struct { unsigned char *_base; size_t _size; } _bf; \ + int _lbfsize; \ + void *_cookie; \ + void *_close; \ + void *_read; \ + void *_seek; \ + void *_write; \ + struct { unsigned char *_base; size_t _size; } _ext; \ + unsigned char *_up; \ + int _ur; \ + unsigned char _ubuf[3]; \ + unsigned char _nbuf[1]; \ + struct { unsigned char *_base; size_t _size; } _lb; \ + int _blksize; \ + fpos_t _offset; \ + /* More fields, not relevant here. */ \ + } *) fp) +# else /* OpenBSD >= 7.8 */ +# define fp_ ((struct { _gl_flags_file_t _flags; \ + _gl_flags_file_t _file; \ + unsigned char *_p; \ + int _r; \ + int _w; \ + struct { unsigned char *_base; size_t _size; } _bf; \ + int _lbfsize; \ + /* More fields, not relevant here. */ \ + } *) fp) +# endif +# elif defined __ANDROID__ /* Android */ +# if defined __LP64__ # define _gl_flags_file_t int # else # define _gl_flags_file_t short # endif -# if defined __OpenBSD__ -# define _gl_file_offset_t fpos_t -# elif defined __LP64__ +# if defined __LP64__ # define _gl_file_offset_t int64_t # else /* see https://android.googlesource.com/platform/bionic/+/master/docs/32-bit-abi.md */ @@ -127,9 +171,7 @@ the innards of FILE were public, see and . - After this commit, the innards of FILE are hidden. Likewise for OpenBSD - up to this commit from 2025-07-16 - . */ + After this commit, the innards of FILE are hidden. */ # define fp_ ((struct { unsigned char *_p; \ int _r; \ int _w; \ diff --git a/lib/stdio.in.h b/lib/stdio.in.h index e80862125df..cc6010119d0 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h @@ -22,12 +22,7 @@ #if defined __need_FILE || defined __need___FILE || defined _@GUARD_PREFIX@_ALREADY_INCLUDING_STDIO_H || defined _GL_SKIP_GNULIB_STDIO_H /* Special invocation convention: - - Inside glibc header files. - - On OSF/1 5.1 we have a sequence of nested includes - -> -> -> -> - -> -> -> . - In this situation, the functions are not yet declared, therefore we cannot - provide the C++ aliases. */ + - Inside glibc header files. */ #@INCLUDE_NEXT@ @NEXT_STDIO_H@ @@ -269,10 +264,6 @@ - with MSVC ucrt: "[-]nan" or "[-]nan(ind)" or "[-]nan(snan)", - with mingw: "[-]1.#IND" or "[-]1.#QNAN". */ # define _PRINTF_NAN_LEN_MAX 10 -# elif defined __sgi -/* On IRIX, the output typically is "[-]nan0xNNNNNNNN" with 8 hexadecimal - digits. */ -# define _PRINTF_NAN_LEN_MAX 14 # else /* We don't know, but 32 should be a safe maximum. */ # define _PRINTF_NAN_LEN_MAX 32 @@ -280,6 +271,33 @@ #endif +#if (defined _WIN32 && !defined __CYGWIN__) && !defined _UCRT +/* Workarounds against msvcrt bugs. */ +_GL_FUNCDECL_SYS (gl_consolesafe_fwrite, size_t, + (const void *ptr, size_t size, size_t nmemb, FILE *fp), + _GL_ARG_NONNULL ((1, 4))); +# if defined __MINGW32__ +_GL_FUNCDECL_SYS (gl_consolesafe_fprintf, int, + (FILE *restrict fp, const char *restrict format, ...), + _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 3) + _GL_ARG_NONNULL ((1, 2))); +_GL_FUNCDECL_SYS (gl_consolesafe_printf, int, + (const char *restrict format, ...), + _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (1, 2) + _GL_ARG_NONNULL ((1))); +_GL_FUNCDECL_SYS (gl_consolesafe_vfprintf, int, + (FILE *restrict fp, + const char *restrict format, va_list args), + _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 0) + _GL_ARG_NONNULL ((1, 2))); +_GL_FUNCDECL_SYS (gl_consolesafe_vprintf, int, + (const char *restrict format, va_list args), + _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (1, 0) + _GL_ARG_NONNULL ((1))); +# endif +#endif + + #if @GNULIB_DZPRINTF@ /* Prints formatted output to file descriptor FD. Returns the number of bytes written to the file descriptor. Upon @@ -616,6 +634,11 @@ _GL_CXXALIAS_SYS (fprintf, int, # if __GLIBC__ >= 2 _GL_CXXALIASWARN (fprintf); # endif +#elif defined __MINGW32__ && !defined _UCRT && __USE_MINGW_ANSI_STDIO +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef fprintf +# define fprintf gl_consolesafe_fprintf +# endif #endif #if !@GNULIB_FPRINTF_POSIX@ && defined GNULIB_POSIXCHECK # if !GNULIB_overrides_fprintf @@ -945,7 +968,7 @@ _GL_CXXALIAS_SYS (fwrite, size_t, FILE *restrict stream)); /* Work around bug 11959 when fortifying glibc 2.4 through 2.15 - , + , which sometimes causes an unwanted diagnostic for fwrite calls. This affects only function declaration attributes under certain versions of gcc and clang, and is not needed for C++. */ @@ -970,6 +993,11 @@ _GL_EXTERN_C size_t __REDIRECT (rpl_fwrite_unlocked, # if __GLIBC__ >= 2 _GL_CXXALIASWARN (fwrite); # endif +#elif (defined _WIN32 && !defined __CYGWIN__) && !defined _UCRT +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef fwrite +# define fwrite gl_consolesafe_fwrite +# endif #endif #if @GNULIB_GETC@ @@ -1016,6 +1044,17 @@ _GL_CXXALIASWARN (getchar); # undef getdelim # define getdelim rpl_getdelim # endif +# ifndef __has_feature +# define __has_feature(a) 0 +# endif +# if __GLIBC__ >= 2 && !(defined __SANITIZE_ADDRESS__ \ + || __has_feature (address_sanitizer)) +/* Arrange for the inline definition of getline() in + to call our getdelim() override. Do not use the __getdelim symbol + if address sanitizer is in use, otherwise it may be overridden by + __interceptor_trampoline___getdelim. */ +# define rpl_getdelim __getdelim +# endif _GL_FUNCDECL_RPL (getdelim, ssize_t, (char **restrict lineptr, size_t *restrict linesize, int delimiter, @@ -1057,14 +1096,27 @@ _GL_WARN_ON_USE (getdelim, "getdelim is unportable - " Return the number of bytes read and stored at *LINEPTR (not including the NUL terminator), or -1 on error or EOF. */ # if @REPLACE_GETLINE@ -# if !(defined __cplusplus && defined GNULIB_NAMESPACE) -# undef getline -# define getline rpl_getline -# endif _GL_FUNCDECL_RPL (getline, ssize_t, (char **restrict lineptr, size_t *restrict linesize, FILE *restrict stream), _GL_ARG_NONNULL ((1, 2, 3)) _GL_ATTRIBUTE_NODISCARD); +# if defined __cplusplus +/* The C++ standard library defines std::basic_istream::getline in + or . */ +# if !(__GLIBC__ >= 2) +extern "C" { +inline ssize_t +getline (char **restrict lineptr, size_t *restrict linesize, + FILE *restrict stream) +{ + return rpl_getline (lineptr, linesize, stream); +} +} +# endif +# else +# undef getline +# define getline rpl_getline +# endif _GL_CXXALIAS_RPL (getline, ssize_t, (char **restrict lineptr, size_t *restrict linesize, FILE *restrict stream)); @@ -1333,6 +1385,11 @@ _GL_CXXALIAS_SYS (printf, int, (const char *restrict format, ...)); # if __GLIBC__ >= 2 _GL_CXXALIASWARN (printf); # endif +#elif defined __MINGW32__ && !defined _UCRT && __USE_MINGW_ANSI_STDIO +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef printf +# define printf gl_consolesafe_printf +# endif #endif #if !@GNULIB_PRINTF_POSIX@ && defined GNULIB_POSIXCHECK # if !GNULIB_overrides_printf @@ -1885,6 +1942,11 @@ _GL_CXXALIAS_SYS_CAST (vfprintf, int, # if __GLIBC__ >= 2 _GL_CXXALIASWARN (vfprintf); # endif +#elif defined __MINGW32__ && !defined _UCRT && __USE_MINGW_ANSI_STDIO +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef vfprintf +# define vfprintf gl_consolesafe_vfprintf +# endif #endif #if !@GNULIB_VFPRINTF_POSIX@ && defined GNULIB_POSIXCHECK # if !GNULIB_overrides_vfprintf @@ -1966,6 +2028,11 @@ _GL_CXXALIAS_SYS_CAST (vprintf, int, # if __GLIBC__ >= 2 _GL_CXXALIASWARN (vprintf); # endif +#elif defined __MINGW32__ && !defined _UCRT && __USE_MINGW_ANSI_STDIO +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef vprintf +# define vprintf gl_consolesafe_vprintf +# endif #endif #if !@GNULIB_VPRINTF_POSIX@ && defined GNULIB_POSIXCHECK # if !GNULIB_overrides_vprintf diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index 1342db48772..bef0aaaf92e 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -62,12 +62,6 @@ /* NetBSD 5.0 mis-defines NULL. */ #include -/* MirBSD 10 defines WEXITSTATUS in , not in . - glibc 2.41 defines WCOREDUMP in , not in . */ -#if @GNULIB_SYSTEM_POSIX@ && !(defined WEXITSTATUS && defined WCOREDUMP) -# include -#endif - /* Solaris declares getloadavg() in . */ #if (@GNULIB_GETLOADAVG@ || defined GNULIB_POSIXCHECK) && @HAVE_SYS_LOADAVG_H@ /* OpenIndiana has a bug: must be included before @@ -83,13 +77,6 @@ #if @GNULIB_RANDOM_R@ -/* OSF/1 5.1 declares 'struct random_data' in , which is included - from if _REENTRANT is defined. Include it whenever we need - 'struct random_data'. */ -# if @HAVE_RANDOM_H@ -# include -# endif - # include # if !@HAVE_STRUCT_RANDOM_DATA@ @@ -2027,6 +2014,18 @@ _GL_CXXALIASWARN (wctomb); _GL_INLINE_HEADER_END + +/* Includes that provide only macros that don't need to be overridden. + (Includes that are needed for type definitions and function declarations + have their place above, before the function overrides.) */ + +/* MirBSD 10 defines WEXITSTATUS in , not in . + glibc 2.41 defines WCOREDUMP in , not in . */ +#if @GNULIB_SYSTEM_POSIX@ && !(defined WEXITSTATUS && defined WCOREDUMP) +# include +#endif + + #endif /* _@GUARD_PREFIX@_STDLIB_H */ #endif /* _@GUARD_PREFIX@_STDLIB_H */ #endif diff --git a/lib/strftime.c b/lib/strftime.c index 537172d8be6..6445d6e3d28 100644 --- a/lib/strftime.c +++ b/lib/strftime.c @@ -110,6 +110,7 @@ #include #include #include +#include #include #include @@ -198,17 +199,48 @@ enum pad_style # define mktime(tp) __mktime64 (tp) #endif +/* For functions that fill an in-memory string, the number of bytes fits in a + size_t. For functions that write to a stream, the number of bytes fits in + an off64_t (a type that is always at least 64 bits large). */ #if FPRINTFTIME # define STREAM_OR_CHAR_T FILE # define STRFTIME_ARG(x) /* empty */ +typedef off64_t byte_count_t; +typedef off64_t sbyte_count_t; #else # define STREAM_OR_CHAR_T CHAR_T # define STRFTIME_ARG(x) x, +typedef size_t byte_count_t; +typedef ptrdiff_t sbyte_count_t; +#endif + +/* The functions strftime[_l], wcsftime[_l] defined by glibc have a return type + 'size_t', for compatibility with POSIX, and return 0 upon failure. + The functions defined by Gnulib have a signed return type, and return -1 + upon failure. */ +#ifdef _LIBC +typedef size_t retval_t; +# define FAILURE 0 +#else +typedef sbyte_count_t retval_t; +# define FAILURE (-1) #endif #if FPRINTFTIME +# define FPUTC(Byte, P) \ + do \ + { \ + int _r = fputc (Byte, P); \ + if (_r < 0) \ + return FAILURE; \ + } \ + while (false) + # define memset_byte(P, Len, Byte) \ - do { size_t _i; for (_i = 0; _i < Len; _i++) fputc (Byte, P); } while (0) + do \ + for (byte_count_t _i = Len; 0 < _i; _i--) \ + FPUTC (Byte, P); \ + while (false) # define memset_space(P, Len) memset_byte (P, Len, ' ') # define memset_zero(P, Len) memset_byte (P, Len, '0') #elif defined COMPILE_WIDE @@ -226,22 +258,32 @@ enum pad_style #endif #define add(n, f) width_add (width, n, f) + +/* Add INCR, returning true if I would become too large. + INCR should not have side effects. */ +#if FPRINTFTIME +# define incr_overflow(incr) ckd_add (&i, i, incr) +#else +/* Use <= not <, to leave room for trailing NUL. */ +# define incr_overflow(incr) (maxsize - i <= (incr) || (i += (incr), false)) +#endif + #define width_add(width, n, f) \ do \ { \ - size_t _n = (n); \ - size_t _w = pad == NO_PAD || width < 0 ? 0 : width; \ - size_t _incr = _n < _w ? _w : _n; \ - if (_incr >= maxsize - i) \ + byte_count_t _n = n; \ + byte_count_t _w = pad == NO_PAD || width < 0 ? 0 : width; \ + byte_count_t _incr = _n < _w ? _w : _n; \ + if (incr_overflow (_incr)) \ { \ errno = ERANGE; \ - return 0; \ + return FAILURE; \ } \ if (p) \ { \ if (_n < _w) \ { \ - size_t _delta = _w - _n; \ + byte_count_t _delta = _w - _n; \ if (pad == ALWAYS_ZERO_PAD || pad == SIGN_PAD) \ memset_zero (p, _delta); \ else \ @@ -250,12 +292,11 @@ enum pad_style f; \ advance (p, _n); \ } \ - i += _incr; \ } while (0) #define add1(c) width_add1 (width, c) #if FPRINTFTIME -# define width_add1(width, c) width_add (width, 1, fputc (c, p)) +# define width_add1(width, c) width_add (width, 1, FPUTC (c, p)) #else # define width_add1(width, c) width_add (width, 1, *p = c) #endif @@ -266,19 +307,15 @@ enum pad_style width_add (width, n, \ do \ { \ + CHAR_T const *_s = s; \ if (to_lowcase) \ - fwrite_lowcase (p, (s), _n); \ + for (byte_count_t _i = 0; _i < _n; _i++) \ + FPUTC (TOLOWER ((UCHAR_T) _s[_i], loc), p); \ else if (to_uppcase) \ - fwrite_uppcase (p, (s), _n); \ - else \ - { \ - /* Ignore the value of fwrite. The caller can determine whether \ - an error occurred by inspecting ferror (P). All known fwrite \ - implementations set the stream's error indicator when they \ - fail due to ENOMEM etc., even though C11 and POSIX.1-2008 do \ - not require this. */ \ - fwrite (s, _n, 1, p); \ - } \ + for (byte_count_t _i = 0; _i < _n; _i++) \ + FPUTC (TOUPPER ((UCHAR_T) _s[_i], loc), p); \ + else if (fwrite (_s, _n, 1, p) == 0) \ + return FAILURE; \ } \ while (0) \ ) @@ -355,32 +392,12 @@ enum pad_style /* Avoid false GCC warning "'memset' specified size 18446744073709551615 exceeds maximum object size 9223372036854775807", caused by insufficient data flow analysis and value propagation of the 'width_add' expansion when GCC is not - optimizing. Cf. . */ + optimizing. Cf. . */ #if _GL_GNUC_PREREQ (7, 0) && !__OPTIMIZE__ # pragma GCC diagnostic ignored "-Wstringop-overflow" #endif -#if FPRINTFTIME -static void -fwrite_lowcase (FILE *fp, const CHAR_T *src, size_t len) -{ - while (len-- > 0) - { - fputc (TOLOWER ((UCHAR_T) *src, loc), fp); - ++src; - } -} - -static void -fwrite_uppcase (FILE *fp, const CHAR_T *src, size_t len) -{ - while (len-- > 0) - { - fputc (TOUPPER ((UCHAR_T) *src, loc), fp); - ++src; - } -} -#else +#if !FPRINTFTIME static CHAR_T *memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM); @@ -894,12 +911,14 @@ static CHAR_T const c_month_names[][sizeof "September"] = # define ns 0 #endif -static size_t __strftime_internal (STREAM_OR_CHAR_T *, STRFTIME_ARG (size_t) - const CHAR_T *, const struct tm *, - CAL_ARGS (const struct calendar *, - struct calendar_date *) - bool, enum pad_style, int, bool * - extra_args_spec LOCALE_PARAM); +static retval_t __strftime_internal (STREAM_OR_CHAR_T *, + STRFTIME_ARG (size_t) + const CHAR_T *, const struct tm *, + CAL_ARGS (const struct calendar *, + struct calendar_date *) + bool, enum pad_style, + sbyte_count_t, bool * + extra_args_spec LOCALE_PARAM); #if !defined _LIBC \ && (!(HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)) \ @@ -1102,12 +1121,16 @@ get_tm_zone (timezone_t tz, char *ubuf, int ubufsize, int modifier, } /* Write information from TP into S according to the format - string FORMAT, writing no more that MAXSIZE characters - (including the terminating '\0') and returning number of - characters written. If S is NULL, nothing will be written - anywhere, so to determine how many characters would be - written, use NULL for S and (size_t) -1 for MAXSIZE. */ -size_t + string FORMAT. Return the number of bytes written. + Upon failure: + - return 0 for the functions defined by glibc, + - return -1 for the functions defined by Gnulib. + + If !FPRINTFTIME, write no more than MAXSIZE bytes (including the + terminating '\0'), and if S is NULL do not write into S. + To determine how many characters would be written, use NULL for S + and (size_t) -1 for MAXSIZE. */ +retval_t my_strftime (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) const CHAR_T *format, const struct tm *tp extra_args_spec LOCALE_PARAM) @@ -1150,24 +1173,26 @@ libc_hidden_def (my_strftime) UPCASE indicates that the result should be converted to upper case. YR_SPEC and WIDTH specify the padding and width for the year. *TZSET_CALLED indicates whether tzset has been called here. */ -static size_t +static retval_t __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) const CHAR_T *format, const struct tm *tp, CAL_ARGS (const struct calendar *cal, struct calendar_date *caldate) bool upcase, - enum pad_style yr_spec, int width, bool *tzset_called + enum pad_style yr_spec, sbyte_count_t width, + bool *tzset_called extra_args_spec LOCALE_PARAM) { #if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL struct __locale_data *const current = loc->__locales[LC_TIME]; #endif -#if FPRINTFTIME - size_t maxsize = (size_t) -1; -#endif - +#if FAILURE == 0 int saved_errno = errno; +#elif !FPRINTFTIME + if (PTRDIFF_MAX < maxsize) + maxsize = PTRDIFF_MAX; +#endif #ifdef _NL_CURRENT /* We cannot make the following values variables since we must delay @@ -1221,7 +1246,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) # define ampm (L_("AMPM") + 2 * (tp->tm_hour > 11)) # define ap_len 2 #endif - size_t i = 0; + retval_t i = 0; STREAM_OR_CHAR_T *p = s; const CHAR_T *f; #if DO_MULTIBYTE && !defined COMPILE_WIDE @@ -1260,7 +1285,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) size_t colons; bool change_case = false; int format_char; - int subwidth; + sbyte_count_t subwidth; #if DO_MULTIBYTE && !defined COMPILE_WIDE switch (*f) @@ -1384,7 +1409,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) { if (ckd_mul (&width, width, 10) || ckd_add (&width, width, *f - L_('0'))) - width = INT_MAX; + return FAILURE; ++f; } while (ISDIGIT (*f)); @@ -1585,12 +1610,15 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) subwidth = -1; subformat_width: { - size_t len = __strftime_internal (NULL, STRFTIME_ARG ((size_t) -1) - subfmt, tp, - CAL_ARGS (cal, caldate) - to_uppcase, pad, subwidth, - tzset_called - extra_args LOCALE_ARG); + retval_t len = + __strftime_internal (NULL, STRFTIME_ARG ((size_t) -1) + subfmt, tp, + CAL_ARGS (cal, caldate) + to_uppcase, pad, subwidth, + tzset_called + extra_args LOCALE_ARG); + if (FAILURE < 0 && len < 0) + return FAILURE; /* errno is set here */ add (len, __strftime_internal (p, STRFTIME_ARG (maxsize - i) subfmt, tp, @@ -1862,8 +1890,9 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) if (digits_base >= 0x100) number_digits = number_bytes / 2; #endif - int shortage = width - !!sign_char - number_digits; - int padding = pad == NO_PAD || shortage <= 0 ? 0 : shortage; + byte_count_t shortage = width - !!sign_char - number_digits; + byte_count_t padding = (pad == NO_PAD || shortage <= 0 + ? 0 : shortage); if (sign_char) { @@ -1871,7 +1900,11 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) { if (p) memset_space (p, padding); - i += padding; + if (ckd_add (&i, i, padding) && FPRINTFTIME) + { + errno = ERANGE; + return FAILURE; + } width -= padding; } width_add1 (0, sign_char); @@ -2033,7 +2066,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) if (ltm.tm_yday < 0) { errno = EOVERFLOW; - return 0; + return FAILURE; } /* Generate string value for T using time_t arithmetic; @@ -2252,12 +2285,12 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) mbstate_t st = {0}; size_t len = __mbsrtowcs_l (p, &z, maxsize - i, &st, loc); if (len == (size_t) -1) - return 0; + return FAILURE; size_t incr = len < w ? w : len; if (incr >= maxsize - i) { errno = ERANGE; - return 0; + return FAILURE; } if (p) { @@ -2375,6 +2408,9 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) *p = L_('\0'); #endif +#if FAILURE == 0 errno = saved_errno; +#endif + return i; } diff --git a/lib/strftime.h b/lib/strftime.h index a76c98c9c82..bb2b63b075f 100644 --- a/lib/strftime.h +++ b/lib/strftime.h @@ -15,6 +15,7 @@ You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . */ +#include #include #ifdef __cplusplus @@ -71,23 +72,32 @@ extern "C" { Store the result, as a string with a trailing NUL character, at the beginning of the array __S[0..__MAXSIZE-1] and return the length of - that string, not counting the trailing NUL, and without changing errno. - If unsuccessful, possibly change the array __S, set errno, and return 0; + that string, not counting the trailing NUL. + If unsuccessful, possibly change the array __S, set errno, and return -1; errno == ERANGE means the string didn't fit. + As a glibc extension if __S is null, do not store anything, and + return the value that would have been returned had __S been non-null. + + A __MAXSIZE greater than PTRDIFF_MAX is silently treated as if + it were PTRDIFF_MAX, so that the caller can safely add 1 to + any return value without overflow. + This function is like strftime, but with two more arguments: * __TZ instead of the local timezone information, - * __NS as the number of nanoseconds in the %N directive. + * __NS as the number of nanoseconds in the %N directive, + and on success it does not preserve errno, + and on failure it returns -1 not 0. */ -size_t nstrftime (char *restrict __s, size_t __maxsize, - char const *__format, - struct tm const *__tp, timezone_t __tz, int __ns); +ptrdiff_t nstrftime (char *restrict __s, size_t __maxsize, + char const *__format, + struct tm const *__tp, timezone_t __tz, int __ns); /* Like nstrftime, except that it uses the "C" locale instead of the current locale. */ -size_t c_nstrftime (char *restrict __s, size_t __maxsize, - char const *__format, - struct tm const *__tp, timezone_t __tz, int __ns); +ptrdiff_t c_nstrftime (char *restrict __s, size_t __maxsize, + char const *__format, + struct tm const *__tp, timezone_t __tz, int __ns); #ifdef __cplusplus } diff --git a/lib/string.c b/lib/string.c new file mode 100644 index 00000000000..cce2eac9c06 --- /dev/null +++ b/lib/string.c @@ -0,0 +1,20 @@ +/* streq and memeq functions. + Copyright (C) 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 . */ + +#include + +#define _GL_STRING_INLINE _GL_EXTERN_INLINE +#include diff --git a/lib/string.in.h b/lib/string.in.h index 9a039c7ba06..fdcdd21bed6 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -80,6 +80,12 @@ # include #endif +_GL_INLINE_HEADER_BEGIN + +#ifndef _GL_STRING_INLINE +# define _GL_STRING_INLINE _GL_INLINE +#endif + /* _GL_ATTRIBUTE_DEALLOC (F, I) declares that the function returns pointers that can be freed by passing them as the Ith argument to the function F. */ @@ -96,7 +102,7 @@ /* Applies to: functions. Cannot be used on inline functions. */ #ifndef _GL_ATTRIBUTE_DEALLOC_FREE # if defined __cplusplus && defined __GNUC__ && !defined __clang__ -/* Work around GCC bug */ +/* Work around GCC bug */ # define _GL_ATTRIBUTE_DEALLOC_FREE \ _GL_ATTRIBUTE_DEALLOC ((void (*) (void *)) free, 1) # else @@ -409,6 +415,21 @@ _GL_WARN_ON_USE (memchr, "memchr has platform-specific bugs - " "use gnulib module memchr for portability" ); #endif +/* Are S1 and S2, of size N, bytewise equal? */ +#if @GNULIB_STRINGEQ@ && !@HAVE_DECL_MEMEQ@ +# ifdef __cplusplus +extern "C" { +# endif +_GL_STRING_INLINE bool +memeq (void const *__s1, void const *__s2, size_t __n) +{ + return !memcmp (__s1, __s2, __n); +} +# ifdef __cplusplus +} +# endif +#endif + /* Return the first occurrence of NEEDLE in HAYSTACK. */ #if @GNULIB_MEMMEM@ # if @REPLACE_MEMMEM@ @@ -789,6 +810,21 @@ _GL_CXXALIASWARN (strdup); # endif #endif +/* Are strings S1 and S2 equal? */ +#if @GNULIB_STRINGEQ@ && !@HAVE_DECL_STREQ@ +# ifdef __cplusplus +extern "C" { +# endif +_GL_STRING_INLINE bool +streq (char const *__s1, char const *__s2) +{ + return !strcmp (__s1, __s2); +} +# ifdef __cplusplus +} +# endif +#endif + /* Append no more than N characters from SRC onto DEST. */ #if @GNULIB_STRNCAT@ # if @REPLACE_STRNCAT@ @@ -1208,7 +1244,7 @@ _GL_EXTERN_C bool str_endswith (const char *string, const char *prefix) # ifdef __MirBSD__ /* MirBSD defines mbslen as a macro. Override it. */ # undef mbslen # endif -# if @HAVE_MBSLEN@ /* AIX, OSF/1, MirBSD define mbslen already in libc. */ +# if @HAVE_MBSLEN@ /* AIX, MirBSD define mbslen already in libc. */ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) # define mbslen rpl_mbslen # endif @@ -1722,6 +1758,7 @@ _GL_WARN_ON_USE (strverscmp, "strverscmp is unportable - " # endif #endif +_GL_INLINE_HEADER_END #endif /* _@GUARD_PREFIX@_STRING_H */ #endif /* _@GUARD_PREFIX@_STRING_H */ diff --git a/lib/sys-limits.h b/lib/sys-limits.h index a556dfeb6d5..5f074fc7db6 100644 --- a/lib/sys-limits.h +++ b/lib/sys-limits.h @@ -30,10 +30,6 @@ Using this also works around a serious Linux bug before 2.6.16; see . - Using this also works around a Tru64 5.1 bug, where attempting - to read INT_MAX bytes fails with errno == EINVAL. See - . - Using this is likely to work around similar bugs in other operating systems. */ diff --git a/lib/sys_select.in.h b/lib/sys_select.in.h index a06725020d2..69c2fa9fc4e 100644 --- a/lib/sys_select.in.h +++ b/lib/sys_select.in.h @@ -26,17 +26,14 @@ #error "Please include config.h first." #endif -/* On OSF/1 and Solaris 2.6, and - both include . +/* On Solaris 2.6, and both include . On Cygwin and OpenBSD, includes . Simply delegate to the system's header in this case. */ #if (@HAVE_SYS_SELECT_H@ \ && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TYPES_H \ - && ((defined __osf__ && defined _SYS_TYPES_H_ \ - && defined _OSF_SOURCE) \ - || (defined __sun && defined _SYS_TYPES_H \ - && (! (defined _XOPEN_SOURCE || defined _POSIX_C_SOURCE) \ - || defined __EXTENSIONS__)))) + && (defined __sun && defined _SYS_TYPES_H \ + && (! (defined _XOPEN_SOURCE || defined _POSIX_C_SOURCE) \ + || defined __EXTENSIONS__))) # define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TYPES_H # @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@ @@ -44,9 +41,7 @@ #elif (@HAVE_SYS_SELECT_H@ \ && (defined _CYGWIN_SYS_TIME_H \ || (!defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H \ - && ((defined __osf__ && defined _SYS_TIME_H_ \ - && defined _OSF_SOURCE) \ - || (defined __OpenBSD__ && defined _SYS_TIME_H_) \ + && ((defined __OpenBSD__ && defined _SYS_TIME_H_) \ || (defined __sun && defined _SYS_TIME_H \ && (! (defined _XOPEN_SOURCE \ || defined _POSIX_C_SOURCE) \ @@ -55,16 +50,6 @@ # define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H # @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@ -/* On IRIX 6.5, includes , which includes - , which includes . At this point we cannot - include , because that includes , which - gives a syntax error because has not been completely - processed. Simply delegate to the system's header in this case. */ -#elif @HAVE_SYS_SELECT_H@ && defined __sgi && (defined _SYS_BSD_TYPES_H && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_BSD_TYPES_H) - -# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_BSD_TYPES_H -# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@ - /* On OpenBSD 5.0, includes , which includes . At this point we cannot include , because that includes gnulib's pthread.h override, which gives a syntax error because @@ -90,10 +75,7 @@ #if @HAVE_SYS_SELECT_H@ -/* On OSF/1 4.0, provides only a forward declaration - of 'struct timeval', and no definition of this type. - Also, Mac OS X, AIX, HP-UX, IRIX, Solaris, Interix declare select() - in . +/* Mac OS X, AIX, HP-UX, Solaris, Interix declare select() in . But avoid namespace pollution on glibc systems, a circular include -> -> on FreeBSD 13.1, and "unknown type name" problems on Cygwin. */ @@ -101,14 +83,6 @@ # include # endif -/* On AIX 7 and Solaris 10, provides an FD_ZERO implementation - that relies on memset(), but without including . - But in any case avoid namespace pollution on glibc systems. */ -# if (defined __OpenBSD__ || defined _AIX || defined __sun || defined __osf__ || defined __BEOS__) \ - && ! defined __GLIBC__ -# include -# endif - /* The include_next requires a split double-inclusion guard. */ # @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@ @@ -352,5 +326,20 @@ _GL_WARN_ON_USE (select, "select is not always POSIX compliant - " #endif /* _@GUARD_PREFIX@_SYS_SELECT_H */ + + +/* Includes that provide only macros that don't need to be overridden. + (Includes that are needed for type definitions and function declarations + have their place above, before the function overrides.) */ + +/* On AIX 7 and Solaris 10, provides an FD_ZERO implementation + that relies on memset(), but without including . + But in any case avoid namespace pollution on glibc systems. */ +# if (defined __OpenBSD__ || defined _AIX || defined __sun || defined __BEOS__) \ + && ! defined __GLIBC__ +# include +# endif + + #endif /* _@GUARD_PREFIX@_SYS_SELECT_H */ -#endif /* OSF/1 */ +#endif diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h index c3c38fd653e..8f676cb390e 100644 --- a/lib/sys_stat.in.h +++ b/lib/sys_stat.in.h @@ -790,8 +790,7 @@ _GL_CXXALIAS_RPL (mknod, int, (char const *file, mode_t mode, dev_t dev)); _GL_FUNCDECL_SYS (mknod, int, (char const *file, mode_t mode, dev_t dev), _GL_ARG_NONNULL ((1))); # endif -/* Need to cast, because on OSF/1 5.1, the third parameter is '...'. */ -_GL_CXXALIAS_SYS_CAST (mknod, int, (char const *file, mode_t mode, dev_t dev)); +_GL_CXXALIAS_SYS (mknod, int, (char const *file, mode_t mode, dev_t dev)); # endif _GL_CXXALIASWARN (mknod); #elif defined GNULIB_POSIXCHECK diff --git a/lib/time.in.h b/lib/time.in.h index 3ff16e3b3e4..d28702d2f61 100644 --- a/lib/time.in.h +++ b/lib/time.in.h @@ -523,11 +523,18 @@ _GL_CXXALIAS_SYS (tzalloc, timezone_t, (char const *__name)); # endif /* tzfree (tz) - Frees a time zone object. + Free a time zone object, preserving errno. The argument must have been returned by tzalloc(). */ # if !@HAVE_TZALLOC@ _GL_FUNCDECL_SYS (tzfree, void, (timezone_t __tz), ); _GL_CXXALIAS_SYS (tzfree, void, (timezone_t __tz)); +# else +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef tzfree +# define tzfree rpl_tzfree +# endif +_GL_FUNCDECL_RPL (tzfree, void, (timezone_t __tz), ); +_GL_CXXALIAS_RPL (tzfree, void, (timezone_t __tz)); # endif /* localtime_rz (tz, &t, &result) diff --git a/lib/time_rz.c b/lib/time_rz.c index 125f4e272d2..8a8eb44c357 100644 --- a/lib/time_rz.c +++ b/lib/time_rz.c @@ -27,7 +27,10 @@ /* Specification. */ #include -#if NEED_TIMEZONE_NULL_SUPPORT /* Android API level >= 35 */ +#include + +#if HAVE_TZALLOC +# if NEED_TIMEZONE_NULL_SUPPORT /* Android API level >= 35 */ struct tm * localtime_rz (timezone_t tz, time_t const *t, struct tm *tm) @@ -48,10 +51,19 @@ mktime_z (timezone_t tz, struct tm *tm) else return mktime_z (tz, tm); } +# endif + +void +tzfree (timezone_t tz) +# undef tzfree +{ + int err = errno; + tzfree (tz); + errno = err; +} #else -# include # include # include # include @@ -116,7 +128,7 @@ save_abbr (timezone_t tz, struct tm *tm) { zone_copy = tz->abbrs; - while (strcmp (zone_copy, zone) != 0) + while (!streq (zone_copy, zone)) { if (! (*zone_copy || (zone_copy == tz->abbrs && tz->tz_is_set))) { @@ -202,7 +214,7 @@ set_tz (timezone_t tz) { char *env_tz = getenv_TZ (); if (env_tz - ? tz->tz_is_set && strcmp (tz->abbrs, env_tz) == 0 + ? tz->tz_is_set && streq (tz->abbrs, env_tz) : !tz->tz_is_set) return local_tz; else @@ -212,9 +224,7 @@ set_tz (timezone_t tz) return old_tz; if (! change_env (tz)) { - int saved_errno = errno; tzfree (old_tz); - errno = saved_errno; return NULL; } return old_tz; diff --git a/lib/u64.h b/lib/u64.h index 6ea08969c29..b47d65e5033 100644 --- a/lib/u64.h +++ b/lib/u64.h @@ -1,4 +1,4 @@ -/* uint64_t-like operations that work even on hosts lacking uint64_t +/* Unsigned integers with arithmetic modulo 2**64 Copyright (C) 2006, 2009-2025 Free Software Foundation, Inc. @@ -17,11 +17,15 @@ /* Written by Paul Eggert. */ +#ifndef U64_H +#define U64_H 1 + /* This file uses _GL_INLINE_HEADER_BEGIN, _GL_INLINE. */ #if !_GL_CONFIG_H_INCLUDED #error "Please include config.h first." #endif +#include #include #include @@ -37,7 +41,7 @@ extern "C" { #endif -#ifdef UINT64_MAX +#if defined UINT64_MAX && INT_MAX < UINT64_MAX /* Native implementations are trivial. See below for comments on what these operations do. */ @@ -45,7 +49,9 @@ typedef uint64_t u64; # define u64hilo(hi, lo) ((u64) (((u64) (hi) << 32) + (lo))) # define u64init(hi, lo) u64hilo (hi, lo) # define u64lo(x) ((u64) (x)) +# define u64getlo(x) ((uint32_t) ((x) & UINT32_MAX)) # define u64size(x) u64lo (x) +# define u64not(x) (~(x)) # define u64lt(x, y) ((x) < (y)) # define u64and(x, y) ((x) & (y)) # define u64or(x, y) ((x) | (y)) @@ -94,6 +100,13 @@ u64lo (unsigned int lo) return r; } +/* Return the low 32 bits of the u64 value X. */ +_GL_U64_INLINE unsigned int +u64getlo (u64 x) +{ + return x.lo & _GL_U64_MASK32; +} + /* Return a u64 value representing SIZE, where 0 <= SIZE < 2**64. */ _GL_U64_INLINE u64 u64size (size_t size) @@ -104,6 +117,16 @@ u64size (size_t size) return r; } +/* Return the bitwise NOT of X. */ +_GL_U64_INLINE u64 +u64not (u64 x) +{ + u64 r; + r.hi = ~x.hi; + r.lo = ~x.lo; + return r; +} + /* Return X < Y. */ _GL_U64_INLINE bool u64lt (u64 x, u64 y) @@ -209,3 +232,5 @@ u64rol (u64 x, int n) #endif _GL_INLINE_HEADER_END + +#endif diff --git a/lib/unistd.in.h b/lib/unistd.in.h index 9f057d30cdf..5b5838240aa 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -104,15 +104,12 @@ # include #endif -/* FreeBSD 14.0, NetBSD 10.0, OpenBSD 7.5, Solaris 11.4, and glibc 2.41 - do not define O_CLOEXEC in . */ /* Cygwin 1.7.1 and Android 4.3 declare unlinkat in , not in . */ /* But avoid namespace pollution on glibc systems. */ -#if ! defined O_CLOEXEC \ - || ((@GNULIB_UNLINKAT@ || defined GNULIB_POSIXCHECK) \ - && (defined __CYGWIN__ || defined __ANDROID__) \ - && ! defined __GLIBC__) +#if ((@GNULIB_UNLINKAT@ || defined GNULIB_POSIXCHECK) \ + && (defined __CYGWIN__ || defined __ANDROID__) \ + && ! defined __GLIBC__) # include #endif @@ -120,10 +117,8 @@ /* mingw, MSVC, BeOS, Haiku declare environ in , not in . */ /* Solaris declares getcwd not only in but also in . */ -/* OSF Tru64 Unix cannot see gnulib rpl_strtod when system is - included here. */ /* But avoid namespace pollution on glibc systems. */ -#if !defined __GLIBC__ && !defined __osf__ +#if !defined __GLIBC__ # define __need_system_stdlib_h # include # undef __need_system_stdlib_h @@ -134,10 +129,10 @@ # include #endif -/* AIX and OSF/1 5.1 declare getdomainname in , not in . +/* AIX declares getdomainname in , not in . NonStop Kernel declares gethostname in , not in . */ /* But avoid namespace pollution on glibc systems. */ -#if ((@GNULIB_GETDOMAINNAME@ && (defined _AIX || defined __osf__)) \ +#if ((@GNULIB_GETDOMAINNAME@ && defined _AIX) \ || (@GNULIB_GETHOSTNAME@ && defined __TANDEM)) \ && !defined __GLIBC__ # include @@ -1336,8 +1331,7 @@ _GL_CXXALIAS_RPL (gethostname, int, (char *name, size_t len)); _GL_FUNCDECL_SYS (gethostname, int, (char *name, size_t len), _GL_ARG_NONNULL ((1))); # endif -/* Need to cast, because on Solaris 10 and OSF/1 5.1 systems, the second - parameter is +/* Need to cast, because on Solaris 10 systems, the second parameter is int len. */ _GL_CXXALIAS_SYS_CAST (gethostname, int, (char *name, size_t len)); # endif @@ -2151,9 +2145,9 @@ _GL_FUNCDECL_SYS (sethostname, int, (const char *name, size_t len), _GL_ARG_NONNULL ((1)) _GL_ATTRIBUTE_NODISCARD); # endif -/* Need to cast, because on Solaris 11 2011-10, Mac OS X 10.5, IRIX 6.5 - and FreeBSD 6.4 the second parameter is int. On Solaris 11 - 2011-10, the first parameter is not const. */ +/* Need to cast, because on Solaris 11 2011-10, Mac OS X 10.5, and FreeBSD 6.4 + the second parameter is int. On Solaris 11 2011-10, the first parameter is + not const. */ _GL_CXXALIAS_SYS_CAST (sethostname, int, (const char *name, size_t len)); # endif @@ -2493,6 +2487,18 @@ _GL_CXXALIASWARN (write); _GL_INLINE_HEADER_END + +/* Includes that provide only macros that don't need to be overridden. + (Includes that are needed for type definitions and function declarations + have their place above, before the function overrides.) */ + +/* FreeBSD 14.0, NetBSD 10.0, OpenBSD 7.5, Solaris 11.4, and glibc 2.41 + do not define O_CLOEXEC in . */ +#if ! defined O_CLOEXEC +# include +#endif + + #endif /* _@GUARD_PREFIX@_UNISTD_H */ #endif /* _GL_INCLUDING_UNISTD_H */ #endif /* _@GUARD_PREFIX@_UNISTD_H */ diff --git a/lib/unlocked-io.h b/lib/unlocked-io.h index 69ea6641a3f..8a7719c4876 100644 --- a/lib/unlocked-io.h +++ b/lib/unlocked-io.h @@ -73,6 +73,13 @@ # define fgets_unlocked(x,y,z) fgets (x,y,z) # endif +# if HAVE_DECL_FILENO_UNLOCKED || defined fileno_unlocked +# undef fileno +# define fileno(x) fileno_unlocked (x) +# else +# define fileno_unlocked(x) fileno (x) +# endif + # if HAVE_DECL_FPUTC_UNLOCKED || defined fputc_unlocked # undef fputc # define fputc(x,y) fputc_unlocked (x,y) diff --git a/lib/utimens.c b/lib/utimens.c index 28e4295f025..0387e9f10e9 100644 --- a/lib/utimens.c +++ b/lib/utimens.c @@ -21,6 +21,7 @@ #include +/* Specification. */ #define _GL_UTIMENS_INLINE _GL_EXTERN_INLINE #include "utimens.h" @@ -32,6 +33,7 @@ #include #include +#include "issymlink.h" #include "stat-time.h" #include "timespec.h" @@ -670,9 +672,17 @@ lutimens (char const *file, struct timespec const timespec[2]) # endif /* HAVE_LUTIMES && !HAVE_UTIMENSAT */ /* Out of luck for symlinks, but we still handle regular files. */ - if (!(adjustment_needed || REPLACE_FUNC_STAT_FILE) && lstat (file, &st)) - return -1; - if (!S_ISLNK (st.st_mode)) + bool not_symlink; + if (adjustment_needed || REPLACE_FUNC_STAT_FILE) + not_symlink = !S_ISLNK (st.st_mode); + else + { + int ret = issymlink (file); + if (ret < 0) + return -1; + not_symlink = !ret; + } + if (not_symlink) return fdutimens (-1, file, ts); errno = ENOSYS; return -1; diff --git a/m4/acl.m4 b/m4/acl.m4 index 2dd33497efd..0ab7d34e2d2 100644 --- a/m4/acl.m4 +++ b/m4/acl.m4 @@ -1,5 +1,5 @@ # acl.m4 -# serial 37 +# serial 39 dnl Copyright (C) 2002, 2004-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, @@ -35,10 +35,10 @@ AC_DEFUN_ONCE([gl_FUNC_ACL], gl_saved_LIBS=$LIBS dnl Test for POSIX-draft-like API (GNU/Linux, FreeBSD, NetBSD >= 10, - dnl Mac OS X, IRIX, Tru64, Cygwin >= 2.5). - dnl -lacl is needed on GNU/Linux, -lpacl on OSF/1. + dnl Mac OS X, Cygwin >= 2.5). + dnl -lacl is needed on GNU/Linux. if test $use_acl = 0; then - AC_SEARCH_LIBS([acl_get_file], [acl pacl], + AC_SEARCH_LIBS([acl_get_file], [acl], [if test "$ac_cv_search_acl_get_file" != "none required"; then LIB_ACL=$ac_cv_search_acl_get_file fi diff --git a/m4/assert_h.m4 b/m4/assert_h.m4 index e77524caff9..b02cbd6810c 100644 --- a/m4/assert_h.m4 +++ b/m4/assert_h.m4 @@ -1,5 +1,5 @@ # assert_h.m4 -# serial 5 +# serial 6 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, @@ -56,8 +56,6 @@ AC_DEFUN([gl_ASSERT_H], dnl The seemingly redundant parentheses are necessary for MSVC 14. dnl #undef assert so that programs are not tempted to use it without dnl specifically including assert.h. - dnl #undef __ASSERT_H__ so that on IRIX, when programs later include - dnl , this include actually defines assert. dnl Break the #undef_s apart with a comment so that 'configure' does dnl not comment them out. AH_VERBATIM([zzstatic_assert], @@ -78,9 +76,6 @@ AC_DEFUN([gl_ASSERT_H], && __GNUG__ < 6 && __clang_major__ < 6))) #include #undef/**/assert - #ifdef __sgi - #undef/**/__ASSERT_H__ - #endif /* Solaris 11.4 defines static_assert as a macro with 2 arguments. We need it also to be invocable with a single argument. Haiku 2022 does not define static_assert at all. */ diff --git a/m4/errno_h.m4 b/m4/errno_h.m4 index 420d5bb3e91..623cb7b2360 100644 --- a/m4/errno_h.m4 +++ b/m4/errno_h.m4 @@ -1,5 +1,5 @@ # errno_h.m4 -# serial 18 +# serial 19 dnl Copyright (C) 2004, 2006, 2008-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, @@ -83,59 +83,4 @@ booboo gl_NEXT_HEADERS([errno.h]) GL_GENERATE_ERRNO_H=true fi - gl_REPLACE_ERRNO_VALUE([EMULTIHOP]) - gl_REPLACE_ERRNO_VALUE([ENOLINK]) - gl_REPLACE_ERRNO_VALUE([EOVERFLOW]) -]) - -# Assuming $1 = EOVERFLOW. -# The EOVERFLOW errno value ought to be defined in , according to -# POSIX. But some systems (like OpenBSD 4.0 or AIX 3) don't define it, and -# some systems (like OSF/1) define it when _XOPEN_SOURCE_EXTENDED is defined. -# Check for the value of EOVERFLOW. -# Set the variables EOVERFLOW_HIDDEN and EOVERFLOW_VALUE. -AC_DEFUN([gl_REPLACE_ERRNO_VALUE], -[ - if $GL_GENERATE_ERRNO_H; then - AC_CACHE_CHECK([for ]$1[ value], [gl_cv_header_errno_h_]$1, [ - AC_EGREP_CPP([yes],[ -#include -#ifdef ]$1[ -yes -#endif - ], - [gl_cv_header_errno_h_]$1[=yes], - [gl_cv_header_errno_h_]$1[=no]) - if test $gl_cv_header_errno_h_]$1[ = no; then - AC_EGREP_CPP([yes],[ -#define _XOPEN_SOURCE_EXTENDED 1 -#include -#ifdef ]$1[ -yes -#endif - ], [gl_cv_header_errno_h_]$1[=hidden]) - if test $gl_cv_header_errno_h_]$1[ = hidden; then - dnl The macro exists but is hidden. - dnl Define it to the same value. - AC_COMPUTE_INT([gl_cv_header_errno_h_]$1, $1, [ -#define _XOPEN_SOURCE_EXTENDED 1 -#include -/* The following two lines are a workaround against an autoconf-2.52 bug. */ -#include -#include -]) - fi - fi - ]) - case $gl_cv_header_errno_h_]$1[ in - yes | no) - ]$1[_HIDDEN=0; ]$1[_VALUE= - ;; - *) - ]$1[_HIDDEN=1; ]$1[_VALUE="$gl_cv_header_errno_h_]$1[" - ;; - esac - AC_SUBST($1[_HIDDEN]) - AC_SUBST($1[_VALUE]) - fi ]) diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4 index d4fe6d82a5d..820fbda5ddb 100644 --- a/m4/extern-inline.m4 +++ b/m4/extern-inline.m4 @@ -1,5 +1,5 @@ # extern-inline.m4 -# serial 1 +# serial 2 dnl Copyright 2012-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, @@ -43,9 +43,11 @@ AC_DEFUN([gl_EXTERN_INLINE], functions or macros in standard C headers like . For example, if isdigit is mistakenly implemented via a static inline function, a program containing an extern inline function that calls isdigit - may not work since the C standard prohibits extern inline functions - from calling static functions (ISO C 99 section 6.7.4.(3). - This bug is known to occur on: + may not work since C99 through C23 prohibit extern inline functions + from calling static functions (ISO C 23 section 6.7.5.(2)). + Although a future C standard will likely relax this restriction + , + respect it for now. This bug is known to occur on: OS X 10.8 and earlier; see: https://lists.gnu.org/r/bug-gnulib/2012-12/msg00023.html @@ -112,8 +114,8 @@ AC_DEFUN([gl_EXTERN_INLINE], suppress bogus "no previous prototype for 'FOO'" and "no previous declaration for 'FOO'" diagnostics, when FOO is an inline function in the header; see - and - . */ + and + . */ #if __GNUC__ == 4 && 6 <= __GNUC_MINOR__ # if defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__ # define _GL_INLINE_HEADER_CONST_PRAGMA diff --git a/m4/fcntl_h.m4 b/m4/fcntl_h.m4 index 1c9f9cce021..6d6c8ff4de5 100644 --- a/m4/fcntl_h.m4 +++ b/m4/fcntl_h.m4 @@ -1,5 +1,5 @@ # fcntl_h.m4 -# serial 20 +# serial 21 dnl Copyright (C) 2006-2007, 2009-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, @@ -26,7 +26,7 @@ AC_DEFUN_ONCE([gl_FCNTL_H], dnl corresponding gnulib module is not in use, if it is not common dnl enough to be declared everywhere. gl_WARN_ON_USE_PREPARE([[#include - ]], [fcntl openat]) + ]], [fcntl openat openat2]) ]) # gl_FCNTL_MODULE_INDICATOR([modulename]) @@ -53,6 +53,7 @@ AC_DEFUN([gl_FCNTL_H_REQUIRE_DEFAULTS], gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_NONBLOCKING]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_OPEN]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_OPENAT]) + gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_OPENAT2]) dnl Support Microsoft deprecated alias function names by default. gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MDA_CREAT], [1]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MDA_OPEN], [1]) @@ -66,6 +67,7 @@ AC_DEFUN([gl_FCNTL_H_DEFAULTS], dnl Assume proper GNU behavior unless another module says otherwise. HAVE_FCNTL=1; AC_SUBST([HAVE_FCNTL]) HAVE_OPENAT=1; AC_SUBST([HAVE_OPENAT]) + HAVE_OPENAT2=0; AC_SUBST([HAVE_OPENAT2]) REPLACE_CREAT=0; AC_SUBST([REPLACE_CREAT]) REPLACE_FCNTL=0; AC_SUBST([REPLACE_FCNTL]) REPLACE_OPEN=0; AC_SUBST([REPLACE_OPEN]) diff --git a/m4/free.m4 b/m4/free.m4 index 485d82433ec..bf03a7d1902 100644 --- a/m4/free.m4 +++ b/m4/free.m4 @@ -14,10 +14,10 @@ AC_DEFUN([gl_FUNC_FREE], dnl In the next release of POSIX, free must preserve errno. dnl https://www.austingroupbugs.net/view.php?id=385 - dnl https://sourceware.org/bugzilla/show_bug.cgi?id=17924 + dnl https://sourceware.org/PR17924 dnl So far, we know of three platforms that do this: dnl * glibc >= 2.33, thanks to the fix for this bug: - dnl + dnl dnl * OpenBSD >= 4.5, thanks to this commit: dnl dnl * Solaris, because its malloc() implementation is based on brk(), diff --git a/m4/fseterr.m4 b/m4/fseterr.m4 new file mode 100644 index 00000000000..3a94c28824f --- /dev/null +++ b/m4/fseterr.m4 @@ -0,0 +1,15 @@ +# fseterr.m4 +# serial 2 +dnl Copyright (C) 2012-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, +dnl with or without modifications, as long as this notice is preserved. +dnl This file is offered as-is, without any warranty. + +AC_DEFUN([gl_FUNC_FSETERR], +[ + gl_CHECK_FUNCS_ANDROID([__fseterr], + [[#include + #include + ]]) +]) diff --git a/m4/fsusage.m4 b/m4/fsusage.m4 index bb7b6e4303d..546c42d292b 100644 --- a/m4/fsusage.m4 +++ b/m4/fsusage.m4 @@ -1,5 +1,5 @@ # fsusage.m4 -# serial 35 +# serial 37 dnl Copyright (C) 1997-1998, 2000-2001, 2003-2025 Free Software Foundation, dnl Inc. dnl This file is free software; the Free Software Foundation @@ -48,16 +48,12 @@ AC_DEFUN([gl_FILE_SYSTEM_USAGE], # is what it gets when this test fails. if test $ac_fsusage_space = no; then # glibc/{Hurd,kFreeBSD}, FreeBSD >= 5.0, NetBSD >= 3.0, - # OpenBSD >= 4.4, AIX, HP-UX, IRIX, Solaris, Cygwin, Interix, BeOS. + # OpenBSD >= 4.4, AIX, HP-UX, Solaris, Cygwin, Interix, BeOS. AC_CACHE_CHECK([for statvfs function (SVR4)], [fu_cv_sys_stat_statvfs], [AC_LINK_IFELSE( [AC_LANG_PROGRAM([[ #include -#ifdef __osf__ -"Do not use Tru64's statvfs implementation" -#endif - #include struct statvfs fsd; @@ -79,7 +75,7 @@ int check_f_blocks_size[sizeof fsd.f_blocks * CHAR_BIT <= 32 ? -1 : 1]; if test $fu_cv_sys_stat_statvfs = yes; then ac_fsusage_space=yes # AIX >= 5.2 has statvfs64 that has a wider f_blocks field than statvfs. - # glibc, HP-UX, IRIX, Solaris have statvfs64 as well, but on these systems + # glibc, HP-UX, Solaris have statvfs64 as well, but on these systems # statvfs with large-file support is already equivalent to statvfs64. AC_CACHE_CHECK([whether to use statvfs64], [fu_cv_sys_stat_statvfs64], @@ -140,38 +136,10 @@ int check_f_blocks_size[sizeof fsd.f_blocks * CHAR_BIT <= 32 ? -1 : 1]; (glibc/Linux > 2.6)]) fi - if test $ac_fsusage_space = no; then - # DEC Alpha running OSF/1 - AC_CACHE_CHECK([for 3-argument statfs function (DEC OSF/1)], - [fu_cv_sys_stat_statfs3_osf1], - [AC_RUN_IFELSE([AC_LANG_SOURCE([[ -#include -#include -#include - int - main () - { - struct statfs fsd; - fsd.f_fsize = 0; - return statfs (".", &fsd, sizeof (struct statfs)) != 0; - }]])], - [fu_cv_sys_stat_statfs3_osf1=yes], - [fu_cv_sys_stat_statfs3_osf1=no], - [fu_cv_sys_stat_statfs3_osf1=no]) - ]) - if test $fu_cv_sys_stat_statfs3_osf1 = yes; then - ac_fsusage_space=yes - AC_DEFINE([STAT_STATFS3_OSF1], [1], - [Define if statfs takes 3 args. (DEC Alpha running OSF/1)]) - fi - fi - if test $ac_fsusage_space = no; then # glibc/Linux, Mac OS X, FreeBSD < 5.0, NetBSD < 3.0, OpenBSD < 4.4. # (glibc/{Hurd,kFreeBSD}, FreeBSD >= 5.0, NetBSD >= 3.0, - # OpenBSD >= 4.4, AIX, HP-UX, OSF/1, Cygwin already handled above.) - # (On IRIX you need to include , not only and - # .) + # OpenBSD >= 4.4, AIX, HP-UX, Cygwin already handled above.) # (On Solaris, statfs has 4 arguments.) AC_CACHE_CHECK([for two-argument statfs with statfs.f_bsize member (AIX, 4.3BSD)], [fu_cv_sys_stat_statfs2_bsize], @@ -225,13 +193,12 @@ int check_f_blocks_size[sizeof fsd.f_blocks * CHAR_BIT <= 32 ? -1 : 1]; if test $fu_cv_sys_stat_statfs4 = yes; then ac_fsusage_space=yes AC_DEFINE([STAT_STATFS4], [1], - [Define if statfs takes 4 args. (SVR3, old Irix)]) + [Define if statfs takes 4 args. (SVR3)]) fi fi if test $ac_fsusage_space = no; then # 4.4BSD and older NetBSD - # (OSF/1 already handled above.) # (On AIX, you need to include , not only .) # (On Solaris, statfs has 4 arguments and 'struct statfs' is not declared in # .) diff --git a/m4/getdelim.m4 b/m4/getdelim.m4 index 63d8830649a..d1217ab8d95 100644 --- a/m4/getdelim.m4 +++ b/m4/getdelim.m4 @@ -1,5 +1,5 @@ # getdelim.m4 -# serial 19 +# serial 21 dnl Copyright (C) 2005-2007, 2009-2025 Free Software Foundation, Inc. dnl @@ -37,6 +37,7 @@ AC_DEFUN([gl_FUNC_GETDELIM], gl_cv_func_working_getdelim=no ;; *) echo fooNbarN | tr -d '\012' | tr N '\012' > conftest.data + touch conftest.empty AC_RUN_IFELSE([AC_LANG_SOURCE([[ # include # include @@ -44,6 +45,7 @@ AC_DEFUN([gl_FUNC_GETDELIM], int main () { FILE *in = fopen ("./conftest.data", "r"); + int result = 0; if (!in) return 1; { @@ -53,7 +55,7 @@ AC_DEFUN([gl_FUNC_GETDELIM], size_t siz = 0; int len = getdelim (&line, &siz, '\n', in); if (!(len == 4 && line && strcmp (line, "foo\n") == 0)) - { free (line); fclose (in); return 2; } + result |= 2; free (line); } { @@ -62,35 +64,40 @@ AC_DEFUN([gl_FUNC_GETDELIM], char *line = NULL; size_t siz = (size_t)(~0) / 4; if (getdelim (&line, &siz, '\n', in) == -1) - { fclose (in); return 3; } + result |= 4; free (line); } fclose (in); - return 0; + { + /* Test that reading EOF as the first character sets the first byte + in the buffer to NUL. This fails on glibc 2.42 and earlier. */ + in = fopen ("./conftest.empty", "r"); + if (!in) + return 1; + char *line = malloc (1); + line[0] = 'A'; + size_t siz = 1; + if (getdelim (&line, &siz, '\n', in) != -1 || line[0] != '\0') + result |= 8; + free (line); + } + fclose (in); + return result; } ]])], [gl_cv_func_working_getdelim=yes], [gl_cv_func_working_getdelim=no], - [dnl We're cross compiling. - dnl Guess it works on glibc2 systems and musl systems. - AC_EGREP_CPP([Lucky GNU user], - [ -#include -#ifdef __GNU_LIBRARY__ - #if (__GLIBC__ >= 2) && !defined __UCLIBC__ - Lucky GNU user - #endif -#endif - ], - [gl_cv_func_working_getdelim="guessing yes"], - [case "$host_os" in - *-musl* | midipix*) gl_cv_func_working_getdelim="guessing yes" ;; - *) gl_cv_func_working_getdelim="$gl_cross_guess_normal" ;; - esac - ]) + [case "$host_os" in + # Guess yes on musl. + *-musl* | midipix*) gl_cv_func_working_getdelim="guessing yes" ;; + # Guess no on glibc. + *-gnu* | gnu*) gl_cv_func_working_getdelim="guessing no" ;; + *) gl_cv_func_working_getdelim="$gl_cross_guess_normal" ;; + esac ]) ;; esac + rm -f conftest.data conftest.empty ]) case "$gl_cv_func_working_getdelim" in *yes) ;; diff --git a/m4/getline.m4 b/m4/getline.m4 index b97b8011248..e07d6533ddc 100644 --- a/m4/getline.m4 +++ b/m4/getline.m4 @@ -1,5 +1,5 @@ # getline.m4 -# serial 33 +# serial 35 dnl Copyright (C) 1998-2003, 2005-2007, 2009-2025 Free Software Foundation, dnl Inc. @@ -31,6 +31,7 @@ AC_DEFUN([gl_FUNC_GETLINE], AC_CACHE_CHECK([for working getline function], [am_cv_func_working_getline], [echo fooNbarN | tr -d '\012' | tr N '\012' > conftest.data + touch conftest.empty AC_RUN_IFELSE([AC_LANG_SOURCE([[ # include # include @@ -38,6 +39,7 @@ AC_DEFUN([gl_FUNC_GETLINE], int main () { FILE *in = fopen ("./conftest.data", "r"); + int result = 0; if (!in) return 1; { @@ -47,7 +49,7 @@ AC_DEFUN([gl_FUNC_GETLINE], size_t siz = 0; int len = getline (&line, &siz, in); if (!(len == 4 && line && strcmp (line, "foo\n") == 0)) - { free (line); fclose (in); return 2; } + result |= 2; free (line); } { @@ -56,33 +58,38 @@ AC_DEFUN([gl_FUNC_GETLINE], char *line = NULL; size_t siz = (size_t)(~0) / 4; if (getline (&line, &siz, in) == -1) - { fclose (in); return 3; } + result |= 4; free (line); } fclose (in); - return 0; + { + /* Test that reading EOF as the first character sets the first byte + in the buffer to NUL. This fails on glibc 2.42 and earlier. */ + in = fopen ("./conftest.empty", "r"); + if (!in) + return 1; + char *line = malloc (1); + line[0] = 'A'; + size_t siz = 1; + if (getline (&line, &siz, in) != -1 || line[0] != '\0') + result |= 8; + free (line); + } + fclose (in); + return result; } ]])], [am_cv_func_working_getline=yes], [am_cv_func_working_getline=no], - [dnl We're cross compiling. - dnl Guess it works on glibc2 systems and musl systems. - AC_EGREP_CPP([Lucky GNU user], - [ -#include -#ifdef __GNU_LIBRARY__ - #if (__GLIBC__ >= 2) && !defined __UCLIBC__ - Lucky GNU user - #endif -#endif - ], - [am_cv_func_working_getline="guessing yes"], - [case "$host_os" in - *-musl* | midipix*) am_cv_func_working_getline="guessing yes" ;; - *) am_cv_func_working_getline="$gl_cross_guess_normal" ;; - esac - ]) + [case "$host_os" in + # Guess yes on musl. + *-musl* | midipix*) am_cv_func_working_getline="guessing yes" ;; + # Guess no on glibc. + *-gnu* | gnu*) am_cv_func_working_getline="guessing no" ;; + *) am_cv_func_working_getline="$gl_cross_guess_normal" ;; + esac ]) + rm -f conftest.data conftest.empty ]) else am_cv_func_working_getline=no diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4 index 8ab613db820..0d80b64acd5 100644 --- a/m4/getloadavg.m4 +++ b/m4/getloadavg.m4 @@ -1,5 +1,5 @@ # getloadavg.m4 -# serial 13 +# serial 14 dnl Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2025 Free dnl Software Foundation, Inc. dnl This file is free software; the Free Software Foundation @@ -124,8 +124,7 @@ if test $gl_func_getloadavg_done = no; then fi # We cannot check for , because Solaris 2 does not use dwarf (it -# uses stabs), but it is still SVR4. We cannot check for because -# Irix 4.0.5F has the header but not the library. +# uses stabs), but it is still SVR4. if test $gl_func_getloadavg_done = no && test "$ac_cv_lib_elf_elf_begin" = yes \ && test "$ac_cv_lib_kvm_kvm_open" = yes; then gl_func_getloadavg_done=yes diff --git a/m4/getopt.m4 b/m4/getopt.m4 index cb344c15d1f..f219ed522ca 100644 --- a/m4/getopt.m4 +++ b/m4/getopt.m4 @@ -1,5 +1,5 @@ # getopt.m4 -# serial 50 +# serial 52 dnl Copyright (C) 2002-2006, 2008-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, @@ -88,8 +88,8 @@ AC_DEFUN([gl_GETOPT_CHECK_HEADERS], dnl Merging these three different test programs into a single one dnl would require a reset mechanism. On BSD systems, it can be done dnl through 'optreset'; on some others (glibc), it can be done by - dnl setting 'optind' to 0; on others again (HP-UX, IRIX, OSF/1, - dnl Solaris 9, musl libc), there is no such mechanism. + dnl setting 'optind' to 0; on others again (HP-UX, Solaris 9, + dnl musl libc), there is no such mechanism. if test $cross_compiling = no; then dnl Sanity check. Succeeds everywhere (except on MSVC, dnl which lacks and getopt() entirely). @@ -238,8 +238,7 @@ dnl is ambiguous with environment values that contain newlines. nocrash_init(); /* This code succeeds on glibc 2.8, OpenBSD 4.0, Cygwin, mingw, - and fails on Mac OS X 10.5, AIX 5.2, HP-UX 11, IRIX 6.5, - OSF/1 5.1, Solaris 10. */ + and fails on Mac OS X 10.5, AIX 5.2, HP-UX 11, Solaris 10. */ { static char conftest[] = "conftest"; static char plus[] = "-+"; @@ -250,7 +249,7 @@ dnl is ambiguous with environment values that contain newlines. } /* This code succeeds on glibc 2.8, mingw, and fails on Mac OS X 10.5, OpenBSD 4.0, AIX 5.2, HP-UX 11, - IRIX 6.5, OSF/1 5.1, Solaris 10, Cygwin 1.5.x. */ + Solaris 10, Cygwin 1.5.x. */ { static char program[] = "program"; static char p[] = "-p"; diff --git a/m4/gettext_h.m4 b/m4/gettext_h.m4 new file mode 100644 index 00000000000..b4b1995c762 --- /dev/null +++ b/m4/gettext_h.m4 @@ -0,0 +1,21 @@ +# gettext_h.m4 +# serial 1 +dnl Copyright (C) 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, +dnl with or without modifications, as long as this notice is preserved. +dnl This file is offered as-is, without any warranty. + +AC_DEFUN_ONCE([gl_GETTEXT_H], +[ + AC_SUBST([LIBINTL]) + AC_SUBST([LTLIBINTL]) + AH_BOTTOM([ +/* The text domainname for Gnulib messages. Ordinarily this is "gnulib", + but packages that do their own translations of Gnulib can use something + different by defining GNULIB_TEXT_DOMAIN in their config.h file. */ +#ifndef GNULIB_TEXT_DOMAIN +# define GNULIB_TEXT_DOMAIN/**/"gnulib" +#endif +]) +]) diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 034dae69e68..134bfba21d0 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -168,7 +168,7 @@ AC_DEFUN([gl_COMMON_BODY], [ ====================================================================== This gives a syntax error - in C mode with gcc - , and + , and - in C++ mode with clang++ version < 16, and - in C++ mode, inside extern "C" {}, still in newer clang++ versions . @@ -451,7 +451,7 @@ AC_DEFUN([gl_COMMON_BODY], [ yet. */ #ifndef _GL_ATTRIBUTE_DEALLOC_FREE # if defined __cplusplus && defined __GNUC__ && !defined __clang__ -/* Work around GCC bug */ +/* Work around GCC bug */ # define _GL_ATTRIBUTE_DEALLOC_FREE \ _GL_ATTRIBUTE_DEALLOC ((void (*) (void *)) free, 1) # else diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 107b1493617..b80c5c84a0b 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -105,6 +105,7 @@ AC_DEFUN([gl_EARLY], # Code from module fpieee: AC_REQUIRE([gl_FP_IEEE]) # Code from module free-posix: + # Code from module fseterr: # Code from module fstatat: # Code from module fsusage: # Code from module fsync: @@ -131,6 +132,8 @@ AC_DEFUN([gl_EARLY], # Code from module include_next: # Code from module intprops: # Code from module inttypes-h-incomplete: + # Code from module issymlink: + # Code from module issymlinkat: # Code from module largefile: AC_REQUIRE([AC_SYS_LARGEFILE]) # Code from module lchmod: @@ -192,6 +195,7 @@ AC_DEFUN([gl_EARLY], # Code from module stdlib-h: # Code from module stpcpy: # Code from module string-h: + # Code from module stringeq: # Code from module strnlen: # Code from module strtoimax: # Code from module strtoll: @@ -341,6 +345,8 @@ AC_DEFUN([gl_INIT], gl_PREREQ_FREE ]) gl_STDLIB_MODULE_INDICATOR([free-posix]) + gl_FUNC_FSETERR + gl_CONDITIONAL([GL_COND_OBJ_FSETERR], [test $ac_cv_func___fseterr = no]) gl_FUNC_FSTATAT gl_CONDITIONAL([GL_COND_OBJ_FSTATAT], [test $HAVE_FSTATAT = 0 || test $REPLACE_FSTATAT = 1]) @@ -562,6 +568,18 @@ AC_DEFUN([gl_INIT], gl_STDIO_H gl_STDIO_H_REQUIRE_DEFAULTS AC_PROG_MKDIR_P + USES_MSVCRT=0 + case "$host_os" in + mingw* | windows*) + AC_EGREP_CPP([Special], [ + #ifndef _UCRT + Special + #endif + ], + [USES_MSVCRT=1]) + ;; + esac + gl_CONDITIONAL([GL_COND_OBJ_STDIO_CONSOLESAFE], [test $USES_MSVCRT = 1]) gl_CONDITIONAL([GL_COND_OBJ_STDIO_READ], [test $REPLACE_STDIO_READ_FUNCS = 1]) gl_CONDITIONAL([GL_COND_OBJ_STDIO_WRITE], [test $REPLACE_STDIO_WRITE_FUNCS = 1]) dnl No need to create extra modules for these functions. Everyone who uses @@ -600,6 +618,9 @@ AC_DEFUN([gl_INIT], gl_STRING_H gl_STRING_H_REQUIRE_DEFAULTS AC_PROG_MKDIR_P + gl_FUNC_STREQ + gl_FUNC_MEMEQ + gl_STRING_MODULE_INDICATOR([stringeq]) gl_FUNC_STRNLEN gl_CONDITIONAL([GL_COND_OBJ_STRNLEN], [test $HAVE_DECL_STRNLEN = 0 || test $REPLACE_STRNLEN = 1]) @@ -646,8 +667,6 @@ AC_DEFUN([gl_INIT], ]) gl_TIME_MODULE_INDICATOR([time_r]) gl_TIME_RZ - gl_CONDITIONAL([GL_COND_OBJ_TIME_RZ], - [test $HAVE_TZALLOC = 0 || test $REPLACE_LOCALTIME_RZ = 1 || test $REPLACE_MKTIME_Z = 1]) gl_TIME_MODULE_INDICATOR([time_rz]) gl_FUNC_TIMEGM gl_CONDITIONAL([GL_COND_OBJ_TIMEGM], @@ -690,6 +709,8 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_fd38c7e463b54744b77b98aeafb4fa7c=false gl_gnulib_enabled_8444034ea779b88768865bb60b4fb8c9=false gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false + gl_gnulib_enabled_issymlink=false + gl_gnulib_enabled_issymlinkat=false gl_gnulib_enabled_lchmod=false gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31=false gl_gnulib_enabled_open=false @@ -799,8 +820,7 @@ AC_DEFUN([gl_INIT], func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 () { if $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then :; else - AC_SUBST([LIBINTL]) - AC_SUBST([LTLIBINTL]) + gl_GETTEXT_H gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true fi } @@ -833,6 +853,20 @@ AC_DEFUN([gl_INIT], fi fi } + func_gl_gnulib_m4code_issymlink () + { + if $gl_gnulib_enabled_issymlink; then :; else + gl_MODULE_INDICATOR([issymlink]) + gl_gnulib_enabled_issymlink=true + fi + } + func_gl_gnulib_m4code_issymlinkat () + { + if $gl_gnulib_enabled_issymlinkat; then :; else + gl_MODULE_INDICATOR([issymlinkat]) + gl_gnulib_enabled_issymlinkat=true + fi + } func_gl_gnulib_m4code_lchmod () { if $gl_gnulib_enabled_lchmod; then :; else @@ -843,6 +877,12 @@ AC_DEFUN([gl_INIT], ]) gl_SYS_STAT_MODULE_INDICATOR([lchmod]) gl_gnulib_enabled_lchmod=true + if test $HAVE_LCHMOD = 0; then + func_gl_gnulib_m4code_issymlink + fi + if test $HAVE_LCHMOD = 0; then + func_gl_gnulib_m4code_issymlinkat + fi fi } func_gl_gnulib_m4code_5264294aa0a5557541b53c8c741f7f31 () @@ -913,6 +953,7 @@ AC_DEFUN([gl_INIT], if $gl_gnulib_enabled_utimens; then :; else gl_UTIMENS gl_gnulib_enabled_utimens=true + func_gl_gnulib_m4code_issymlink fi } func_gl_gnulib_m4code_verify () @@ -942,6 +983,9 @@ AC_DEFUN([gl_INIT], if test $HAVE_FCHMODAT = 0; then func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b fi + if test $REPLACE_FCHMODAT = 1; then + func_gl_gnulib_m4code_issymlinkat + fi if test $HAVE_FCHMODAT = 0; then func_gl_gnulib_m4code_lchmod fi @@ -987,6 +1031,9 @@ AC_DEFUN([gl_INIT], if test $HAVE_READLINKAT = 0 || test $REPLACE_READLINKAT = 1; then func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7 fi + if test $ac_use_included_regex = yes; then + func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 + fi if test $ac_use_included_regex = yes; then func_gl_gnulib_m4code_fd38c7e463b54744b77b98aeafb4fa7c fi @@ -1022,6 +1069,8 @@ AC_DEFUN([gl_INIT], AM_CONDITIONAL([gl_GNULIB_ENABLED_fd38c7e463b54744b77b98aeafb4fa7c], [$gl_gnulib_enabled_fd38c7e463b54744b77b98aeafb4fa7c]) 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_issymlink], [$gl_gnulib_enabled_issymlink]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_issymlinkat], [$gl_gnulib_enabled_issymlinkat]) AM_CONDITIONAL([gl_GNULIB_ENABLED_lchmod], [$gl_gnulib_enabled_lchmod]) AM_CONDITIONAL([gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31], [$gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31]) AM_CONDITIONAL([gl_GNULIB_ENABLED_open], [$gl_gnulib_enabled_open]) @@ -1291,6 +1340,8 @@ AC_DEFUN([gl_FILE_LIST], [ lib/fpending.c lib/fpending.h lib/free.c + lib/fseterr.c + lib/fseterr.h lib/fstatat.c lib/fsusage.c lib/fsusage.h @@ -1325,6 +1376,9 @@ AC_DEFUN([gl_FILE_LIST], [ lib/intprops-internal.h lib/intprops.h lib/inttypes.in.h + lib/issymlink.c + lib/issymlink.h + lib/issymlinkat.c lib/lchmod.c lib/libc-config.h lib/limits.in.h @@ -1404,6 +1458,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/stdckdint.in.h lib/stddef.in.h lib/stdint.in.h + lib/stdio-consolesafe.c lib/stdio-impl.h lib/stdio-read.c lib/stdio-write.c @@ -1414,6 +1469,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/str-two-way.h lib/strftime.c lib/strftime.h + lib/string.c lib/string.in.h lib/strnlen.c lib/strtoimax.c @@ -1485,6 +1541,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/fpending.m4 m4/fpieee.m4 m4/free.m4 + m4/fseterr.m4 m4/fstatat.m4 m4/fsusage.m4 m4/fsync.m4 @@ -1496,6 +1553,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/getloadavg.m4 m4/getopt.m4 m4/getrandom.m4 + m4/gettext_h.m4 m4/gettime.m4 m4/gettimeofday.m4 m4/gl-openssl.m4 @@ -1565,6 +1623,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/stdlib_h.m4 m4/stpcpy.m4 m4/string_h.m4 + m4/stringeq.m4 m4/strnlen.m4 m4/strtoimax.m4 m4/strtoll.m4 diff --git a/m4/largefile.m4 b/m4/largefile.m4 index b24f657dec4..6aa07078297 100644 --- a/m4/largefile.m4 +++ b/m4/largefile.m4 @@ -1,5 +1,5 @@ # largefile.m4 -# serial 2 +# serial 4 dnl Copyright 1992-1996, 1998-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, @@ -355,8 +355,7 @@ AC_DEFUN([gl_LARGEFILE], *) dnl Nothing to do on gnulib's side. dnl A 64-bit off_t is - dnl - already the default on Mac OS X, FreeBSD, NetBSD, OpenBSD, IRIX, - dnl OSF/1, Cygwin, + dnl - already the default on Mac OS X, FreeBSD, NetBSD, OpenBSD, Cygwin, dnl - enabled by _FILE_OFFSET_BITS=64 (ensured by AC_SYS_LARGEFILE) on dnl glibc, HP-UX, Solaris, dnl - enabled by _LARGE_FILES=1 (ensured by AC_SYS_LARGEFILE) on AIX, diff --git a/m4/lchmod.m4 b/m4/lchmod.m4 index fd768343472..601d1d3da4f 100644 --- a/m4/lchmod.m4 +++ b/m4/lchmod.m4 @@ -1,5 +1,5 @@ # lchmod.m4 -# serial 10 +# serial 11 dnl Copyright (C) 2005-2006, 2008-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, @@ -16,7 +16,7 @@ AC_DEFUN([gl_FUNC_LCHMOD], dnl Persuade glibc to declare lchmod(). AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_FUNCS_ONCE([lchmod]) + gl_CHECK_FUNCS_ANDROID([lchmod], [[#include ]]) if test "$ac_cv_func_lchmod" = no; then HAVE_LCHMOD=0 fi diff --git a/m4/malloc.m4 b/m4/malloc.m4 index cb607b61732..688594fe661 100644 --- a/m4/malloc.m4 +++ b/m4/malloc.m4 @@ -1,5 +1,5 @@ # malloc.m4 -# serial 43 +# serial 44 dnl Copyright (C) 2007, 2009-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, @@ -186,9 +186,7 @@ AC_DEFUN([gl_CHECK_MALLOC_POSIX], [gl_cv_func_malloc_posix="guessing yes"], [gl_cv_func_malloc_posix="guessing no"]) ;; - irix* | solaris*) - dnl On IRIX 6.5, the three functions return NULL with errno unset - dnl when the argument is larger than PTRDIFF_MAX. + solaris*) dnl On Solaris 11.3, the three functions return NULL with errno set dnl to EAGAIN, not ENOMEM, when the argument is larger than dnl PTRDIFF_MAX. diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index eebba901806..bb5b4e10cd9 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -198,7 +198,7 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)], fi # This warning have too many false alarms in GCC 11.2.1. - # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=101713 + # https://gcc.gnu.org/PR101713 AS_VAR_APPEND([$1], [' -Wno-analyzer-malloc-leak']) AC_LANG_POP([C]) diff --git a/m4/memmem.m4 b/m4/memmem.m4 index ce5b85990e4..e940f8273f0 100644 --- a/m4/memmem.m4 +++ b/m4/memmem.m4 @@ -23,7 +23,7 @@ AC_DEFUN([gl_FUNC_MEMMEM_SIMPLE], if test $ac_cv_have_decl_memmem = no; then HAVE_DECL_MEMMEM=0 else - dnl Detect https://sourceware.org/bugzilla/show_bug.cgi?id=12092. + dnl Detect https://sourceware.org/PR12092. dnl Also check that we handle empty needles correctly. AC_CACHE_CHECK([whether memmem works], [gl_cv_func_memmem_works_always], diff --git a/m4/mktime.m4 b/m4/mktime.m4 index eca6c4d8924..6d7243e3306 100644 --- a/m4/mktime.m4 +++ b/m4/mktime.m4 @@ -1,5 +1,5 @@ # mktime.m4 -# serial 42 +# serial 43 dnl Copyright (C) 2002-2003, 2005-2007, 2009-2025 Free Software Foundation, dnl Inc. dnl This file is free software; the Free Software Foundation @@ -112,22 +112,6 @@ mktime_test (time_t now) && mktime_test1 ((time_t) (time_t_min + now))); } -static int -irix_6_4_bug () -{ - /* Based on code from Ariel Faigon. */ - struct tm tm; - tm.tm_year = 96; - tm.tm_mon = 3; - tm.tm_mday = 0; - tm.tm_hour = 0; - tm.tm_min = 0; - tm.tm_sec = 0; - tm.tm_isdst = -1; - mktime (&tm); - return tm.tm_mon == 2 && tm.tm_mday == 31; -} - static int bigtime_test (int j) { @@ -255,12 +239,10 @@ main () if ((result & 8) == 0 && ! bigtime_test (INT_MAX)) result |= 8; } - if (! irix_6_4_bug ()) - result |= 16; if (! spring_forward_gap ()) - result |= 32; + result |= 16; if (! year_2050_test () || ! indiana_test ()) - result |= 64; + result |= 32; return result; }]])], [gl_cv_func_working_mktime=yes], diff --git a/m4/nproc.m4 b/m4/nproc.m4 index 48c239be064..9225779585a 100644 --- a/m4/nproc.m4 +++ b/m4/nproc.m4 @@ -1,5 +1,5 @@ # nproc.m4 -# serial 6 +# serial 7 dnl Copyright (C) 2009-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, @@ -17,7 +17,7 @@ AC_DEFUN([gl_PREREQ_NPROC], dnl Persuade glibc to declare CPU_SETSIZE, CPU_ISSET etc. AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_HEADERS([sys/pstat.h sys/sysmp.h sys/param.h],,, + AC_CHECK_HEADERS([mntent.h sys/pstat.h sys/param.h],,, [AC_INCLUDES_DEFAULT]) dnl requires on OpenBSD 4.0. AC_CHECK_HEADERS([sys/sysctl.h],,, @@ -27,7 +27,7 @@ AC_DEFUN([gl_PREREQ_NPROC], #endif ]) - AC_CHECK_FUNCS([sched_getaffinity_np pstat_getdynamic sysmp sysctl]) + AC_CHECK_FUNCS([sched_getaffinity_np pstat_getdynamic sysctl]) gl_CHECK_FUNCS_ANDROID([sched_getaffinity], [[#include ]]) dnl Test whether sched_getaffinity has the expected declaration. diff --git a/m4/pthread_sigmask.m4 b/m4/pthread_sigmask.m4 index a9da33c4c38..77991d4f334 100644 --- a/m4/pthread_sigmask.m4 +++ b/m4/pthread_sigmask.m4 @@ -1,5 +1,5 @@ # pthread_sigmask.m4 -# serial 23 +# serial 24 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, @@ -97,7 +97,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK], HAVE_PTHREAD_SIGMASK=0 dnl Define the symbol rpl_pthread_sigmask, not pthread_sigmask, dnl so as to not accidentally override the system's pthread_sigmask - dnl symbol from libpthread. This is necessary on IRIX 6.5. + dnl symbol from libpthread. REPLACE_PTHREAD_SIGMASK=1 fi ]) @@ -199,76 +199,6 @@ int main () [Define to 1 if pthread_sigmask(), when it fails, returns -1 and sets errno.]) ;; esac - - dnl On IRIX 6.5, in a single-threaded program, pending signals are not - dnl immediately delivered when they are unblocked through pthread_sigmask, - dnl only a little while later. - AC_CACHE_CHECK([whether pthread_sigmask unblocks signals correctly], - [gl_cv_func_pthread_sigmask_unblock_works], - [ - case "$host_os" in - irix*) - gl_cv_func_pthread_sigmask_unblock_works="guessing no";; - *) - gl_cv_func_pthread_sigmask_unblock_works="guessing yes";; - esac - m4_ifdef([gl_][THREADLIB], - [dnl Link against $LIBMULTITHREAD, not only $PTHREAD_SIGMASK_LIB. - dnl Otherwise we get a false positive on those platforms where - dnl $gl_cv_func_pthread_sigmask_in_libc_works is "no". - gl_saved_LIBS=$LIBS - LIBS="$LIBS $LIBMULTITHREAD"]) - AC_RUN_IFELSE( - [AC_LANG_SOURCE([[ -#include -#include -#include -#include -#include -#include -]GL_MDA_DEFINES[ -static volatile int sigint_occurred; -static void -sigint_handler (int sig) -{ - sigint_occurred++; -} -int main () -{ - sigset_t set; - pid_t pid = getpid (); - char command[80]; - if (LONG_MAX < pid) - return 6; - signal (SIGINT, sigint_handler); - sigemptyset (&set); - sigaddset (&set, SIGINT); - if (!(pthread_sigmask (SIG_BLOCK, &set, NULL) == 0)) - return 1; - sprintf (command, "sh -c 'sleep 1; kill -INT %ld' &", (long) pid); - if (!(system (command) == 0)) - return 2; - sleep (2); - if (!(sigint_occurred == 0)) - return 3; - if (!(pthread_sigmask (SIG_UNBLOCK, &set, NULL) == 0)) - return 4; - if (!(sigint_occurred == 1)) /* This fails on IRIX. */ - return 5; - return 0; -}]])], - [:], - [gl_cv_func_pthread_sigmask_unblock_works=no], - [:]) - m4_ifdef([gl_][THREADLIB], [LIBS=$gl_saved_LIBS]) - ]) - case "$gl_cv_func_pthread_sigmask_unblock_works" in - *no) - REPLACE_PTHREAD_SIGMASK=1 - AC_DEFINE([PTHREAD_SIGMASK_UNBLOCK_BUG], [1], - [Define to 1 if pthread_sigmask() unblocks signals incorrectly.]) - ;; - esac fi ]) diff --git a/m4/readutmp.m4 b/m4/readutmp.m4 index 36c95be3373..418c398b249 100644 --- a/m4/readutmp.m4 +++ b/m4/readutmp.m4 @@ -1,5 +1,5 @@ # readutmp.m4 -# serial 31 +# serial 32 dnl Copyright (C) 2002-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, @@ -96,11 +96,9 @@ AC_INCLUDES_DEFAULT AC_CHECK_MEMBERS([struct utmpx.ut_exit],,,[$utmp_includes]) AC_CHECK_MEMBERS([struct utmp.ut_exit],,,[$utmp_includes]) - AC_CHECK_MEMBERS([struct utmpx.ut_exit.ut_exit],,,[$utmp_includes]) AC_CHECK_MEMBERS([struct utmpx.ut_exit.e_exit],,,[$utmp_includes]) AC_CHECK_MEMBERS([struct utmp.ut_exit.e_exit],,,[$utmp_includes]) - AC_CHECK_MEMBERS([struct utmpx.ut_exit.ut_termination],,,[$utmp_includes]) AC_CHECK_MEMBERS([struct utmpx.ut_exit.e_termination],,,[$utmp_includes]) AC_CHECK_MEMBERS([struct utmp.ut_exit.e_termination],,,[$utmp_includes]) fi diff --git a/m4/sig2str.m4 b/m4/sig2str.m4 index d49e363f3ae..4f713724bb6 100644 --- a/m4/sig2str.m4 +++ b/m4/sig2str.m4 @@ -1,5 +1,5 @@ # sig2str.m4 -# serial 8 +# serial 9 dnl Copyright (C) 2002, 2005-2006, 2009-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, @@ -9,7 +9,8 @@ dnl This file is offered as-is, without any warranty. AC_DEFUN([gl_FUNC_SIG2STR], [ AC_REQUIRE([gl_SIGNAL_H_DEFAULTS]) - AC_CHECK_FUNCS([sig2str str2sig]) + gl_CHECK_FUNCS_ANDROID([sig2str], [[#include ]]) + gl_CHECK_FUNCS_ANDROID([str2sig], [[#include ]]) if test $ac_cv_func_sig2str = no; then HAVE_SIG2STR=0 fi diff --git a/m4/socklen.m4 b/m4/socklen.m4 index a8ac25b1c35..a4d49bfdc06 100644 --- a/m4/socklen.m4 +++ b/m4/socklen.m4 @@ -1,5 +1,5 @@ # socklen.m4 -# serial 11 +# serial 13 dnl Copyright (C) 2005-2007, 2009-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, @@ -11,7 +11,7 @@ dnl From Albert Chin, Windows fixes from Simon Josefsson. dnl Check for socklen_t: historically on BSD it is an int, and in dnl POSIX 1g it is a type of its own, but some platforms use different dnl types for the argument to getsockopt, getpeername, etc.: -dnl HP-UX 10.20, IRIX 6.5, OSF/1 4.0, Interix 3.5, BeOS. +dnl HP-UX 10.20, Interix 3.5, BeOS. dnl So we have to test to find something that will work. AC_DEFUN([gl_TYPE_SOCKLEN_T], diff --git a/m4/stdalign.m4 b/m4/stdalign.m4 index 885feafdd8b..d22360e1075 100644 --- a/m4/stdalign.m4 +++ b/m4/stdalign.m4 @@ -30,7 +30,7 @@ AC_DEFUN([gl_ALIGNASOF], /* Test that alignof yields a result consistent with offsetof. This catches GCC bug 52023 - . */ + . */ #ifdef __cplusplus template struct alignof_helper { char a; t b; }; # define ao(type) offsetof (alignof_helper, b) @@ -103,7 +103,7 @@ AC_DEFUN([gl_ALIGNASOF], want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. */ /* GCC releases before GCC 4.9 had a bug in _Alignof. See GCC bug 52023 - . + . 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 \ diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4 index 127ec05b60d..d52d549489f 100644 --- a/m4/stddef_h.m4 +++ b/m4/stddef_h.m4 @@ -85,7 +85,7 @@ AC_DEFUN_ONCE([gl_STDDEF_H], dnl Provide gl_unreachable() unconditionally. GL_GENERATE_STDDEF_H=true - dnl https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114869 + dnl https://gcc.gnu.org/PR114869 AC_CACHE_CHECK([whether nullptr_t needs ], [gl_cv_nullptr_t_needs_stddef], [AC_COMPILE_IFELSE([AC_LANG_DEFINES_PROVIDED[nullptr_t x;]], @@ -96,7 +96,7 @@ AC_DEFUN_ONCE([gl_STDDEF_H], GL_GENERATE_STDDEF_H=true fi - dnl https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114870 + dnl https://gcc.gnu.org/PR114870 dnl affects GCC 13.3 and 14.2. AC_CACHE_CHECK([whether is idempotent], [gl_cv_stddef_idempotent], diff --git a/m4/stdint.m4 b/m4/stdint.m4 index 2d69088b676..5a289e6df4d 100644 --- a/m4/stdint.m4 +++ b/m4/stdint.m4 @@ -1,5 +1,5 @@ # stdint.m4 -# serial 64 +# serial 65 dnl Copyright (C) 2001-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, @@ -391,9 +391,9 @@ AC_DEFUN([gl_STDINT_BITSIZEOF], ]) eval result=\$gl_cv_bitsizeof_${gltype} if test $result = unknown; then - dnl Use a nonempty default, because some compilers, such as IRIX 5 cc, - dnl do a syntax check even on unused #if conditions and give an error - dnl on valid C code like this: + dnl Use a nonempty default, because some old compilers do a syntax check + dnl even on unused #if conditions and give an error on valid C code like + dnl this: dnl #if 0 dnl # if > 32 dnl # endif diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4 index 2d25da37b53..ab2e87019bb 100644 --- a/m4/stdlib_h.m4 +++ b/m4/stdlib_h.m4 @@ -1,5 +1,5 @@ # stdlib_h.m4 -# serial 84 +# serial 85 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, @@ -205,7 +205,6 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], HAVE_PTSNAME_R=1; AC_SUBST([HAVE_PTSNAME_R]) HAVE_QSORT_R=1; AC_SUBST([HAVE_QSORT_R]) HAVE_RANDOM=1; AC_SUBST([HAVE_RANDOM]) - HAVE_RANDOM_H=1; AC_SUBST([HAVE_RANDOM_H]) HAVE_RANDOM_R=1; AC_SUBST([HAVE_RANDOM_R]) HAVE_REALLOCARRAY=1; AC_SUBST([HAVE_REALLOCARRAY]) HAVE_REALPATH=1; AC_SUBST([HAVE_REALPATH]) diff --git a/m4/string_h.m4 b/m4/string_h.m4 index bdcd6ef2b67..b5324e3a37e 100644 --- a/m4/string_h.m4 +++ b/m4/string_h.m4 @@ -1,5 +1,5 @@ # string_h.m4 -# serial 44 +# serial 45 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, @@ -63,6 +63,7 @@ AC_DEFUN([gl_STRING_H_REQUIRE_DEFAULTS], gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STPNCPY]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRCHRNUL]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRDUP]) + gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRINGEQ]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRNCAT]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRNDUP]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRNLEN]) @@ -114,6 +115,7 @@ AC_DEFUN([gl_STRING_H_DEFAULTS], HAVE_EXPLICIT_BZERO=1; AC_SUBST([HAVE_EXPLICIT_BZERO]) HAVE_FFSL=1; AC_SUBST([HAVE_FFSL]) HAVE_FFSLL=1; AC_SUBST([HAVE_FFSLL]) + HAVE_DECL_MEMEQ=0; AC_SUBST([HAVE_DECL_MEMEQ]) HAVE_DECL_MEMMEM=1; AC_SUBST([HAVE_DECL_MEMMEM]) HAVE_MEMPCPY=1; AC_SUBST([HAVE_MEMPCPY]) HAVE_MEMSET_EXPLICIT=1; AC_SUBST([HAVE_MEMSET_EXPLICIT]) @@ -123,6 +125,7 @@ AC_DEFUN([gl_STRING_H_DEFAULTS], HAVE_STPNCPY=1; AC_SUBST([HAVE_STPNCPY]) HAVE_STRCHRNUL=1; AC_SUBST([HAVE_STRCHRNUL]) HAVE_DECL_STRDUP=1; AC_SUBST([HAVE_DECL_STRDUP]) + HAVE_DECL_STREQ=0; AC_SUBST([HAVE_DECL_STREQ]) HAVE_DECL_STRNDUP=1; AC_SUBST([HAVE_DECL_STRNDUP]) HAVE_DECL_STRNLEN=1; AC_SUBST([HAVE_DECL_STRNLEN]) HAVE_STRPBRK=1; AC_SUBST([HAVE_STRPBRK]) diff --git a/m4/stringeq.m4 b/m4/stringeq.m4 new file mode 100644 index 00000000000..de6d66c12d0 --- /dev/null +++ b/m4/stringeq.m4 @@ -0,0 +1,25 @@ +# stringeq.m4 +# serial 1 +dnl Copyright (C) 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, +dnl with or without modifications, as long as this notice is preserved. +dnl This file is offered as-is, without any warranty. + +AC_DEFUN([gl_FUNC_STREQ], +[ + AC_REQUIRE([gl_STRING_H_DEFAULTS]) + AC_CHECK_DECLS_ONCE([streq]) + if test $ac_cv_have_decl_streq != no; then + HAVE_DECL_STREQ=1 + fi +]) + +AC_DEFUN([gl_FUNC_MEMEQ], +[ + AC_REQUIRE([gl_STRING_H_DEFAULTS]) + AC_CHECK_DECLS_ONCE([memeq]) + if test $ac_cv_have_decl_memeq != no; then + HAVE_DECL_MEMEQ=1 + fi +]) diff --git a/m4/sys_select_h.m4 b/m4/sys_select_h.m4 index b02f470d95c..f154bc5f1e6 100644 --- a/m4/sys_select_h.m4 +++ b/m4/sys_select_h.m4 @@ -1,5 +1,5 @@ # sys_select_h.m4 -# serial 23 +# serial 24 dnl Copyright (C) 2006-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, @@ -13,17 +13,14 @@ AC_DEFUN_ONCE([gl_SYS_SELECT_H], AC_CACHE_CHECK([whether is self-contained], [gl_cv_header_sys_select_h_selfcontained], [ - dnl Test against two bugs: + dnl Test against a bug: dnl 1. On many platforms, assumes prior inclusion of dnl . - dnl 2. On OSF/1 4.0, provides only a forward declaration - dnl of 'struct timeval', and no definition of this type. - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], - [[struct timeval b;]])], + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [])], [gl_cv_header_sys_select_h_selfcontained=yes], [gl_cv_header_sys_select_h_selfcontained=no]) dnl Test against another bug: - dnl 3. On Solaris 10, provides an FD_ZERO implementation + dnl 2. On Solaris 10, provides an FD_ZERO implementation dnl that relies on memset(), but without including . if test $gl_cv_header_sys_select_h_selfcontained = yes; then AC_COMPILE_IFELSE( diff --git a/m4/sys_socket_h.m4 b/m4/sys_socket_h.m4 index fb69209b4dc..da3c6804c6f 100644 --- a/m4/sys_socket_h.m4 +++ b/m4/sys_socket_h.m4 @@ -1,5 +1,5 @@ # sys_socket_h.m4 -# serial 31 +# serial 32 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, @@ -13,17 +13,6 @@ AC_DEFUN_ONCE([gl_SYS_SOCKET_H], AC_REQUIRE([gl_SYS_SOCKET_H_DEFAULTS]) AC_REQUIRE([AC_CANONICAL_HOST]) - dnl On OSF/1, the functions recv(), send(), recvfrom(), sendto() have - dnl old-style declarations (with return type 'int' instead of 'ssize_t') - dnl unless _POSIX_PII_SOCKET is defined. - case "$host_os" in - osf*) - AC_DEFINE([_POSIX_PII_SOCKET], [1], - [Define to 1 in order to get the POSIX compatible declarations - of socket functions.]) - ;; - esac - GL_GENERATE_SYS_SOCKET_H=false AC_CACHE_CHECK([whether is self-contained], [gl_cv_header_sys_socket_h_selfcontained], diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4 index fdcc89545bc..10636923b17 100644 --- a/m4/sys_stat_h.m4 +++ b/m4/sys_stat_h.m4 @@ -1,5 +1,5 @@ # sys_stat_h.m4 -# serial 42 -*- Autoconf -*- +# serial 44 -*- Autoconf -*- dnl Copyright (C) 2006-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, diff --git a/m4/time_rz.m4 b/m4/time_rz.m4 index b85e6d0cbb5..885463a03b9 100644 --- a/m4/time_rz.m4 +++ b/m4/time_rz.m4 @@ -1,5 +1,5 @@ # time_rz.m4 -# serial 3 +# serial 4 dnl Copyright (C) 2015-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, @@ -58,7 +58,8 @@ AC_DEFUN([gl_TIME_RZ], if test $ac_cv_func_tzalloc = yes; then HAVE_TZALLOC=1 fi - dnl Assume that tzalloc, localtime_rz, mktime_z are all defined together. + dnl Assume that tzalloc, tzfree, localtime_rz, mktime_z + dnl are all defined together. case "$gl_cv_onwards_func_tzalloc" in yes) case "$host_os" in diff --git a/m4/unlocked-io.m4 b/m4/unlocked-io.m4 index 97f43f4b6c4..a5eacecc61c 100644 --- a/m4/unlocked-io.m4 +++ b/m4/unlocked-io.m4 @@ -1,5 +1,5 @@ # unlocked-io.m4 -# serial 16 +# serial 17 dnl Copyright (C) 1998-2006, 2009-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, @@ -25,6 +25,7 @@ AC_DEFUN([gl_FUNC_GLIBC_UNLOCKED_IO], AC_CHECK_DECLS_ONCE([ferror_unlocked]) AC_CHECK_DECLS_ONCE([fflush_unlocked]) AC_CHECK_DECLS_ONCE([fgets_unlocked]) + AC_CHECK_DECLS_ONCE([fileno_unlocked]) AC_CHECK_DECLS_ONCE([fputc_unlocked]) AC_CHECK_DECLS_ONCE([fputs_unlocked]) AC_CHECK_DECLS_ONCE([fread_unlocked]) diff --git a/src/conf_post.h b/src/conf_post.h index 4a88f46455d..cf2e6dca4e5 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -402,8 +402,8 @@ extern int emacs_setenv_TZ (char const *); #include #undef _GL_TIME_H -/* Redefine tzalloc and tzfree so as not to conflict with their - system-provided versions, which are incompatible. */ +/* Redefine tzalloc so as not to conflict with its + system-provided version, which is incompatible. + Do not redefine tzfree, as Gnulib does that. */ #define tzalloc rpl_tzalloc -#define tzfree rpl_tzfree #endif /* defined __ANDROID__ && __ANDROID_API__ >= 35 */ diff --git a/src/timefns.c b/src/timefns.c index b4baeaaff82..75efea3560d 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -1323,21 +1323,23 @@ or (if you need time as a string) `format-time-string'. */) /* Write information into buffer S of size MAXSIZE, according to the FORMAT of length FORMAT_LEN, using time information taken from *TP. + FORMAT[FORMATLEN] must be NUL. Use the time zone specified by TZ. Use NS as the number of nanoseconds in the %N directive. - Return the number of bytes written, not including the terminating - '\0'. If S is NULL, nothing will be written anywhere; so to + Return the number of bytes written, not including the terminating NUL. + On error return -1, setting errno and possibly writing some bytes. + + If S is NULL, nothing will be written anywhere; so to determine how many bytes would be written, use NULL for S and - ((size_t) -1) for MAXSIZE. + SIZE_MAX for MAXSIZE. This function behaves like nstrftime, except it allows null bytes in FORMAT. */ -static size_t +static ptrdiff_t emacs_nmemftime (char *s, size_t maxsize, const char *format, size_t format_len, const struct tm *tp, timezone_t tz, int ns) { - int saved_errno = errno; - size_t total = 0; + ptrdiff_t total = 0; /* Loop through all the null-terminated strings in the format argument. Normally there's just one null-terminated string, but @@ -1346,24 +1348,24 @@ emacs_nmemftime (char *s, size_t maxsize, const char *format, '\0' byte so we must invoke it separately for each such string. */ for (;;) { - errno = 0; - size_t result = nstrftime (s, maxsize, format, tp, tz, ns); - if (result == 0 && errno != 0) + ptrdiff_t result = nstrftime (s, maxsize, format, tp, tz, ns); + if (result < 0) return result; - if (s) - s += result + 1; - - maxsize -= result + 1; - total += result; size_t len = strlen (format); + if (ckd_add (&total, total, result + (len != format_len))) + { + errno = ERANGE; + return -1; + } if (len == format_len) break; - total++; + if (s) + s += result + 1; + maxsize -= result + 1; format += len + 1; format_len -= len + 1; } - errno = saved_errno; return total; } @@ -1373,9 +1375,7 @@ format_time_string (char const *format, ptrdiff_t formatlen, { char buffer[4000]; char *buf = buffer; - ptrdiff_t size = sizeof buffer; - size_t len; - int ns = t.tv_nsec; + ptrdiff_t len = -1; USE_SAFE_ALLOCA; timezone_t tz = tzlookup (zone, false); @@ -1384,34 +1384,29 @@ format_time_string (char const *format, ptrdiff_t formatlen, expects a pointer to time_t value. */ time_t tsec = t.tv_sec; tmp = emacs_localtime_rz (tz, &tsec, tmp); - if (! tmp) + if (tmp) { - int localtime_errno = errno; - xtzfree (tz); - time_error (localtime_errno); - } - synchronize_system_time_locale (); - - while (true) - { - errno = 0; - len = emacs_nmemftime (buf, size, format, formatlen, tmp, tz, ns); - if (len != 0 || errno == 0) - break; - eassert (errno == ERANGE); - - /* Buffer was too small, so make it bigger and try again. */ - len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tmp, tz, ns); - if (STRING_BYTES_BOUND <= len) + synchronize_system_time_locale (); + int ns = t.tv_nsec; + len = emacs_nmemftime (buffer, sizeof buffer, format, formatlen, + tmp, tz, ns); + if (len < 0 && errno == ERANGE) { - xtzfree (tz); - string_overflow (); + /* Buffer was too small, so make it bigger and try again. */ + len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, + tmp, tz, ns); + if (0 <= len && len < STRING_BYTES_BOUND) + { + buf = SAFE_ALLOCA (len + 1); + len = emacs_nmemftime (buf, len + 1, format, formatlen, + tmp, tz, ns); + } } - size = len + 1; - buf = SAFE_ALLOCA (size); } xtzfree (tz); + if (len < 0) + time_error (errno); AUTO_STRING_WITH_LEN (bufstring, buf, len); Lisp_Object result = code_convert_string_norecord (bufstring, Vlocale_coding_system, 0); commit 327c16ce14897ad4f1e5f9759b9773f97549eae1 Author: Philip Kaludercic Date: Fri Oct 24 18:32:14 2025 +0200 Add support for 'bind-and*' patterns to 'cond*' * lisp/emacs-lisp/cond-star.el (cond*): Document 'bind-and*'. (bind-and*): Add a stub to raise an error if 'bind-and*' is used outside of 'cond*'. (cond*-convert-condition): Implement a new type of condition. diff --git a/lisp/emacs-lisp/cond-star.el b/lisp/emacs-lisp/cond-star.el index dcbc3e67829..7dc6b34cc64 100644 --- a/lisp/emacs-lisp/cond-star.el +++ b/lisp/emacs-lisp/cond-star.el @@ -69,6 +69,10 @@ and runs the body of the clause if the first binding's value is non-nil. For its patterns, see `match*'. The condition counts as true if PATTERN matches DATUM. +`(bind-and* BINDINGS...)' means to bind BINDINGS (as if they were in +`if-let*') for only the the body of the clause. If any expression +evaluates to nil, the condition counts as false. + `(pcase* PATTERN DATUM)' means to match DATUM against the pattern PATTERN, using the same pattern syntax as `pcase'. The condition counts as true if PATTERN matches DATUM. @@ -154,6 +158,13 @@ ATOM (meaning any other kind of non-list not described above) ;; FIXME: `byte-compile-warn-x' is not necessarily defined here. (byte-compile-warn-x pattern "`match*' used other than as a `cond*' condition")) +(defmacro bind-and* (&rest bindings) + "This macro evaluates BINDINGS like `if-let*'. +It is not really a Lisp function, and it is meaningful +only in the CONDITION of a `cond*' clause." + ;; FIXME: `byte-compile-warn-x' is not necessarily defined here. + (byte-compile-warn-x bindings "`bind-and*' used other than as a `cond*' condition")) + (defun cond*-non-exit-clause-p (clause) "If CLAUSE, a cond* clause, is a non-exit clause, return t." (or (null (cdr-safe clause)) ;; clause has only one element. @@ -279,6 +290,30 @@ This is used for conditional exit clauses." (let* ,mod-bindings (when ,init-gensym . ,true-exps))))))) + ((eq pat-type 'bind-and*) + (let ((checks '()) (last t)) + (dolist (bind (cdr condition)) + (push (list (car bind) (list 'and last (cadr bind))) + checks) + (setq last (car bind))) + (cond + ;; For explanations on these cases, see "Ordinary + ;; Lisp expression is the condition." below. + (rest + (let ((quit (gensym "quit"))) + `(catch ',quit + (let* (,@(nreverse checks)) + (if ,last (throw ',quit ,(macroexp-progn true-exps)))) + ,iffalse))) + (uncondit-clauses + `(progn + (let* (,@(nreverse checks)) + (if ,last ,(macroexp-progn true-exps))) + ,(cond*-convert uncondit-clauses))) + (true-exps + `(let* (,@(nreverse checks)) + (if ,last ,(macroexp-progn true-exps)))) + (t last)))) ((eq pat-type 'pcase*) (if true-exps (progn commit 89f0853f1e902778076ae63d0cb21f99d824cbac Author: Juri Linkov Date: Tue Nov 4 20:02:28 2025 +0200 Use 'read-char-choice' in 'ask-user-about-lock' (bug#79664) * lisp/userlock.el (ask-user-about-lock): Use 'read-char-choice' instead of 'read-char'. * lisp/subr.el (read-char-choice-with-read-key): Add fallback cond-branch to show a message with required keys. diff --git a/lisp/subr.el b/lisp/subr.el index ef08618f467..a5f8ead0a1b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3745,7 +3745,16 @@ causes it to evaluate `help-form' and display the result." ((and (null esc-flag) (eq char ?\e)) (setq esc-flag t)) ((memq char '(?\C-g ?\e)) - (keyboard-quit)))))))) + (keyboard-quit)))) + (t + (beep) + (message "Please type %s" + (substitute-command-keys + (mapconcat (lambda (c) + (format "\\`%s'" + (single-key-description c))) + chars ", "))) + (sit-for 3)))))) ;; Display the question with the answer. But without cursor-in-echo-area. (message "%s%s" prompt (char-to-string char)) char)) diff --git a/lisp/userlock.el b/lisp/userlock.el index 583e13e8b2f..9c1c73cbc8c 100644 --- a/lisp/userlock.el +++ b/lisp/userlock.el @@ -51,7 +51,8 @@ You can redefine this function to choose among those three alternatives in any way you like." (discard-input) (save-window-excursion - (let (answer short-opponent short-file) + (let ((choices `(?s ?q ?p ?S ?Q ?P ?\C-g ?? ,help-char)) + prompt short-opponent short-file answer) (setq short-file (if (> (length file) 22) (concat "..." (substring file (- (length file) 22))) @@ -63,16 +64,15 @@ in any way you like." (concat (substring opponent 0 13) "..." (match-string 0 opponent))) opponent)) + (setq prompt (format-message + (substitute-command-keys + "%s locked by %s: (\\`s', \\`q', \\`p', \\`?')? ") + short-file short-opponent)) (while (null answer) (when noninteractive (signal 'file-locked (list file opponent "Cannot resolve lock conflict in batch mode"))) - (message (substitute-command-keys - "%s locked by %s: (\\`s', \\`q', \\`p', \\`?')? ") - short-file short-opponent) - (let ((tem (let ((inhibit-quit t) - (cursor-in-echo-area t)) - (prog1 (downcase (read-char)) - (setq quit-flag nil))))) + (let ((tem (prog1 (downcase (read-char-choice prompt choices t)) + (setq quit-flag nil)))) (if (= tem help-char) (ask-user-about-lock-help) (setq answer (assoc tem '((?s . t) commit d9ddf0d075adfdb2c934955f4747b06a05c27f28 Author: Eli Zaretskii Date: Tue Nov 4 20:00:39 2025 +0200 ; Fix documentation of a recent change * lisp/progmodes/python.el (python-ts-hs-adjust-block-end-fn): * lisp/progmodes/hideshow.el (hs-modes-alist) (hs-adjust-block-end, hs-inside-comment-p-func): Doc fixes. (bug#79671) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 13ec1bf65c9..f3850c0f3d8 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -426,33 +426,25 @@ see the `hs-modes-alist' entry for `bibtex-mode'. For some major modes, `forward-sexp' does not work properly. In those cases, FORWARD-SEXP-FUNC specifies another function to use instead. -See the documentation for `hs-adjust-block-beginning' to see what is the -use of ADJUST-BEG-FUNC. +See `hs-adjust-block-beginning' for how to use ADJUST-BEG-FUNC, +and `hs-adjust-block-end' for how to use ADJUST-END-FUNC. -See the documentation for `hs-adjust-block-end' to see what is the -use of ADJUST-END-FUNC. +See `hs-find-block-beginning-func' for how to use FIND-BLOCK-BEGINNING-FUNC +and `hs-find-next-block-func' for how to use FIND-NEXT-BLOCK-FUNC. -See the documentation for `hs-find-block-beginning-func' to see -what is the use of FIND-BLOCK-BEGINNING-FUNC. - -See the documentation for `hs-find-next-block-func' to see what -is the use of FIND-NEXT-BLOCK-FUNC. - -See the documentation for `hs-looking-at-block-start-p-func' to -see what is the use of LOOKING-AT-BLOCK-START-P-FUNC. - -See the documentation for `hs-inside-comment-p-func' to see what is the -use of INSIDE-COMMENT-P-FUNC. +See `hs-looking-at-block-start-p-func' for how to use +LOOKING-AT-BLOCK-START-P-FUNC and `hs-inside-comment-p-func' for how to +use INSIDE-COMMENT-P-FUNC. TREESIT-THINGS is a thing defined in `treesit-thing-settings' to -determine if current block at point is valid, see -`treesit-thing-settings' for more information. +determine if the block at point is valid, see `treesit-thing-settings' +for more information. All the elements support mode hierarchy. If any of the elements is left nil or omitted, hideshow searches for a value defined in some parent mode in this alist; if no value is found, it tries to guess the -appropriate values. The regexps should not contain leading or trailing -whitespace. Case does not matter.") +appropriate value. The regexps should not contain leading or trailing +whitespace. Letter-case does not matter.") (defvar hs-hide-all-non-comment-function nil "Function called if non-nil when doing `hs-hide-all' for non-comments.") @@ -611,11 +603,9 @@ See `hs-c-like-adjust-block-beginning' for an example of using this.") This is useful to ensure some characters such as parenthesis or curly braces get properly hidden in python-like modes. -It is called with 1 argument which is the start position where the -overlay will be created. - -It should return the last position to hide or nil. If it returns nil, -hideshow will guess the end position.") +It is called with one argument, which is the start position where the +overlay will be created, and should return either the last position to +hide or nil. If it returns nil, hideshow will guess the end position.") (defvar-local hs-find-block-beginning-func nil "Function used to do `hs-find-block-beginning'. @@ -652,14 +642,14 @@ to check if the point is at the block start.") (defvar-local hs-inside-comment-p-func nil "Function used to check if point is inside a comment. -If point is inside a comment, it should return a list containing the -buffer position of the start and the end of the comment, otherwise -return nil. +If point is inside a comment, the function should return a list +containing the buffer position of the start and the end of the +comment, otherwise it should return nil. A comment block can be hidden only if on its starting line there is only whitespace preceding the actual comment beginning. If point is inside -of a comment but this condition is not met, it can return a list having -a nil as its car and the end of comment position as cdr.") +a comment but this condition is not met, the function can return a list +having nil as its `car' and the end of comment position as its `cdr'.") (defvar-local hs-treesit-things nil "Treesit things to check if point is at a valid block. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 9826edfc054..f73a0128b5c 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5917,7 +5917,7 @@ are also searched. REGEXP is passed to `looking-at' to set BLOCK-BEG is the beginning position where the hiding will be performed. -This is only used to properly hide the block when there are not closing +This is only used to properly hide the block when there are no closing parens." (unless (save-excursion (goto-char block-beg) commit 447bb6ef5cb483ad1edd635792c5c801e8270b38 Merge: 7c6993e21d9 2bec93b5f4a Author: Eli Zaretskii Date: Tue Nov 4 19:45:10 2025 +0200 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 2bec93b5f4a04e893b975d35d2ef39969d596979 Author: Juri Linkov Date: Tue Nov 4 19:23:55 2025 +0200 * test/lisp/emacs-lisp/map-ynp-tests.el: Silence backtrace. (test-map-ynp-kmacro): Ignore 'backtrace-print' that prints unrequested backtrace (bug#67836). diff --git a/test/lisp/emacs-lisp/map-ynp-tests.el b/test/lisp/emacs-lisp/map-ynp-tests.el index 371d52e2028..6a9c8213791 100644 --- a/test/lisp/emacs-lisp/map-ynp-tests.el +++ b/test/lisp/emacs-lisp/map-ynp-tests.el @@ -33,14 +33,15 @@ (ert-deftest test-map-ynp-kmacro () "Test that `map-y-or-n-p' in a kmacro terminates on end of input." - (execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET y")) - (should-error - (execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET"))) - (unless noninteractive - (let ((noninteractive t)) - (execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET y")) - (should-error - (execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET")))))) + (cl-letf* (((symbol-function #'backtrace-print) (lambda ()))) ;; bug#67836 + (execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET y")) + (should-error + (execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET"))) + (unless noninteractive + (let ((noninteractive t)) + (execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET y")) + (should-error + (execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET"))))))) (provide 'map-ynp-tests) ;;; map-ynp-tests.el ends here commit 959345f602d9a779875df689bdf0adb2b84be4dc Author: Elías Gabriel Pérez Date: Mon Oct 13 18:45:21 2025 -0600 hideshow: Rewrite 'hs-special-modes-alist' Rewrite the format in 'hs-special-modes-alist' to make easier to exclude some values, add support for settings inheritance according to current major mode and parents, and support string hiding for lisp modes. Bug#79671 * lisp/progmodes/hideshow.el (hs-modes-alist): New variable. (hs-special-modes-alist): Mark as obsolete. (hs-forward-sexp-func, hs-adjust-block-beginning) (hs-find-block-beginning-func, hs-find-next-block-func) (hs-looking-at-block-start-p-func): Set default values to nil. (hs-inside-comment-p): Remove function. (hs-adjust-block-end, hs-treesit-things): New buffer-local variables. (hs-block-positions): Minor updates. (hs--get-mode-value): New function. (hs-grok-mode-type): Rewrite. * lisp/progmodes/f90.el (hs-special-modes-alist): * lisp/progmodes/fortran.el (hs-special-modes-alist): * lisp/progmodes/icon.el (icon-mode): * lisp/progmodes/lua-mode.el (lua-mode): * lisp/progmodes/python.el (python-base-mode): * lisp/progmodes/verilog-mode.el (verilog-mode): * lisp/progmodes/vhdl-mode.el (vhdl-hs-minor-mode): Rewrite settings. * lisp/progmodes/python.el (python-ts-hs-adjust-block-end-fn): New function. * lisp/treesit.el (treesit-hs-block-end) (treesit-hs-find-block-beginning, treesit-hs-find-next-block) (treesit-hs-looking-at-block-start-p): Minor updates. * doc/emacs/programs.texi (Hideshow): * etc/NEWS: Document changes. diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index f42f40fa28f..12bde32be05 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -1735,7 +1735,7 @@ Hide all blocks @var{n} levels below this block @vindex hs-indicator-maximum-buffer-size @vindex hs-isearch-open @vindex hs-hide-block-behavior -@vindex hs-special-modes-alist +@vindex hs-modes-alist These variables can be used to customize Hideshow mode: @table @code @@ -1782,6 +1782,9 @@ code blocks and comments), or @code{nil} (unhide neither code blocks nor comments). The default value is @code{code}. @end table +All necessary settings for each mode can be found in the variable +@code{hs-modes-alist}. + @node Symbol Completion @section Completion for Symbol Names @cindex completion (symbol names) diff --git a/etc/NEWS b/etc/NEWS index d3eff6991dd..81117951302 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1100,6 +1100,12 @@ should hide a block. If set to 'after-bol', hide the innermost block to which the current line belongs. If set to 'after-cursor', hide the block after cursor position. By default this is set to 'after-bol'. ++++ +*** The variable 'hs-special-modes-alist' is now obsolete. +Use the new variable 'hs-modes-alist' instead, which supports mode +hierarchy for each value. + + ** C-ts mode +++ diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 96626600d55..c3158069dcd 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -930,7 +930,7 @@ allowed. This minor issue currently only affects \"(/\" and \"/)\".") "block" "critical") t) "\\_>") "Regexp matching the end of an F90 \"block\", from the line start. -Used in the F90 entry in `hs-special-modes-alist'.") +Used in the F90 entry in `hs-modes-alist'.") ;; Ignore the fact that FUNCTION, SUBROUTINE, WHERE, FORALL have a ;; following "(". DO, CASE, IF can have labels. @@ -966,12 +966,12 @@ Used in the F90 entry in `hs-special-modes-alist'.") "Regexp matching the start of an F90 \"block\", from the line start. A simple regexp cannot do this in fully correct fashion, so this tries to strike a compromise between complexity and flexibility. -Used in the F90 entry in `hs-special-modes-alist'.") +Used in the F90 entry in `hs-modes-alist'.") -;; hs-special-modes-alist is autoloaded. -(add-to-list 'hs-special-modes-alist - `(f90-mode ,f90-start-block-re ,f90-end-block-re - "!" f90-end-of-block nil)) +;; hs-modes-alist is autoloaded. +(add-to-list 'hs-modes-alist + `(f90-mode (start . ,f90-start-block-re) (end . ,f90-end-block-re) + (c-start . "!") (forward-fn . f90-end-of-block))) ;; Imenu support. diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index d1f14fdf8fe..6eb75af01a3 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -549,7 +549,7 @@ than ENDDO.") "\\|!\\|$\\)") "Regexp matching the end of a Fortran \"block\", from the line start. Note that only ENDDO is handled for the end of a DO-loop. Used -in the Fortran entry in `hs-special-modes-alist'.") +in the Fortran entry in `hs-modes-alist'.") (defconst fortran-start-block-re (concat @@ -582,11 +582,11 @@ in the Fortran entry in `hs-special-modes-alist'.") "Regexp matching the start of a Fortran \"block\", from the line start. A simple regexp cannot do this in fully correct fashion, so this tries to strike a compromise between complexity and flexibility. -Used in the Fortran entry in `hs-special-modes-alist'.") +Used in the Fortran entry in `hs-modes-alist'.") -(add-to-list 'hs-special-modes-alist - `(fortran-mode ,fortran-start-block-re ,fortran-end-block-re - "^[cC*!]" fortran-end-of-block nil)) +(add-to-list 'hs-modes-alist + `(fortran-mode (start . ,fortran-start-block-re) (end . ,fortran-end-block-re) + (c-start . "^[cC*!]") (forward-fn . fortran-end-of-block))) (defvar fortran-mode-syntax-table @@ -1247,7 +1247,7 @@ Directive lines are treated as comments." (goto-char i) (= (line-beginning-position) p))))) -;; Used in hs-special-modes-alist. +;; Used in hs-modes-alist. (defun fortran-end-of-block (&optional num) "Move point forward to the end of the current code block. With optional argument NUM, go forward that many balanced blocks. diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 6158253ee53..13ec1bf65c9 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -370,30 +370,48 @@ This is only used if `hs-indicator-type' is set to `margin' or nil." :version "31.1") ;;;###autoload -(defvar hs-special-modes-alist - ;; FIXME: Currently the check is made via - ;; (assoc major-mode hs-special-modes-alist) so it doesn't pay attention - ;; to the mode hierarchy. - '((c-mode "{" "}" "/[*/]" nil nil) - (c-ts-mode "{" "}" "/[*/]" nil nil) - (c++-mode "{" "}" "/[*/]" nil nil) - (c++-ts-mode "{" "}" "/[*/]" nil nil) - (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) - (java-mode "{" "}" "/[*/]" nil nil) - (java-ts-mode "{" "}" "/[*/]" nil nil) - (js-mode "{" "}" "/[*/]" nil) - (js-ts-mode "{" "}" "/[*/]" nil) - (mhtml-mode "{\\|<[^/>]*?" "}\\|]*[^/]>" " whatever ;; ((and (eq 'byte-constant (car lap0)) - (memq (car lap1) byte-conditional-ops) + (memq (car lap1) conditional-ops) ;; Must be an actual constant, not a closure variable. (consp (cdr lap0))) (cond ((if (memq (car lap1) '(byte-goto-if-nil @@ -2559,7 +2529,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; (this may enable other optimizations.) ;; ((and (eq 'byte-unbind (car lap1)) - (memq (car lap0) byte-after-unbind-ops)) + (memq (car lap0) after-unbind-ops)) (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0) (setcar rest lap1) (setcar (cdr rest) lap0) @@ -2674,9 +2644,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." byte-goto-if-not-nil-else-pop)) (let ((tmp (cdr (memq (cdr lap0) (cdr lap-head))))) (and - (memq (caar tmp) - (eval-when-compile - (cons 'byte-discard byte-conditional-ops))) + (memq (caar tmp) conditional-or-discard-ops) (not (eq lap0 (car tmp))) (let ((tmp2 (car tmp)) (tmp3 (assq (car lap0) @@ -2709,9 +2677,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (eq (car lap1) 'byte-goto) (let ((tmp (cdr (memq (cdr lap1) (cdr lap-head))))) (and - (memq (caar tmp) - (eval-when-compile - (cons 'byte-discard byte-conditional-ops))) + (memq (caar tmp) conditional-or-discard-ops) (not (eq lap1 (car tmp))) (let ((tmp2 (car tmp))) (cond ((and (consp (cdr lap0)) @@ -2761,6 +2727,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (and (eq (car (car tmp)) 'byte-varref) (eq (cdr (car tmp)) (cdr lap1)) + ;; Can't optimise away varref for DEFVAR_BOOL vars + ;; because what we put in might not be what we get out. (not (memq (car (cdr lap1)) byte-boolean-vars)) (let ((newtag (byte-compile-make-tag))) (byte-compile-log-lap commit 2ed5179179d9e642c250e10c5dc86f30b841f9ba Author: Yuan Fu Date: Thu Oct 23 23:41:31 2025 -0700 Remove cached font-lock settings in java-ts-mode After the changes made in bug#79363, we don't need the cache anymore. * lisp/progmodes/java-ts-mode.el: (java-ts-mode--font-lock-settings-cached): Remove variable. (java-ts-mode--font-lock-settings): Remove use of the variable. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index f1c6d52b58f..64a41de2a43 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -237,140 +237,135 @@ For NODE, OVERRIDE, START, and END, see `treesit-font-lock-rules'." 'font-lock-constant-face override start end)))) -(defvar java-ts-mode--font-lock-settings-cached nil - "Cached tree-sitter font-lock settings for `java-ts-mode'.") - (defun java-ts-mode--font-lock-settings () "Return tree-sitter font-lock settings for `java-ts-mode'. Tree-sitter font-lock settings are evaluated the first time this function is called. Subsequent calls return the first evaluated value." - (or java-ts-mode--font-lock-settings-cached - (setq java-ts-mode--font-lock-settings-cached - (treesit-font-lock-rules - :language 'java - :override t - :feature 'comment - `((line_comment) @font-lock-comment-face - (block_comment) @font-lock-comment-face) - :language 'java - :override t - :feature 'keyword - `([,@java-ts-mode--keywords - (this) - (super)] @font-lock-keyword-face - (labeled_statement - (identifier) @font-lock-keyword-face)) - :language 'java - :override t - :feature 'operator - `([,@java-ts-mode--operators] @font-lock-operator-face - "@" @font-lock-constant-face) - :language 'java - :override t - :feature 'annotation - `((annotation - name: (identifier) @font-lock-constant-face) - - (marker_annotation - name: (identifier) @font-lock-constant-face)) - :language 'java - :override t - :feature 'string - (java-ts-mode--string-highlight-helper) - :language 'java - :override t - :feature 'literal - `((null_literal) @font-lock-constant-face - (binary_integer_literal) @font-lock-number-face - (decimal_integer_literal) @font-lock-number-face - (hex_integer_literal) @font-lock-number-face - (octal_integer_literal) @font-lock-number-face - (decimal_floating_point_literal) @font-lock-number-face - (hex_floating_point_literal) @font-lock-number-face) - :language 'java - :override t - :feature 'type - '((annotation_type_declaration - name: (identifier) @font-lock-type-face) - - (interface_declaration - name: (identifier) @font-lock-type-face) - - (class_declaration - name: (identifier) @font-lock-type-face) - - (record_declaration - name: (identifier) @font-lock-type-face) - - (enum_declaration - name: (identifier) @font-lock-type-face) - - (constructor_declaration - name: (identifier) @font-lock-type-face) - - (compact_constructor_declaration - name: (identifier) @font-lock-type-face) - - (method_reference (identifier) @font-lock-type-face) - - (scoped_identifier (identifier) @font-lock-constant-face) - - ((scoped_identifier name: (identifier) @font-lock-type-face) - (:match "\\`[A-Z]" @font-lock-type-face)) - - (type_identifier) @font-lock-type-face - - [(boolean_type) - (integral_type) - (floating_point_type) - (void_type)] @font-lock-type-face) - :language 'java - :override t - :feature 'definition - `((annotation_type_element_declaration - name: (identifier) @font-lock-function-name-face) - - (method_declaration - name: (identifier) @font-lock-function-name-face) - - (variable_declarator - name: (identifier) @font-lock-variable-name-face) - - (element_value_pair - key: (identifier) @font-lock-property-use-face) - - (formal_parameter - name: (identifier) @font-lock-variable-name-face) - - (catch_formal_parameter - name: (identifier) @font-lock-variable-name-face)) - :language 'java - :override t - :feature 'expression - '((method_invocation - object: (identifier) @font-lock-variable-use-face) - - (method_invocation - name: (identifier) @font-lock-function-call-face) - - (argument_list (identifier) @font-lock-variable-name-face) - - (expression_statement (identifier) @font-lock-variable-use-face)) - ;; Make sure the constant feature is after expression and definition, - ;; because those two applies variable-name-face on some constants. - :language 'java - :override t - :feature 'constant - `((identifier) @java-ts-mode--fontify-constant - [(true) (false)] @font-lock-constant-face) - :language 'java - :feature 'bracket - '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) - - :language 'java - :feature 'delimiter - '((["," ":" ";"]) @font-lock-delimiter-face))))) + (treesit-font-lock-rules + :language 'java + :override t + :feature 'comment + `((line_comment) @font-lock-comment-face + (block_comment) @font-lock-comment-face) + :language 'java + :override t + :feature 'keyword + `([,@java-ts-mode--keywords + (this) + (super)] @font-lock-keyword-face + (labeled_statement + (identifier) @font-lock-keyword-face)) + :language 'java + :override t + :feature 'operator + `([,@java-ts-mode--operators] @font-lock-operator-face + "@" @font-lock-constant-face) + :language 'java + :override t + :feature 'annotation + `((annotation + name: (identifier) @font-lock-constant-face) + + (marker_annotation + name: (identifier) @font-lock-constant-face)) + :language 'java + :override t + :feature 'string + (java-ts-mode--string-highlight-helper) + :language 'java + :override t + :feature 'literal + `((null_literal) @font-lock-constant-face + (binary_integer_literal) @font-lock-number-face + (decimal_integer_literal) @font-lock-number-face + (hex_integer_literal) @font-lock-number-face + (octal_integer_literal) @font-lock-number-face + (decimal_floating_point_literal) @font-lock-number-face + (hex_floating_point_literal) @font-lock-number-face) + :language 'java + :override t + :feature 'type + '((annotation_type_declaration + name: (identifier) @font-lock-type-face) + + (interface_declaration + name: (identifier) @font-lock-type-face) + + (class_declaration + name: (identifier) @font-lock-type-face) + + (record_declaration + name: (identifier) @font-lock-type-face) + + (enum_declaration + name: (identifier) @font-lock-type-face) + + (constructor_declaration + name: (identifier) @font-lock-type-face) + + (compact_constructor_declaration + name: (identifier) @font-lock-type-face) + + (method_reference (identifier) @font-lock-type-face) + + (scoped_identifier (identifier) @font-lock-constant-face) + + ((scoped_identifier name: (identifier) @font-lock-type-face) + (:match "\\`[A-Z]" @font-lock-type-face)) + + (type_identifier) @font-lock-type-face + + [(boolean_type) + (integral_type) + (floating_point_type) + (void_type)] @font-lock-type-face) + :language 'java + :override t + :feature 'definition + `((annotation_type_element_declaration + name: (identifier) @font-lock-function-name-face) + + (method_declaration + name: (identifier) @font-lock-function-name-face) + + (variable_declarator + name: (identifier) @font-lock-variable-name-face) + + (element_value_pair + key: (identifier) @font-lock-property-use-face) + + (formal_parameter + name: (identifier) @font-lock-variable-name-face) + + (catch_formal_parameter + name: (identifier) @font-lock-variable-name-face)) + :language 'java + :override t + :feature 'expression + '((method_invocation + object: (identifier) @font-lock-variable-use-face) + + (method_invocation + name: (identifier) @font-lock-function-call-face) + + (argument_list (identifier) @font-lock-variable-name-face) + + (expression_statement (identifier) @font-lock-variable-use-face)) + ;; Make sure the constant feature is after expression and definition, + ;; because those two applies variable-name-face on some constants. + :language 'java + :override t + :feature 'constant + `((identifier) @java-ts-mode--fontify-constant + [(true) (false)] @font-lock-constant-face) + :language 'java + :feature 'bracket + '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) + + :language 'java + :feature 'delimiter + '((["," ":" ";"]) @font-lock-delimiter-face))) (defun java-ts-mode--defun-name (node) "Return the defun name of NODE. commit fa9d22d719782122934e155b260364650d4595a3 Author: Yuan Fu Date: Thu Oct 23 23:35:32 2025 -0700 Fix field access fontification in java-ts-mode (bug#79625) * lisp/progmodes/java-ts-mode.el (java-ts-mode--font-lock-settings): Remove the field_access rule. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 5e45c55f42d..f1c6d52b58f 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -312,9 +312,6 @@ function is called. Subsequent calls return the first evaluated value." (compact_constructor_declaration name: (identifier) @font-lock-type-face) - (field_access - object: (identifier) @font-lock-type-face) - (method_reference (identifier) @font-lock-type-face) (scoped_identifier (identifier) @font-lock-constant-face) commit bb491ff804205d814980757d3b49f0f36b1430bb Author: Yuan Fu Date: Thu Oct 23 21:44:12 2025 -0700 Fix treesit-admin.el after recent treesit.el change * admin/tree-sitter/treesit-admin.el: (treesit-admin--verify-major-mode-queries): (treesit-admin--validate-mode-lang): (treesit-admin--mode-languages): Use treesit-font-lock-setting-language. diff --git a/admin/tree-sitter/treesit-admin.el b/admin/tree-sitter/treesit-admin.el index 1f1fa1ce752..a76e105e908 100644 --- a/admin/tree-sitter/treesit-admin.el +++ b/admin/tree-sitter/treesit-admin.el @@ -193,7 +193,7 @@ queries that has problems with latest grammar." (all-queries-valid t)) (dolist (setting settings) (let* ((query (treesit-font-lock-setting-query setting)) - (language (treesit-query-language query)) + (language (treesit-font-lock-setting-language setting)) (feature (treesit-font-lock-setting-feature setting))) ;; Record that MODE uses LANGUAGE. (unless (memq language (alist-get mode mode-language-alist)) @@ -299,7 +299,7 @@ Return non-nil if all queries are valid, nil otherwise." (dolist (setting settings) ;; `treesit-font-lock-setting-query' isn't available in Emacs 30. (let* ((query (car setting)) - (language (treesit-query-language query))) + (language (treesit-font-lock-setting-language setting))) ;; Validate query. (when (and (eq lang language) (not (treesit-query-valid-p language query))) @@ -322,9 +322,7 @@ Return non-nil if all queries are valid, nil otherwise." treesit-font-lock-settings))) (all-queries-valid t)) (cl-remove-duplicates - (mapcar #'treesit-query-language - (mapcar #'treesit-font-lock-setting-query - settings))))) + (mapcar #'treesit-font-lock-setting-language settings)))) (defun treesit-admin--find-latest-compatible-revision (mode language source-alist grammar-dir revision-type commit f47824106a58f00c8d5e166930f18102b5e96bd0 Author: João Távora Date: Thu Oct 23 22:34:38 2025 +0100 Prevent shorthand inheritance when loading .elc files (bug#79485) Loading .elc files doesn't go through 'load-with-code-conversion' as usual, but since these files are still 'read', we must still take care to bind read-symbol-shorthands to nil around that. The process is simpler than in 'load-with-code-conversion' because .elc files cannot have read-symbol-shorthands cookies, so the binding is always to nil. If we don't do this, the symbols in the .elc will be subject to shorthand manipulation if there's an active binding in the recursive load stack. * src/lread.c (readevalloop): Bind read-symbol-shorthands to nil. (syms_of_lread): Add Qread_symbol_shorthands. diff --git a/src/lread.c b/src/lread.c index 1a667ce163a..273957507a3 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2207,6 +2207,12 @@ readevalloop (Lisp_Object readcharfun, specbind (Qstandard_input, readcharfun); + /* In an .elc file, all shorthand expansion has alreay taken place, so + make sure we disable any read-symbol-shorthands set higher up in + the stack of recursive 'load'. */ + if (STRINGP (sourcename) && suffix_p (sourcename, ".elc")) + specbind (Qread_symbol_shorthands, Qnil); + /* If lexical binding is active (either because it was specified in the file's header, or via a buffer-local variable), create an empty lexical environment, otherwise, turn off lexical binding. */ @@ -5907,6 +5913,7 @@ will use instead of `load-path' to look for the file to load. */); doc: /* Function to decide default lexical-binding. */); Vinternal__get_default_lexical_binding_function = Qnil; + DEFSYM (Qread_symbol_shorthands, "read-symbol-shorthands"); DEFVAR_LISP ("read-symbol-shorthands", Vread_symbol_shorthands, doc: /* Alist of known symbol-name shorthands. This variable's value can only be set via file-local variables. commit 94a4bf8a39e319004a6cee0d6259adfb207e351b Author: João Távora Date: Thu Oct 23 21:35:08 2025 +0100 Eglot: release version 1.19 * lisp/progmodes/eglot.el (Version): Bump to 1.19. (Package-Requires): Require Flymake 1.4.2 * etc/EGLOT-NEWS: Announce new version. diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index e420a84114d..628fb741571 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -18,7 +18,7 @@ to look up issue github#1234, go to https://github.com/joaotavora/eglot/issues/1234. -* Changes in upcoming Eglot +* Changes in Eglot 1.19 (23/10/2025) ** Support for call and type hierarchies @@ -36,9 +36,9 @@ performance. ** Suggests code actions at point A commonly requested feature, Eglot will use ElDoc to ask the server for -code actions available at point, indicating to the user, who may use -execute them quickly via the usual 'eglot-code-actions' command. -Customize with 'eglot-code-action-indications' and +code actions available at point. This is indicated to the user, who may +quickly execute via the usual 'eglot-code-actions' command or with the +mouse. Customize with 'eglot-code-action-indications' and 'eglot-code-action-indicator'. ** Mode line is customizable @@ -49,10 +49,10 @@ or removing symbols and strings from the customizable variable ** Improved diagnostic-reporting performance and bugfixes (bug#77588) -Eglot remembers the LSP document version to which diagonstics reported -by the LSP server pertain. This helps in skipping useless or harmful -updates, avoiding flakiness with code actions and flickering overlays -when the buffer is changed. +Eglot remembers the LSP document version pertaining to the diagnostics +reported by the LSP server. This helps in skipping useless or confusing +diagnostic updates, avoids flakiness with code actions and prevents +flickering overlays when the buffer is changed. ** Markdown links migrating to *eldoc* buffer now clickable (bug#79552) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index e4d3ed122cc..27e79b2f816 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2,12 +2,12 @@ ;; Copyright (C) 2018-2025 Free Software Foundation, Inc. -;; Version: 1.18 +;; Version: 1.19 ;; Author: João Távora ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (eldoc "1.14.0") (external-completion "0.1") (flymake "1.4.1") (jsonrpc "1.0.26") (project "0.9.8") (seq "2.23") (xref "1.6.2")) +;; Package-Requires: ((emacs "26.3") (eldoc "1.14.0") (external-completion "0.1") (flymake "1.4.2") (jsonrpc "1.0.26") (project "0.9.8") (seq "2.23") (xref "1.6.2")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any commit 15ce66523912f84bc735228d9efa004a9a463e83 Author: João Távora Date: Thu Oct 23 21:29:28 2025 +0100 Flymake: bump package version to 1.4.2 * lisp/progmodes/flymake.el (Version): Bump to 1.4.2. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 0585d128d31..7af4ea334d6 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -4,7 +4,7 @@ ;; Author: Pavel Kobyakov ;; Maintainer: Spencer Baugh -;; Version: 1.4.1 +;; Version: 1.4.2 ;; Keywords: c languages tools ;; Package-Requires: ((emacs "26.1") (eldoc "1.14.0") (project "0.7.1")) commit 1e7981fd869742420f2a0add69aba0b5cc4aa0f0 Author: João Távora Date: Thu Oct 23 21:42:00 2025 +0100 Eglot: don't send JSONRPC params in 'shutdown' request (bug#79653) See also bug#66144. Github-reference: https://github.com/joaotavora/eglot/discussions/1540 * lisp/progmodes/eglot.el (eglot-shutdown): Pass :jsonrpc-omit (Package-Requires): Require jsonrpc 1.0.26. * etc/EGLOT-NEWS: Announce bugfix. diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 23104edd5d6..e420a84114d 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -60,6 +60,12 @@ Eglot now preserves crucial properties in the Markdown documentation provided by the LSP server, fixing a longstanding bug with clickable hyperlinks. See also github#1238. +** Compliant shutdown requests (bug#79653, bug#66144, github#1540) + +Eglot now complies with the latest LSP spec, which mandates that the +shutdown request mustn't have any parameters. This should fix problems +with some servers. + * Changes in Eglot 1.18 (20/1/2025) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 5277df8b7c4..e4d3ed122cc 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -7,7 +7,7 @@ ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (eldoc "1.14.0") (external-completion "0.1") (flymake "1.4.1") (jsonrpc "1.0.24") (project "0.9.8") (seq "2.23") (xref "1.6.2")) +;; Package-Requires: ((emacs "26.3") (eldoc "1.14.0") (external-completion "0.1") (flymake "1.4.1") (jsonrpc "1.0.26") (project "0.9.8") (seq "2.23") (xref "1.6.2")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any @@ -1270,7 +1270,7 @@ SERVER." (unwind-protect (progn (setf (eglot--shutdown-requested server) t) - (eglot--request server :shutdown eglot--{} :timeout (or timeout 1.5)) + (eglot--request server :shutdown :jsonrpc-omit :timeout (or timeout 1.5)) (jsonrpc-notify server :exit eglot--{})) ;; Now ask jsonrpc.el to shut down the server. (jsonrpc-shutdown server (not preserve-buffers)) commit 74618070ab751562c307c66cd3546d680a472d80 Author: João Távora Date: Thu Oct 23 21:40:13 2025 +0100 Jsonrpc: support requests and notifications without params (bug#79653) See also bug#66144. Github-reference: https://github.com/joaotavora/eglot/discussions/1540 * lisp/jsonrpc.el (jsonrpc-async-request): Fix docstring. (jsonrpc--async-request-1): Handle :jsonrpc-omit (jsonrpc-notify): Handle jsonrpc-omit. (jsonrpc-request): Tweak doc. (Version): Bump to 1.0.26. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 1ad0a78b1d1..808c1fdd147 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -4,7 +4,7 @@ ;; Author: João Távora ;; Keywords: processes, languages, extensions -;; Version: 1.0.25 +;; Version: 1.0.26 ;; Package-Requires: ((emacs "25.2")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -360,8 +360,8 @@ object, using the keywords `:code', `:message' and `:data'." _timeout-fn _timeout _deferred) "Make a request to CONNECTION, expecting a reply, return immediately. -The JSONRPC request is formed by METHOD, a symbol, and PARAMS a -JSON object. +The JSONRPC request is formed by METHOD, a symbol; and PARAMS, a JSON +object value as described in `json-serialize' (which see). The caller can expect SUCCESS-FN or ERROR-FN to be called with a JSONRPC `:result' or `:error' object, respectively. If this @@ -378,6 +378,9 @@ never be sent at all, in case it is overridden in the meantime by a new request with identical DEFERRED and for the same buffer. However, in that situation, the original timeout is kept. +PARAMS can also be the keyword `:jsonrpc-omit', in which case the +JSONRPC request object is formed witout a `params' entry. + Returns a list whose first element is an integer identifying the request as specified in the JSONRPC 2.0 spec." (apply #'jsonrpc--async-request-1 connection method params args)) @@ -387,9 +390,8 @@ as specified in the JSONRPC 2.0 spec." deferred timeout cancel-on-input cancel-on-input-retval) - "Make a request to CONNECTION, wait for a reply. -Like `jsonrpc-async-request' for CONNECTION, METHOD and PARAMS, -but synchronous. + "Make a request to CONNECTION, synchronously wait for a reply. +CONNECTION, METHOD and PARAMS as in `jsonrpc-async-request' (which see). Except in the case of a non-nil CANCEL-ON-INPUT (explained below), this function doesn't exit until anything interesting @@ -401,11 +403,13 @@ error of type `jsonrpc-error'. DEFERRED and TIMEOUT as in `jsonrpc-async-request', which see. If CANCEL-ON-INPUT is non-nil and the user inputs something while the -function is waiting, then any future replies to the request by the -remote endpoint (normal or error) are ignored and the function exits -returning CANCEL-ON-INPUT-RETVAL. If CANCEL-ON-INPUT is a function, it -is invoked with one argument, an integer identifying the canceled -request as specified in the JSONRPC 2.0 spec." +function is waiting, the function locally exits immediately returning +CANCEL-ON-INPUT-RETVAL. Any future replies to the request coming from +the remote endpoint (normal or error) are ignored. If CANCEL-ON-INPUT +is a function, it is invoked with one argument, an integer identifying +the canceled request as specified in the JSONRPC 2.0 spec. Callers may +use this function to issue a cancel notification to the endpoint, thus +preventing it from continuing to work on the now-cancelled request." (let* ((tag (funcall (if (fboundp 'gensym) 'gensym 'cl-gensym) "jsonrpc-request-catch-tag")) id-and-timer @@ -465,10 +469,11 @@ request as specified in the JSONRPC 2.0 spec." (cadr retval))) (cl-defun jsonrpc-notify (connection method params) - "Notify CONNECTION of something, don't expect a reply." - (jsonrpc-connection-send connection - :method method - :params params)) + "Notify CONNECTION of something, don't expect a reply. +CONNECTION, METHOD and PARAMS as in `jsonrpc-async-request' (which see)." + (apply #'jsonrpc-connection-send connection + :method method + (unless (eq params :jsonrpc-omit) `(:params ,params)))) (define-obsolete-variable-alias 'jrpc-default-request-timeout 'jsonrpc-default-request-timeout "28.1") @@ -933,10 +938,10 @@ TIMEOUT is nil)." (cl-return-from jsonrpc--async-request-1 (list id timer)))) ;; Really send it thru the wire ;; - (jsonrpc-connection-send connection - :id id - :method method - :params params) + (apply #'jsonrpc-connection-send connection + :id id + :method method + (unless (eq params :jsonrpc-omit) `(:params ,params))) ;; Setup some control structures ;; (when sync-request commit ac78b945d5af14fa6cb311ebbae1248baa33a541 Author: Juri Linkov Date: Thu Oct 23 19:28:14 2025 +0300 * doc/lispref/display.texi (Display Margins): Remove obsolete remark. Text and images in the margin were made mouse-sensitive long ago. https://lists.gnu.org/archive/html/emacs-devel/2025-10/msg00596.html diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 9e83e4a9bcc..eb3f7fd5feb 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5816,8 +5816,7 @@ something changed since the last display cycle. A buffer can have blank areas called @dfn{display margins} on the left and on the right. Ordinary text never appears in these areas, but you can put things into the display margins using the -@code{display} property. There is currently no way to make text or -images in the margin mouse-sensitive. +@code{display} property. The way to display something in the margins is to specify it in a margin display specification in the @code{display} property of some commit c2b23a04c239317d42a47eba7ad50e9c102ad2f8 Author: Mattias Engdegård Date: Thu Oct 23 13:49:57 2025 +0200 Sink calls to byte-compile-warning-enabled-p * lisp/emacs-lisp/bytecomp.el (byte-compile--check-arity-bytecode) (byte-compile-warn-about-unresolved-functions, byte-compile-form) (byte-compile-free-vars-warn): Delay checking whether a warning is enabled until we are about to emit such a warning, since most warnings are enabled most of the time but finding something to warn about is rare. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7cb944e3b08..2b2740479c6 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1581,8 +1581,7 @@ when printing the error message." (defun byte-compile--check-arity-bytecode (form bytecode) "Check that the call in FORM matches that allowed by BYTECODE." - (when (and (byte-code-function-p bytecode) - (byte-compile-warning-enabled-p 'callargs)) + (when (byte-code-function-p bytecode) (let* ((actual-args (length (cdr form))) (arity (func-arity bytecode)) (min-args (car arity)) @@ -1883,18 +1882,19 @@ It is too wide if it has any lines longer than the largest of ;; defined, issue a warning enumerating them. ;; `unresolved' in the list `byte-compile-warnings' disables this. (defun byte-compile-warn-about-unresolved-functions () - (when (byte-compile-warning-enabled-p 'unresolved) - (let ((byte-compile-current-form :end)) - ;; Separate the functions that will not be available at runtime - ;; from the truly unresolved ones. - (dolist (urf byte-compile-unresolved-functions) - (let ((f (car urf))) - (when (not (memq f byte-compile-new-defuns)) - (byte-compile-warn-x - f - (if (fboundp f) "the function `%s' might not be defined at runtime." "the function `%s' is not known to be defined.") - (car urf))))))) - nil) + (let ((byte-compile-current-form :end)) + ;; Separate the functions that will not be available at runtime + ;; from the truly unresolved ones. + (dolist (urf byte-compile-unresolved-functions) + (let ((f (car urf))) + (when (and (not (memq f byte-compile-new-defuns)) + (byte-compile-warning-enabled-p 'unresolved)) + (byte-compile-warn-x + f + (if (fboundp f) + "the function `%s' might not be defined at runtime." + "the function `%s' is not known to be defined.") + (car urf))))))) ;; Dynamically bound in byte-compile-from-buffer. @@ -3428,11 +3428,11 @@ lambda-expression." (let ((hook (car-safe (cdr form)))) (if (eq (car-safe hook) 'quote) (byte-compile-check-variable (cadr hook) nil)))) - (when (and (byte-compile-warning-enabled-p 'suspicious) - (macroexp--const-symbol-p fn)) + (when (and (macroexp--const-symbol-p fn) + (byte-compile-warning-enabled-p 'suspicious)) (byte-compile-warn-x fn "`%s' called as a function" fn)) - (when (and (byte-compile-warning-enabled-p 'interactive-only fn) - interactive-only) + (when (and interactive-only + (byte-compile-warning-enabled-p 'interactive-only fn)) (byte-compile-warn-x fn "`%s' is for interactive use only%s" fn (cond ((stringp interactive-only) @@ -3842,12 +3842,12 @@ VAR must not be lexically bound. ARG is a position argument, used by `byte-compile-warn-x'. If optional argument ASSIGNMENT is non-nil, this is treated as an assignment (i.e. `setq')." - (unless (or (not (byte-compile-warning-enabled-p 'free-vars var)) - (boundp var) + (unless (or (boundp var) (memq var byte-compile-bound-variables) (memq var (if assignment byte-compile-free-assignments - byte-compile-free-references))) + byte-compile-free-references)) + (not (byte-compile-warning-enabled-p 'free-vars var))) (let* ((varname (prin1-to-string var)) (desc (if assignment "assignment" "reference")) (suggestions (help-uni-confusable-suggestions varname))) commit a78bf76fb9748bc62f275bb95502aef0b3d6c637 Author: Martin Rudalics Date: Thu Oct 23 16:38:25 2025 +0200 Revert recent additions of 'split-frame' and 'merge-frames' * lisp/window-x.el (merge-frames, split-frame): Remove. * doc/lispref/windows.texi (Changing Window Layouts): Remove sections on 'split-frame' and 'merge-frames'. * etc/NEWS: Remove announcement of 'split-frame' and 'merge-frames'. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 01baf742cd7..1611ecb7389 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2453,52 +2453,6 @@ selected window will change to the window that appears at the location of the selected window before any of these commands were invoked. @end defopt -The next command allows to split the window layout of a frame and move -the resulting parts to one or several new frames. - -@cindex split window layout -@cindex split frame -@deffn Command split-frame &optional arg frame -This commands splits the window layout of @var{frame} which must be a -live frame and defaults to the selected one. It moves the resulting -parts into one or several new frames and returns these frames. - -If the optional argument @var{arg} is @code{nil}, it makes a new frame -whose root window occupies approximately one half of @var{frame}'s -original estate. If @var{arg} is a number, it creates @var{arg} - 1 new -frames and puts any child window of the main window of @var{frame} into -one of these frames. As a special case, if @var{arg} equals 1, it makes -one new frame containing all children but the first of the main window -of @var{frame}. With a non-numeric prefix @var{arg}, it tries to put -all children of @var{frame}'s main window but the first into a new -frame. Interactively, @var{arg} is the prefix argument. - -Note that any window put on a new frame is a clone (@pxref{Window -Configurations}) of the original window and the original window is -deleted. -@end deffn - -The effect of @code{split-frame} can be undone with the following -command which merges the window layout of one frame into the layout of -another. - -@cindex merge window layouts -@cindex merge frames -@deffn Command merge-frames &optional vertical frame1 frame2 -This commands merges the window layout of @var{frame2} into that of -@var{frame1}. For this purpose, it splits the root window of -@var{frame1} and makes the new window display the root window of -@var{frame2}. Both @var{frame1} and @var{frame2} must be distinct, live -frames where @var{frame1} defaults to the selected frame and -@var{frame2} to the frame following @var{frame1} in the frame list. -@var{frame2} gets deleted if its windows have been merged successfully. - -If @var{vertical} is non-@code{nil}, this makes the new window appear -below the old main window of @var{frame1}. Otherwise, it makes the new -window on the right of @var{frame1}'s main window. Interactively, -@var{vertical} is the prefix argument. -@end deffn - @node Cyclic Window Ordering @section Cyclic Ordering of Windows diff --git a/etc/NEWS b/etc/NEWS index 8ddc9fe3407..f61825f531b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -420,12 +420,6 @@ adjacent windows and subsequently operate on that parent. 'uncombine-window' can then be used to restore the window configuration to the state it had before running 'combine-windows'. -+++ -*** New commands 'split-frame' and 'merge-frames'. -These commands allow splitting the window layout of an existing frame -into several frames, and merging the window layouts of two existing -frames into one frame, respectively. - ** Frames +++ diff --git a/lisp/window-x.el b/lisp/window-x.el index 4220e0d2880..37344e9101a 100644 --- a/lisp/window-x.el +++ b/lisp/window-x.el @@ -313,121 +313,7 @@ ones in `window--transpose'." (let ((is-atom (memq (cadr (cadr (cddddr subtree))) atom-windows))) (window--transpose-1 (car (cddddr subtree)) cwin (if is-atom '(nil . t) conf) - no-resize atom-windows))))) - -;;;###autoload -(defun merge-frames (&optional vertical frame1 frame2) - "Merge FRAME2 into FRAME1. -Split the root window of FRAME1 and make the new window display the root -window of FRAME2. Both FRAME1 and FRAME2 must be distinct, live frames -where FRAME1 defaults to the selected frame and FRAME2 to the frame -following FRAME1 in the frame list. Delete FRAME2 if it has been merged -successfully. - -If VERTICAL is non-nil, make the new window below the old main window -of FRAME1. Otherwise, make the new window on the right of FRAME1's main -window. Interactively, VERTICAL is the prefix argument, FRAME1 is the -selected frame and FRAME2 is the frame following FRAME1 in the frame -list." - (interactive "P") - (let* ((frame1 (window-normalize-frame frame1)) - (frame2 (if frame2 - (window-normalize-frame frame2) - (next-frame frame1)))) - (if (eq frame1 frame2) - (user-error "Cannot merge frame into itself") - (window-state-put - ;; Source window on frame2. - (window-state-get (window-main-window frame2)) - ;; Make new window on frame1. - (split-window (window-main-window frame1) nil (not vertical))) - (delete-frame frame2) - frame1))) - -;;;###autoload -(defun split-frame (&optional arg frame) - "Split FRAME. -FRAME must be a live frame and defaults to the selected frame. - -Interactively, ARG is the prefix argument. If ARG is nil, make a new -frame whose root window occupies approximately one half of FRAME's -original estate. If ARG is a number, make ARG - 1 new frames and put -any child window of the main window of FRAME into one of these frames. -As a special case, if ARG equals 1, make one new frame containing all -children but the first of the main window of FRAME. With a non-numeric -prefix ARG, try to put all children of FRAME's main window but the first -into a new frame. In either case, any window put on a new frame is a -clone of the original window and the original window is deleted." - (interactive "P") - (let* ((mw (window-main-window frame)) - (first-child (window-child mw)) - (nwindows (window-child-count mw))) - (cond - ((<= nwindows 1) - (user-error "Cannot split a one-window frame")) - ;; One frame for each window. - ((or (eq nwindows 2) (and arg (not (numberp arg)))) - (let ((sib (window-next-sibling first-child)) - frames) - (while sib - (let* ((state (window-state-get sib)) - (frame (make-frame)) - (next-sib (window-next-sibling sib))) - (push frame frames) - (window-state-put state (window-main-window frame)) - (delete-window sib) - (setq sib next-sib))) - frames)) - ;; Two windows. - ((eq 1 arg) - (let* ((snd-sib (window-next-sibling first-child)) - (sib (combine-windows snd-sib (window-last-child mw))) - (state (window-state-get sib)) - (frame (make-frame))) - (window-state-put state (window-main-window frame)) - (delete-window sib) - frame)) - ;; Smart window splitting. - (t - (let ((nframes (or arg 2))) - (when (< nwindows nframes) - (user-error "%i frames cannot be made from %i windows" arg nwindows)) - (let* ((horizontal (window-combined-p first-child t)) - (ideal (/ (window-size mw horizontal) nframes)) - (current-window first-child) - (sum (window-size current-window horizontal)) - (windows (list (list first-child))) - frames) - ;; Need to come up with the inital windows split using sliding - ;; sum technique. - (while (setq current-window (window-next-sibling current-window)) - (setq sum (seq-reduce '+ (mapcar - (lambda (w) - (window-size w horizontal)) - (car (last windows))) - 0)) - (let ((remaining-frames (- nframes (length windows))) - (remaining-windows - (- nwindows (seq-reduce '+ (mapcar 'length windows) 0)))) - (if (or (= remaining-windows remaining-frames) - ;; HACK ALERT! - (>= sum (* ideal 0.85))) - (progn - (setq sum 0) - (nconc windows (list (list current-window)))) - (nconc (car (last windows)) (list current-window))))) - (when (cdar windows) - (combine-windows (caar windows) (car (last (car windows))))) - (dolist (wls (cdr windows) frames) - (let* ((cwin (if (cdr wls) - (combine-windows (car wls) (car (last wls))) - (car wls))) - (state (window-state-get cwin)) - (frame (make-frame))) - (push frame frames) - (delete-window cwin) - (window-state-put state (window-main-window frame)))))))))) + no-resize atom-windows))))) (provide 'window-x) - ;;; window-x.el ends here commit a8c4f06a8e9f6fee28d44066e92165596d37a707 Author: Robert Pluim Date: Thu Oct 23 11:44:00 2025 +0200 ; * etc/NEWS: Fix typo. diff --git a/etc/NEWS b/etc/NEWS index 51e5091808b..8ddc9fe3407 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -422,7 +422,7 @@ to the state it had before running 'combine-windows'. +++ *** New commands 'split-frame' and 'merge-frames'. -These commands allow spliting the window layout of an existing frame +These commands allow splitting the window layout of an existing frame into several frames, and merging the window layouts of two existing frames into one frame, respectively. commit 1cbc6c2f17a3bdd4f87ddd97882f7cfd8e13e1a4 Author: Robert Pluim Date: Thu Oct 23 11:38:47 2025 +0200 ; * etc/NEWS: Grammar fix. diff --git a/etc/NEWS b/etc/NEWS index 03f3af16177..51e5091808b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -422,9 +422,9 @@ to the state it had before running 'combine-windows'. +++ *** New commands 'split-frame' and 'merge-frames'. -These commands allow to split the window layout of an existing frame -into several frames and to merge the window layouts of two existing -frames into one frame. +These commands allow spliting the window layout of an existing frame +into several frames, and merging the window layouts of two existing +frames into one frame, respectively. ** Frames commit 3b8cec55c4631056df5512635ee9a66e5f51a438 Author: Martin Rudalics Date: Thu Oct 23 11:14:03 2025 +0200 Document and announce 'split-frame' and 'merge-frames' * lisp/window-x.el (merge-frames): Rewrite doc-string. Error out when FRAME1 and FRAME2 are not distinct frames. (split-frame): Rewrite doc-string. Use 'user-error' instead of 'error'. * doc/lispref/windows.texi (Changing Window Layouts): Document 'split-frame' and 'merge-frames'. * etc/NEWS: Announce 'split-frame' and 'merge-frames'. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 1611ecb7389..01baf742cd7 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2453,6 +2453,52 @@ selected window will change to the window that appears at the location of the selected window before any of these commands were invoked. @end defopt +The next command allows to split the window layout of a frame and move +the resulting parts to one or several new frames. + +@cindex split window layout +@cindex split frame +@deffn Command split-frame &optional arg frame +This commands splits the window layout of @var{frame} which must be a +live frame and defaults to the selected one. It moves the resulting +parts into one or several new frames and returns these frames. + +If the optional argument @var{arg} is @code{nil}, it makes a new frame +whose root window occupies approximately one half of @var{frame}'s +original estate. If @var{arg} is a number, it creates @var{arg} - 1 new +frames and puts any child window of the main window of @var{frame} into +one of these frames. As a special case, if @var{arg} equals 1, it makes +one new frame containing all children but the first of the main window +of @var{frame}. With a non-numeric prefix @var{arg}, it tries to put +all children of @var{frame}'s main window but the first into a new +frame. Interactively, @var{arg} is the prefix argument. + +Note that any window put on a new frame is a clone (@pxref{Window +Configurations}) of the original window and the original window is +deleted. +@end deffn + +The effect of @code{split-frame} can be undone with the following +command which merges the window layout of one frame into the layout of +another. + +@cindex merge window layouts +@cindex merge frames +@deffn Command merge-frames &optional vertical frame1 frame2 +This commands merges the window layout of @var{frame2} into that of +@var{frame1}. For this purpose, it splits the root window of +@var{frame1} and makes the new window display the root window of +@var{frame2}. Both @var{frame1} and @var{frame2} must be distinct, live +frames where @var{frame1} defaults to the selected frame and +@var{frame2} to the frame following @var{frame1} in the frame list. +@var{frame2} gets deleted if its windows have been merged successfully. + +If @var{vertical} is non-@code{nil}, this makes the new window appear +below the old main window of @var{frame1}. Otherwise, it makes the new +window on the right of @var{frame1}'s main window. Interactively, +@var{vertical} is the prefix argument. +@end deffn + @node Cyclic Window Ordering @section Cyclic Ordering of Windows diff --git a/etc/NEWS b/etc/NEWS index f61825f531b..03f3af16177 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -420,6 +420,12 @@ adjacent windows and subsequently operate on that parent. 'uncombine-window' can then be used to restore the window configuration to the state it had before running 'combine-windows'. ++++ +*** New commands 'split-frame' and 'merge-frames'. +These commands allow to split the window layout of an existing frame +into several frames and to merge the window layouts of two existing +frames into one frame. + ** Frames +++ diff --git a/lisp/window-x.el b/lisp/window-x.el index 12f459fafd3..4220e0d2880 100644 --- a/lisp/window-x.el +++ b/lisp/window-x.el @@ -319,9 +319,13 @@ ones in `window--transpose'." (defun merge-frames (&optional vertical frame1 frame2) "Merge FRAME2 into FRAME1. Split the root window of FRAME1 and make the new window display the root -window of FRAME2. Both FRAME1 and FRAME2 must be live frames. If -VERTICAL is non-nil, make the new window below the old root window of -FRAME1. Otherwise, make the new window on the right of FRAME1's root +window of FRAME2. Both FRAME1 and FRAME2 must be distinct, live frames +where FRAME1 defaults to the selected frame and FRAME2 to the frame +following FRAME1 in the frame list. Delete FRAME2 if it has been merged +successfully. + +If VERTICAL is non-nil, make the new window below the old main window +of FRAME1. Otherwise, make the new window on the right of FRAME1's main window. Interactively, VERTICAL is the prefix argument, FRAME1 is the selected frame and FRAME2 is the frame following FRAME1 in the frame list." @@ -330,34 +334,37 @@ list." (frame2 (if frame2 (window-normalize-frame frame2) (next-frame frame1)))) - (window-state-put - ;; Source window on frame2. - (window-state-get (window-main-window frame2)) - ;; Make new window on frame1. - (split-window (window-main-window frame1) nil (null vertical))) - (delete-frame frame2) - frame1)) + (if (eq frame1 frame2) + (user-error "Cannot merge frame into itself") + (window-state-put + ;; Source window on frame2. + (window-state-get (window-main-window frame2)) + ;; Make new window on frame1. + (split-window (window-main-window frame1) nil (not vertical))) + (delete-frame frame2) + frame1))) ;;;###autoload (defun split-frame (&optional arg frame) "Split FRAME. -FRAME must be a live frame and defaults to the selected one. - -Interactively, ARG is the prefix argument. If ARG is a number, make ARG -- 1 new frames and put any child window of the main window of FRAME into -one of these frames. As a special case, if ARG equals 1, make one new -frame containing all children but the first of the root window of FRAME. -With a non-numeric prefix ARG, try to put all children of FRAME's main -window but the first into a new frame. In either case, any window put -on a new frame is a clone of the original window and the original window -is deleted." +FRAME must be a live frame and defaults to the selected frame. + +Interactively, ARG is the prefix argument. If ARG is nil, make a new +frame whose root window occupies approximately one half of FRAME's +original estate. If ARG is a number, make ARG - 1 new frames and put +any child window of the main window of FRAME into one of these frames. +As a special case, if ARG equals 1, make one new frame containing all +children but the first of the main window of FRAME. With a non-numeric +prefix ARG, try to put all children of FRAME's main window but the first +into a new frame. In either case, any window put on a new frame is a +clone of the original window and the original window is deleted." (interactive "P") (let* ((mw (window-main-window frame)) (first-child (window-child mw)) (nwindows (window-child-count mw))) (cond - ((or (<= nwindows 1)) - (error "Cannot split a one-window frame")) + ((<= nwindows 1) + (user-error "Cannot split a one-window frame")) ;; One frame for each window. ((or (eq nwindows 2) (and arg (not (numberp arg)))) (let ((sib (window-next-sibling first-child)) @@ -384,7 +391,7 @@ is deleted." (t (let ((nframes (or arg 2))) (when (< nwindows nframes) - (error "%i frames cannot be made from %i windows" arg nwindows)) + (user-error "%i frames cannot be made from %i windows" arg nwindows)) (let* ((horizontal (window-combined-p first-child t)) (ideal (/ (window-size mw horizontal) nframes)) (current-window first-child) commit db6ac3c5f4ae3723f5772134d75b2625854e342d Author: Pranshu Sharma Date: Thu Oct 23 10:04:39 2025 +0200 New commands to split and merge frames * lisp/window-x.el (merge-frames, split-frame): New commands. diff --git a/lisp/window-x.el b/lisp/window-x.el index 37344e9101a..12f459fafd3 100644 --- a/lisp/window-x.el +++ b/lisp/window-x.el @@ -313,7 +313,114 @@ ones in `window--transpose'." (let ((is-atom (memq (cadr (cadr (cddddr subtree))) atom-windows))) (window--transpose-1 (car (cddddr subtree)) cwin (if is-atom '(nil . t) conf) - no-resize atom-windows))))) + no-resize atom-windows))))) + +;;;###autoload +(defun merge-frames (&optional vertical frame1 frame2) + "Merge FRAME2 into FRAME1. +Split the root window of FRAME1 and make the new window display the root +window of FRAME2. Both FRAME1 and FRAME2 must be live frames. If +VERTICAL is non-nil, make the new window below the old root window of +FRAME1. Otherwise, make the new window on the right of FRAME1's root +window. Interactively, VERTICAL is the prefix argument, FRAME1 is the +selected frame and FRAME2 is the frame following FRAME1 in the frame +list." + (interactive "P") + (let* ((frame1 (window-normalize-frame frame1)) + (frame2 (if frame2 + (window-normalize-frame frame2) + (next-frame frame1)))) + (window-state-put + ;; Source window on frame2. + (window-state-get (window-main-window frame2)) + ;; Make new window on frame1. + (split-window (window-main-window frame1) nil (null vertical))) + (delete-frame frame2) + frame1)) + +;;;###autoload +(defun split-frame (&optional arg frame) + "Split FRAME. +FRAME must be a live frame and defaults to the selected one. + +Interactively, ARG is the prefix argument. If ARG is a number, make ARG +- 1 new frames and put any child window of the main window of FRAME into +one of these frames. As a special case, if ARG equals 1, make one new +frame containing all children but the first of the root window of FRAME. +With a non-numeric prefix ARG, try to put all children of FRAME's main +window but the first into a new frame. In either case, any window put +on a new frame is a clone of the original window and the original window +is deleted." + (interactive "P") + (let* ((mw (window-main-window frame)) + (first-child (window-child mw)) + (nwindows (window-child-count mw))) + (cond + ((or (<= nwindows 1)) + (error "Cannot split a one-window frame")) + ;; One frame for each window. + ((or (eq nwindows 2) (and arg (not (numberp arg)))) + (let ((sib (window-next-sibling first-child)) + frames) + (while sib + (let* ((state (window-state-get sib)) + (frame (make-frame)) + (next-sib (window-next-sibling sib))) + (push frame frames) + (window-state-put state (window-main-window frame)) + (delete-window sib) + (setq sib next-sib))) + frames)) + ;; Two windows. + ((eq 1 arg) + (let* ((snd-sib (window-next-sibling first-child)) + (sib (combine-windows snd-sib (window-last-child mw))) + (state (window-state-get sib)) + (frame (make-frame))) + (window-state-put state (window-main-window frame)) + (delete-window sib) + frame)) + ;; Smart window splitting. + (t + (let ((nframes (or arg 2))) + (when (< nwindows nframes) + (error "%i frames cannot be made from %i windows" arg nwindows)) + (let* ((horizontal (window-combined-p first-child t)) + (ideal (/ (window-size mw horizontal) nframes)) + (current-window first-child) + (sum (window-size current-window horizontal)) + (windows (list (list first-child))) + frames) + ;; Need to come up with the inital windows split using sliding + ;; sum technique. + (while (setq current-window (window-next-sibling current-window)) + (setq sum (seq-reduce '+ (mapcar + (lambda (w) + (window-size w horizontal)) + (car (last windows))) + 0)) + (let ((remaining-frames (- nframes (length windows))) + (remaining-windows + (- nwindows (seq-reduce '+ (mapcar 'length windows) 0)))) + (if (or (= remaining-windows remaining-frames) + ;; HACK ALERT! + (>= sum (* ideal 0.85))) + (progn + (setq sum 0) + (nconc windows (list (list current-window)))) + (nconc (car (last windows)) (list current-window))))) + (when (cdar windows) + (combine-windows (caar windows) (car (last (car windows))))) + (dolist (wls (cdr windows) frames) + (let* ((cwin (if (cdr wls) + (combine-windows (car wls) (car (last wls))) + (car wls))) + (state (window-state-get cwin)) + (frame (make-frame))) + (push frame frames) + (delete-window cwin) + (window-state-put state (window-main-window frame)))))))))) (provide 'window-x) + ;;; window-x.el ends here diff --git a/src/pdumper.c b/src/pdumper.c index 4fa9c917124..876065929e0 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2072,7 +2072,7 @@ dump_interval_tree (struct dump_context *ctx, static dump_off dump_string (struct dump_context *ctx, const struct Lisp_String *string) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_String_03B2DF1C8E) +#if CHECK_STRUCTS && !defined (HASH_Lisp_String_B71C8876EB) # error "Lisp_String changed. See CHECK_STRUCTS comment in config.h." #endif /* If we have text properties, write them _after_ the string so that commit 8fc068a15d7d89955731f858c529020574840e36 Author: Eli Zaretskii Date: Thu Oct 23 07:46:12 2025 +0300 ; Fix a recent documentation change * doc/lispref/customize.texi (Variable Definitions): Restore description of 'custom-initialize-delay'. Fix indexing. diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index 170bdc5e42c..2d124bd7e8d 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -354,8 +354,8 @@ values are legitimate, and how to display the value (@pxref{Customization Types}). Every @code{defcustom} should specify a value for this keyword. -@item :options @var{value-list} @kindex options@r{, @code{defcustom} keyword} +@item :options @var{value-list} Specify the list of reasonable values for use in this option. The user is not restricted to using only these values, but they are offered as convenient alternatives. @@ -368,8 +368,8 @@ Re-evaluating a @code{defcustom} form with a different @code{:options} value does not clear the values added by previous evaluations, or added by calls to @code{custom-add-frequent-value} (see below). -@item :set @var{setfunction} @kindex set@r{, @code{defcustom} keyword} +@item :set @var{setfunction} Specify @var{setfunction} as the way to change the value of this option when using the Customize interface. The function @var{setfunction} should take two arguments, a symbol (the option @@ -389,8 +389,8 @@ should describe how to do the same job in hand-written Lisp code, either by invoking @var{setfunction} directly or by using @code{setopt}. -@item :get @var{getfunction} @kindex get@r{, @code{defcustom} keyword} +@item :get @var{getfunction} Specify @var{getfunction} as the way to extract the value of this option. The function @var{getfunction} should take one argument, a symbol, and should return whatever customize should use as the @@ -403,8 +403,8 @@ Custom as variables but are not actually stored in Lisp variables. It is almost surely a mistake to specify @var{getfunction} for a value that really is stored in a Lisp variable. -@item :initialize @var{function} @kindex initialize@r{, @code{defcustom} keyword} +@item :initialize @var{function} @var{function} should be a function used to initialize the variable when the @code{defcustom} is evaluated. It should take two arguments, the option name (a symbol) and the value. Here are some predefined @@ -440,10 +440,18 @@ delays the actual initialization until after the containing file is loaded. This can be useful to break the common dependency where the setter is (or uses) a function which needs to be defined after the variable, such as when a global minor mode has a non-@code{nil} @code{:init-value}. + +@item custom-initialize-delay +This function behaves like @code{custom-initialize-set}, but it delays +the actual initialization to the next Emacs start. This should be used +in Lisp files that are preloaded (loaded when Emacs is built), when it +is important to ensure that the initialization is performed in the +run-time context (which could be on a different system or programming +environment). @xref{Building Emacs, custom-initialize-delay}. @end table -@item :local @var{value} @kindex local@r{, @code{defcustom} keyword} +@item :local @var{value} If the @var{value} is @code{t}, mark @var{option} as automatically buffer-local; if the value is @code{permanent}, also set @var{option}s @code{permanent-local} property to @code{t}. Finally, if the value is @@ -451,18 +459,18 @@ buffer-local; if the value is @code{permanent}, also set @var{option}s to @code{t} without marking it as automatically buffer-local. @xref{Creating Buffer-Local}. -@item :risky @var{value} @kindex risky@r{, @code{defcustom} keyword} +@item :risky @var{value} Set the variable's @code{risky-local-variable} property to @var{value} (@pxref{File Local Variables}). -@item :safe @var{function} @kindex safe@r{, @code{defcustom} keyword} +@item :safe @var{function} Set the variable's @code{safe-local-variable} property to @var{function} (@pxref{File Local Variables}). -@item :set-after @var{variables} @kindex set-after@r{, @code{defcustom} keyword} +@item :set-after @var{variables} When setting variables according to saved customizations, make sure to set the variables @var{variables} before this one; i.e., delay setting this variable until after those others have been handled. Use commit 953d1db6ba26e730b0a3ec667e0ba36739800990 Author: Stephen Gildea Date: Wed Oct 22 21:16:54 2025 -0700 time-stamp-format-* tests: reduce repetitiveness * test/lisp/time-stamp-tests.el (time-stamp-test): New macro. Use it to coalesce the repetitive lines of the various time-stamp-format-* tests, reducing the line count of the time-stamp-string formatting tests by 30%. diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el index 7f0c7d7f511..45593db0ed6 100644 --- a/test/lisp/time-stamp-tests.el +++ b/test/lisp/time-stamp-tests.el @@ -333,456 +333,313 @@ ;;; Tests of time-stamp-string formatting -(ert-deftest time-stamp-format-day-of-week () - "Test `time-stamp' formats for named day of week." +(eval-and-compile ;utility functions used by macros + +(defun time-stamp-test--to-unquoted-list (object) + (let ((unquote (lambda (object) + (cond ((memq (car-safe object) '(function quote)) + (cadr object)) + (t object))))) + (setq object (funcall unquote object)) + (when (or (stringp object) + (and object (symbolp object))) + (setq object (list object))) + (mapcar unquote object))) + +(defun time-stamp-test-1 (formats expected &rest filter-fns) + "Generate a form that tests with time-stamp-format FORMATS. +Must be called from within `with-time-stamp-test-env'. +FORMATS is a string or a list of strings. +EXPECTED is a string and is run through `format-time-string' for +each of test environment times ref-time1, ref-time2 and ref-time3, +respectively (unless FILTER-FNS contains :literal, see below). +Optional FILTER-FNS is a list of functions to modify the expected +conversion; the functions are composed left to right. +FILTER-FNS may contain the element :warn to say that this test should +output a time-stamp compatibility warning, or the element :literal to +say EXPECTED should not be run through `format-time-string'." + (let* ((format-list (time-stamp-test--to-unquoted-list formats)) + (filter-list (time-stamp-test--to-unquoted-list filter-fns)) + (literal nil) + (should-fn 'should) + (do-one (lambda (conv expected reftime) + `(,should-fn + (time-stamp-test--string-equal + (time-stamp-string ,conv ,reftime) + ,(let ((fmt-form + (if literal + expected + `(format-time-string + ,expected ,reftime time-stamp-time-zone)))) + (dolist (fn filter-list fmt-form) + (setq fmt-form `(funcall ',fn ,fmt-form)))) + )))) + (result (list 'progn))) + (when (memq :literal filter-list) + (setq literal t) + (setq filter-list (delq :literal filter-list))) + (when (memq :warn filter-list) + (setq should-fn 'time-stamp-should-warn) + (setq filter-list (delq :warn filter-list))) + (dolist (f1 format-list result) + (nconc result + (list (funcall do-one f1 expected 'ref-time1)) + (unless literal (list (funcall do-one f1 expected 'ref-time2))) + (unless literal (list (funcall do-one f1 expected 'ref-time3))))))) + +(defun time-stamp-test--a-to-b (string) + "In STRING, replace \"a\" and \"A\" with \"b\" and \"B\", respectively." + (string-replace "a" "b" (string-replace "A" "B" string))) + +) ; end eval-and-compile + + +(defmacro time-stamp-test (formats expected &rest filter-fns) + (declare (debug (&rest sexp))) + (apply #'time-stamp-test-1 formats expected filter-fns)) + +(defmacro time-stamp-test-AB (formats expected &rest filter-fns) + "Test FORMATS, %A variations. +The given conversion(s) are tested, and also the equivalent %B conversion(s)." + (declare (debug (&rest sexp))) + `(progn + ,(apply #'time-stamp-test-1 + formats expected filter-fns) + ,(apply #'time-stamp-test-1 + (mapcar #'time-stamp-test--a-to-b + (time-stamp-test--to-unquoted-list formats)) + (time-stamp-test--a-to-b expected) + filter-fns))) + +(defmacro time-stamp-test-dmHIMS (formats expected &rest filter-fns) + "Test FORMATS, %d variations. +The given conversion(s) are tested, and also the other 2-digit conversion(s)." + (declare (debug (&rest sexp))) + (let ((result (list 'progn + (apply #'time-stamp-test-1 + formats expected filter-fns)))) + (dolist (letter '("m" "H" "I" "M" "S") result) + (nconc result + (list (apply #'time-stamp-test-1 + (mapcar (lambda (str) (string-replace "d" letter str)) + (time-stamp-test--to-unquoted-list formats)) + (string-replace "d" letter expected) + filter-fns)))))) + + +(defun time-stamp-test--string-equal (string1 string2) + "Compare strings with `compare-strings'. +Use `compare-strings' instead of `string-equal' +because `compare-strings' handles the case +where one string is multibyte and the other unibyte. +This is a separate function so it can have an `ert-explainer' property." + (eq t (compare-strings string1 nil nil + string2 nil nil))) + +(put 'time-stamp-test--string-equal 'ert-explainer + (get 'string-equal 'ert-explainer)) + +(defun formatz-mod-pad-l4 (string) + "Return STRING padded on the left to 4 characters." + (time-stamp-test--pad-left-to-string-width string 4)) + +(defun formatz-mod-pad-l10 (string) + "Return STRING padded on the left to 10 characters." + (time-stamp-test--pad-left-to-string-width string 10)) + +(defun time-stamp-test--pad-left-to-string-width (string width) + "Return STRING padded on the left to string-width WIDTH." + (let ((needed-padding (- width (string-width string)))) + (if (> needed-padding 0) + (concat (make-string needed-padding ?\s) string) + string))) + + +(ert-deftest time-stamp-format-word-conversions () + "Test `time-stamp' formats for %A and %B conversions." (with-time-stamp-test-env - (let* ((Mon (format-time-string "%a" ref-time1 t)) - (MON (format-time-string "%^a" ref-time1 t)) - (mon (downcase (format-time-string "%a" ref-time1 t))) - (Mon-tc (capitalize (format-time-string "%a" ref-time1 t))) - (Monday (format-time-string "%A" ref-time1 t)) - (MONDAY (format-time-string "%^A" ref-time1 t)) - (monday (downcase (format-time-string "%A" ref-time1 t))) - (Monday-tc (capitalize (format-time-string "%A" ref-time1 t))) - (p4-Mon (string-pad Mon 4 ?\s t)) - (p4-MON (string-pad MON 4 ?\s t)) - (p10-Monday (string-pad Monday 10 ?\s t)) - (p10-MONDAY (string-pad MONDAY 10 ?\s t))) ;; implemented and recommended since 1997 - (should (equal (time-stamp-string "%#A" ref-time1) MONDAY)) - (should (equal (time-stamp-string "%#10A" ref-time1) p10-MONDAY)) + (time-stamp-test-AB "%#A" "%^A") + (time-stamp-test-AB "%#10A" "%^A" #'formatz-mod-pad-l10) ;; implemented since 1997, recommended 1997-2024 - (should (equal (time-stamp-string "%3a" ref-time1) Mon)) + (time-stamp-test-AB "%3a" "%a") ;; recommended 1997-2019 - (should (equal (time-stamp-string "%:a" ref-time1) Monday)) + (time-stamp-test-AB "%:a" "%A") ;; recommended 1997-2019, warned since 2024, will change - (time-stamp-should-warn - (equal (time-stamp-string "%3A" ref-time1) MON)) - (time-stamp-should-warn - (equal (time-stamp-string "%10A" ref-time1) p10-MONDAY)) + (time-stamp-test-AB "%3A" "%^a" :warn) + (time-stamp-test-AB "%10A" "%^A" #'formatz-mod-pad-l10 :warn) ;; implemented since 2001, recommended since 2019 - (should (equal (time-stamp-string "%#a" ref-time1) MON)) - (should (equal (time-stamp-string "%#3a" ref-time1) MON)) - (should (equal (time-stamp-string "%#4a" ref-time1) p4-MON)) + (time-stamp-test-AB ("%#a" "%#3a") "%^a") + (time-stamp-test-AB "%#4a" "%^a" #'formatz-mod-pad-l4) ;; implemented since 2001, recommended 2019-2024 - (should (equal (time-stamp-string "%:A" ref-time1) Monday)) + (time-stamp-test-AB "%:A" "%A") ;; broken 2019-2024 - (should (equal (time-stamp-string "%:10A" ref-time1) p10-Monday)) + (time-stamp-test-AB "%:10A" "%A" #'formatz-mod-pad-l10) ;; broken in 2019, changed in 2024 - (should (equal (time-stamp-string "%-A" ref-time1) Monday)) - (should (equal (time-stamp-string "%_A" ref-time1) Monday)) + (time-stamp-test-AB ("%-A" "%_A") "%A") ;; warned 1997-2019, changed in 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%a" ref-time1) Mon)) - (should (equal (time-stamp-string "%4a" ref-time1) p4-Mon)) - (should (equal (time-stamp-string "%04a" ref-time1) p4-Mon)) - (should (equal (time-stamp-string "%A" ref-time1) Monday)) - (should (equal (time-stamp-string "%^A" ref-time1) MONDAY)) + (time-stamp-test-AB "%a" "%a") + (time-stamp-test-AB ("%4a" "%04a") "%a" #'formatz-mod-pad-l4) + (time-stamp-test-AB "%A" "%A") + (time-stamp-test-AB "%^A" "%^A") ;; warned 1997-2019, changed in 2019 - (should (equal (time-stamp-string "%^a" ref-time1) MON)) - (should (equal (time-stamp-string "%^4a" ref-time1) p4-MON)) + (time-stamp-test-AB "%^a" "%^a") + (time-stamp-test-AB "%^4a" "%^a" #'formatz-mod-pad-l4) ;; implemented since 2025 - (should (equal (time-stamp-string "%^#A" ref-time1) monday)) - (should (equal (time-stamp-string "%^#a" ref-time1) mon)) - (should (equal (time-stamp-string "%*A" ref-time1) Monday-tc)) - (should (equal (time-stamp-string "%*a" ref-time1) Mon-tc)) + (time-stamp-test-AB "%^#A" "%A" #'downcase) + (time-stamp-test-AB "%^#a" "%a" #'downcase) + (time-stamp-test-AB "%*A" "%A" #'capitalize) + (time-stamp-test-AB "%*a" "%a" #'capitalize) ;; discouraged - (should (equal (time-stamp-string "%:3a" ref-time1) " ")) - ))) - -(ert-deftest time-stamp-format-month-name () - "Test `time-stamp' formats for month name." - (with-time-stamp-test-env - (let* ((Jan (format-time-string "%b" ref-time1 t)) - (JAN (format-time-string "%^b" ref-time1 t)) - (jan (downcase (format-time-string "%b" ref-time1 t))) - (Jan-tc (capitalize (format-time-string "%^b" ref-time1 t))) - (January (format-time-string "%B" ref-time1 t)) - (JANUARY (format-time-string "%^B" ref-time1 t)) - (january (downcase (format-time-string "%B" ref-time1 t))) - (January-tc (capitalize (format-time-string "%B" ref-time1 t))) - (p4-Jan (string-pad Jan 4 ?\s t)) - (p4-JAN (string-pad JAN 4 ?\s t)) - (p10-January (string-pad January 10 ?\s t)) - (p10-JANUARY (string-pad JANUARY 10 ?\s t))) - ;; implemented and recommended since 1997 - (should (equal (time-stamp-string "%#B" ref-time1) JANUARY)) - (should (equal (time-stamp-string "%#10B" ref-time1) p10-JANUARY)) - ;; implemented since 1997, recommended 1997-2024 - (should (equal (time-stamp-string "%3b" ref-time1) Jan)) - ;; recommended 1997-2019 - (should (equal (time-stamp-string "%:b" ref-time1) January)) - ;; recommended 1997-2019, warned since 2024, will change - (time-stamp-should-warn - (equal (time-stamp-string "%3B" ref-time1) JAN)) - (time-stamp-should-warn - (equal (time-stamp-string "%10B" ref-time1) p10-JANUARY)) - ;; implemented since 2001, recommended since 2019 - (should (equal (time-stamp-string "%#b" ref-time1) JAN)) - (should (equal (time-stamp-string "%#3b" ref-time1) JAN)) - (should (equal (time-stamp-string "%#4b" ref-time1) p4-JAN)) - ;; implemented since 2001, recommended 2019-2024 - (should (equal (time-stamp-string "%:B" ref-time1) January)) - ;; broken 2019-2024 - (should (equal (time-stamp-string "%:10B" ref-time1) p10-January)) - ;; broken in 2019, changed in 2024 - (should (equal (time-stamp-string "%-B" ref-time1) January)) - (should (equal (time-stamp-string "%_B" ref-time1) January)) - ;; warned 1997-2019, changed in 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%b" ref-time1) Jan)) - (should (equal (time-stamp-string "%4b" ref-time1) p4-Jan)) - (should (equal (time-stamp-string "%04b" ref-time1) p4-Jan)) - (should (equal (time-stamp-string "%B" ref-time1) January)) - (should (equal (time-stamp-string "%^B" ref-time1) JANUARY)) - ;; warned 1997-2019, changed in 2019 - (should (equal (time-stamp-string "%^b" ref-time1) JAN)) - (should (equal (time-stamp-string "%^4b" ref-time1) p4-JAN)) - ;; implemented since 2025 - (should (equal (time-stamp-string "%^#B" ref-time1) january)) - (should (equal (time-stamp-string "%^#b" ref-time1) jan)) - (should (equal (time-stamp-string "%*B" ref-time1) January-tc)) - (should (equal (time-stamp-string "%*b" ref-time1) Jan-tc)) - ;; discouraged - (should (equal (time-stamp-string "%:3b" ref-time1) " ")) - ))) + (time-stamp-test-AB "%:3a" " " :literal) + )) -(ert-deftest time-stamp-format-day-of-month () - "Test `time-stamp' formats for day of month." +(ert-deftest time-stamp-format-two-digit-conversions () + "Test `time-stamp' formats for %d, %m, %H, %I, %M and %S." (with-time-stamp-test-env ;; implemented since 1995, recommended until 2024 - (should (equal (time-stamp-string "%2d" ref-time1) " 2")) - (should (equal (time-stamp-string "%2d" ref-time2) "18")) - (should (equal (time-stamp-string "%02d" ref-time1) "02")) - (should (equal (time-stamp-string "%02d" ref-time2) "18")) + (time-stamp-test-dmHIMS "%2d" "%_2d") + (time-stamp-test-dmHIMS "%02d" "%02d") ;; recommended 1997-2019 - (should (equal (time-stamp-string "%:d" ref-time1) "2")) - (should (equal (time-stamp-string "%:d" ref-time2) "18")) + (time-stamp-test-dmHIMS "%:d" "%-d") ;; implemented since 1997, recommended 2019-2024 - (should (equal (time-stamp-string "%1d" ref-time1) "2")) - (should (equal (time-stamp-string "%1d" ref-time2) "18")) + (time-stamp-test-dmHIMS "%1d" "%-d") ;; warned 1997-2019, allowed 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%-d" ref-time1) "2")) - (should (equal (time-stamp-string "%-d" ref-time2) "18")) + (time-stamp-test-dmHIMS "%-d" "%-d") ;; warned 1997-2019, changed in 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%_d" ref-time1) " 2")) - (should (equal (time-stamp-string "%_d" ref-time2) "18")) - (should (equal (time-stamp-string "%d" ref-time1) "02")) - (should (equal (time-stamp-string "%d" ref-time2) "18")) + (time-stamp-test-dmHIMS "%_d" "%_d") + (time-stamp-test-dmHIMS "%d" "%d") ;; discouraged - (should (equal (time-stamp-string "%:2d" ref-time1) " ")) + (time-stamp-test-dmHIMS "%:2d" " " :literal) )) -(ert-deftest time-stamp-format-hours-24 () - "Test `time-stamp' formats for hour on a 24-hour clock." - (with-time-stamp-test-env - ;; implemented since 1995, recommended until 2024 - (should (equal (time-stamp-string "%2H" ref-time1) "15")) - (should (equal (time-stamp-string "%2H" ref-time2) "12")) - (should (equal (time-stamp-string "%2H" ref-time3) " 6")) - (should (equal (time-stamp-string "%02H" ref-time1) "15")) - (should (equal (time-stamp-string "%02H" ref-time2) "12")) - (should (equal (time-stamp-string "%02H" ref-time3) "06")) - ;; recommended 1997-2019 - (should (equal (time-stamp-string "%:H" ref-time1) "15")) - (should (equal (time-stamp-string "%:H" ref-time2) "12")) - (should (equal (time-stamp-string "%:H" ref-time3) "6")) - ;; implemented since 1997, recommended 2019-2024 - (should (equal (time-stamp-string "%1H" ref-time1) "15")) - (should (equal (time-stamp-string "%1H" ref-time2) "12")) - (should (equal (time-stamp-string "%1H" ref-time3) "6")) - ;; warned 1997-2019, allowed 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%-H" ref-time1) "15")) - (should (equal (time-stamp-string "%-H" ref-time2) "12")) - (should (equal (time-stamp-string "%-H" ref-time3) "6")) - ;; warned 1997-2019, changed in 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%_H" ref-time1) "15")) - (should (equal (time-stamp-string "%_H" ref-time2) "12")) - (should (equal (time-stamp-string "%_H" ref-time3) " 6")) - (should (equal (time-stamp-string "%H" ref-time1) "15")) - (should (equal (time-stamp-string "%H" ref-time2) "12")) - (should (equal (time-stamp-string "%H" ref-time3) "06")))) - -(ert-deftest time-stamp-format-hours-12 () - "Test `time-stamp' formats for hour on a 12-hour clock." - (with-time-stamp-test-env - ;; implemented since 1995, recommended until 2024 - (should (equal (time-stamp-string "%2I" ref-time1) " 3")) - (should (equal (time-stamp-string "%2I" ref-time2) "12")) - (should (equal (time-stamp-string "%2I" ref-time3) " 6")) - (should (equal (time-stamp-string "%02I" ref-time1) "03")) - (should (equal (time-stamp-string "%02I" ref-time2) "12")) - (should (equal (time-stamp-string "%02I" ref-time3) "06")) - ;; recommended 1997-2019 - (should (equal (time-stamp-string "%:I" ref-time1) "3")) ;PM - (should (equal (time-stamp-string "%:I" ref-time2) "12")) ;PM - (should (equal (time-stamp-string "%:I" ref-time3) "6")) ;AM - ;; implemented since 1997, recommended 2019-2024 - (should (equal (time-stamp-string "%1I" ref-time1) "3")) - (should (equal (time-stamp-string "%1I" ref-time2) "12")) - (should (equal (time-stamp-string "%1I" ref-time3) "6")) - ;; warned 1997-2019, allowed 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%-I" ref-time1) "3")) - (should (equal (time-stamp-string "%-I" ref-time2) "12")) - (should (equal (time-stamp-string "%-I" ref-time3) "6")) - ;; warned 1997-2019, changed in 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%_I" ref-time1) " 3")) - (should (equal (time-stamp-string "%_I" ref-time2) "12")) - (should (equal (time-stamp-string "%_I" ref-time3) " 6")) - (should (equal (time-stamp-string "%I" ref-time1) "03")) - (should (equal (time-stamp-string "%I" ref-time2) "12")) - (should (equal (time-stamp-string "%I" ref-time3) "06")))) - -(ert-deftest time-stamp-format-month-number () - "Test `time-stamp' formats for month number." - (with-time-stamp-test-env - ;; implemented since 1995, recommended until 2024 - (should (equal (time-stamp-string "%2m" ref-time1) " 1")) - (should (equal (time-stamp-string "%2m" ref-time2) "11")) - (should (equal (time-stamp-string "%02m" ref-time1) "01")) - (should (equal (time-stamp-string "%02m" ref-time2) "11")) - ;; recommended 1997-2019 - (should (equal (time-stamp-string "%:m" ref-time1) "1")) - (should (equal (time-stamp-string "%:m" ref-time2) "11")) - ;; implemented since 1997, recommended 2019-2024 - (should (equal (time-stamp-string "%1m" ref-time1) "1")) - (should (equal (time-stamp-string "%1m" ref-time2) "11")) - ;; warned 1997-2019, allowed 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%-m" ref-time1) "1")) - (should (equal (time-stamp-string "%-m" ref-time2) "11")) - ;; warned 1997-2019, changed in 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%_m" ref-time1) " 1")) - (should (equal (time-stamp-string "%_m" ref-time2) "11")) - (should (equal (time-stamp-string "%m" ref-time1) "01")) - (should (equal (time-stamp-string "%m" ref-time2) "11")))) - -(ert-deftest time-stamp-format-minute () - "Test `time-stamp' formats for minute." - (with-time-stamp-test-env - ;; implemented since 1995, recommended until 2024 - (should (equal (time-stamp-string "%2M" ref-time1) " 4")) - (should (equal (time-stamp-string "%2M" ref-time2) "14")) - (should (equal (time-stamp-string "%02M" ref-time1) "04")) - (should (equal (time-stamp-string "%02M" ref-time2) "14")) - ;; recommended 1997-2019 - (should (equal (time-stamp-string "%:M" ref-time1) "4")) - (should (equal (time-stamp-string "%:M" ref-time2) "14")) - ;; implemented since 1997, recommended 2019-2024 - (should (equal (time-stamp-string "%1M" ref-time1) "4")) - (should (equal (time-stamp-string "%1M" ref-time2) "14")) - ;; warned 1997-2019, allowed 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%-M" ref-time1) "4")) - (should (equal (time-stamp-string "%-M" ref-time2) "14")) - ;; warned 1997-2019, changed in 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%_M" ref-time1) " 4")) - (should (equal (time-stamp-string "%_M" ref-time2) "14")) - (should (equal (time-stamp-string "%M" ref-time1) "04")) - (should (equal (time-stamp-string "%M" ref-time2) "14")))) - -(ert-deftest time-stamp-format-second () - "Test `time-stamp' formats for second." - (with-time-stamp-test-env - ;; implemented since 1995, recommended until 2024 - (should (equal (time-stamp-string "%2S" ref-time1) " 5")) - (should (equal (time-stamp-string "%2S" ref-time2) "15")) - (should (equal (time-stamp-string "%02S" ref-time1) "05")) - (should (equal (time-stamp-string "%02S" ref-time2) "15")) - ;; recommended 1997-2019 - (should (equal (time-stamp-string "%:S" ref-time1) "5")) - (should (equal (time-stamp-string "%:S" ref-time2) "15")) - ;; implemented since 1997, recommended 2019-2024 - (should (equal (time-stamp-string "%1S" ref-time1) "5")) - (should (equal (time-stamp-string "%1S" ref-time2) "15")) - ;; warned 1997-2019, allowed 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%-S" ref-time1) "5")) - (should (equal (time-stamp-string "%-S" ref-time2) "15")) - ;; warned 1997-2019, changed in 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%_S" ref-time1) " 5")) - (should (equal (time-stamp-string "%_S" ref-time2) "15")) - (should (equal (time-stamp-string "%S" ref-time1) "05")) - (should (equal (time-stamp-string "%S" ref-time2) "15")))) - (ert-deftest time-stamp-format-year-2digit () "Test `time-stamp' formats for %y." (with-time-stamp-test-env ;; implemented since 1995, recommended 1995-2024 - (should (equal (time-stamp-string "%02y" ref-time1) "06")) - (should (equal (time-stamp-string "%02y" ref-time2) "16")) + (time-stamp-test "%02y" "%y") ;; recommended 1997-2019, warned since 2024 - (time-stamp-should-warn - (equal (time-stamp-string "%:y" ref-time1) "2006")) - (time-stamp-should-warn - (equal (time-stamp-string "%:y" ref-time2) "2016")) + (time-stamp-test "%:y" "%Y" :warn) ;; %-y and %_y warned 1997-2019, changed in 2019 ;; (We don't expect these forms to be useful, ;; but we test here so that we can confidently state that ;; all 2-digit conversions behave identically.) - (should (equal (time-stamp-string "%1y" ref-time1) "6")) - (should (equal (time-stamp-string "%1y" ref-time2) "16")) - (should (equal (time-stamp-string "%-y" ref-time1) "6")) - (should (equal (time-stamp-string "%-y" ref-time2) "16")) - (should (equal (time-stamp-string "%_y" ref-time1) " 6")) - (should (equal (time-stamp-string "%_y" ref-time2) "16")) + (time-stamp-test ("%1y" "%-y") "%-y") + (time-stamp-test "%_y" "%_y") ;; warned 1997-2019, changed in 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%y" ref-time1) "06")) - (should (equal (time-stamp-string "%y" ref-time2) "16")) + (time-stamp-test "%y" "%y") ;; implemented since 1995, warned since 2019, will change - (time-stamp-should-warn - (equal (time-stamp-string "%04y" ref-time1) "2006")) - (time-stamp-should-warn - (equal (time-stamp-string "%4y" ref-time1) "2006")))) + (time-stamp-test ("%04y" "%4y") "%Y" :warn) + )) (ert-deftest time-stamp-format-year-4digit () "Test `time-stamp' format %Y." (with-time-stamp-test-env ;; implemented since 1997, recommended since 2019 - (should (equal (time-stamp-string "%Y" ref-time1) "2006")) + (time-stamp-test "%Y" "%Y") ;; numbers do not truncate - (should (equal (time-stamp-string "%2Y" ref-time1) "2006")) - (should (equal (time-stamp-string "%02Y" ref-time1) "2006")))) + (time-stamp-test ("%2Y" "%02Y") "%Y") + )) (ert-deftest time-stamp-format-am-pm () "Test `time-stamp' formats for AM and PM strings." (with-time-stamp-test-env - (let ((pm (format-time-string "%P" ref-time1 t)) - (am (format-time-string "%P" ref-time3 t)) - (Pm (format-time-string "%p" ref-time1 t)) - (Am (format-time-string "%p" ref-time3 t)) - (Pm-tc (capitalize (format-time-string "%p" ref-time1 t))) - (Am-tc (capitalize (format-time-string "%p" ref-time3 t))) - (PM (format-time-string "%^p" ref-time1 t)) - (AM (format-time-string "%^p" ref-time3 t))) - ;; implemented and recommended since 1997 - (should (equal (time-stamp-string "%#p" ref-time1) pm)) - (should (equal (time-stamp-string "%#p" ref-time3) am)) - ;; implemented since 1997, recommended 1997-2024 - (should (equal (time-stamp-string "%P" ref-time1) Pm)) - (should (equal (time-stamp-string "%P" ref-time3) Am)) - ;; implemented since 1997 - (should (equal (time-stamp-string "%^#p" ref-time1) pm)) - (should (equal (time-stamp-string "%^#p" ref-time3) am)) - ;; warned 1997-2019, changed in 2019, recommended (with caveat) since 2024 - (should (equal (time-stamp-string "%p" ref-time1) Pm)) - (should (equal (time-stamp-string "%p" ref-time3) Am)) - ;; changed in 2024 - (should (equal (time-stamp-string "%^p" ref-time1) PM)) - (should (equal (time-stamp-string "%^p" ref-time3) AM)) - (should (equal (time-stamp-string "%#^p" ref-time1) PM)) - (should (equal (time-stamp-string "%#^p" ref-time3) AM)) - (should (equal (time-stamp-string "%#P" ref-time1) pm)) - (should (equal (time-stamp-string "%#P" ref-time3) am)) - (should (equal (time-stamp-string "%^#P" ref-time1) pm)) - (should (equal (time-stamp-string "%^#P" ref-time3) am)) - (should (equal (time-stamp-string "%^P" ref-time1) "")) - (should (equal (time-stamp-string "%^P" ref-time3) "")) - ;; implemented since 2025 - (should (equal (time-stamp-string "%*p" ref-time1) Pm-tc)) - (should (equal (time-stamp-string "%*p" ref-time3) Am-tc)) - (should (equal (time-stamp-string "%*P" ref-time1) Pm-tc)) - (should (equal (time-stamp-string "%*P" ref-time3) Am-tc)) - ;; reserved for possible adding or removing periods (dots) - (should (equal (time-stamp-string "%:p" ref-time1) Pm)) - (should (equal (time-stamp-string "%#:p" ref-time1) pm)) - (should (equal (time-stamp-string "%^:p" ref-time1) PM)) - (should (equal (time-stamp-string "%.p" ref-time1) Pm)) - (should (equal (time-stamp-string "%#.p" ref-time1) pm)) - (should (equal (time-stamp-string "%^.p" ref-time1) PM)) - (should (equal (time-stamp-string "%@p" ref-time1) Pm)) - (should (equal (time-stamp-string "%#@p" ref-time1) pm)) - (should (equal (time-stamp-string "%^@p" ref-time1) PM)) - ))) + ;; implemented and recommended since 1997 + (time-stamp-test "%#p" "%P") + ;; implemented since 1997, recommended 1997-2024 + (time-stamp-test "%P" "%p") + ;; implemented since 1997 + (time-stamp-test "%^#p" "%P") + ;; warned 1997-2019, changed in 2019, recommended (with caveat) since 2024 + (time-stamp-test "%p" "%p") + ;; changed in 2024 + (time-stamp-test ("%^p" "%#^p") "%^p") + (time-stamp-test ("%#P" "%^#P") "%P") + (time-stamp-test "%^P" "") + ;; implemented since 2025 + (time-stamp-test ("%*p" "%*P") "%p" #'capitalize) + ;; reserved for possible adding or removing periods (dots) + (time-stamp-test ("%:p" "%.p" "%@p") "%p") + (time-stamp-test ("%#:p" "%#.p" "%#@p") "%P") + (time-stamp-test ("%^:p" "%^.p" "%^@p") "%^p") + )) (ert-deftest time-stamp-format-day-number-in-week () "Test `time-stamp' formats for day number in week." (with-time-stamp-test-env - (should (equal (time-stamp-string "%w" ref-time1) "1")) - (should (equal (time-stamp-string "%w" ref-time2) "5")) - (should (equal (time-stamp-string "%w" ref-time3) "0")))) + (time-stamp-test "%w" "%w") + )) (ert-deftest time-stamp-format-time-zone-name () "Test `time-stamp' format %Z." (with-time-stamp-test-env - (let ((UTC-abbr (format-time-string "%Z" ref-time1 t)) - (Utc-abbr (capitalize (format-time-string "%Z" ref-time1 t))) - (utc-abbr (format-time-string "%#Z" ref-time1 t))) - ;; implemented and recommended since 1995 - (should (equal (time-stamp-string "%Z" ref-time1) UTC-abbr)) - ;; implemented since 1997, recommended since 2019 - (should (equal (time-stamp-string "%#Z" ref-time1) utc-abbr)) - ;; ^ accepted and ignored since 1995/1997, test for consistency with %p - (should (equal (time-stamp-string "%^Z" ref-time1) UTC-abbr)) - (should (equal (time-stamp-string "%^#Z" ref-time1) utc-abbr)) - ;; implemented since 2025 - (should (equal (time-stamp-string "%*Z" ref-time1) Utc-abbr)) - ))) + ;; implemented and recommended since 1995 + (time-stamp-test "%Z" "%Z") + ;; implemented since 1997, recommended since 2019 + (time-stamp-test "%#Z" "%#Z") + ;; ^ accepted and ignored since 1995/1997, test for consistency with %p + (time-stamp-test "%^Z" "%Z") + (time-stamp-test "%^#Z" "%#Z") + ;; implemented since 2025 + (time-stamp-test "%*Z" "%Z" #'capitalize) + )) (ert-deftest time-stamp-format-time-zone-offset () "Test `time-stamp' legacy format %z and spot-test new offset format %5z." (with-time-stamp-test-env - (let ((utc-abbr (format-time-string "%#Z" ref-time1 t))) ;; recommended 1995-2019, warned since 2019, will change - (time-stamp-should-warn - (equal (time-stamp-string "%z" ref-time1) utc-abbr))) + (time-stamp-test "%z" "%#Z" :warn) ;; implemented and recommended (with compat caveat) since 2019 - (should (equal (time-stamp-string "%5z" ref-time1) "+0000")) + (time-stamp-test "%5z" "+0000" :literal) (let ((time-stamp-time-zone "PST8")) - (should (equal (time-stamp-string "%5z" ref-time1) "-0800"))) + (time-stamp-test "%5z" "-0800" :literal)) (let ((time-stamp-time-zone '(-36000 "HST"))) - (should (equal (time-stamp-string "%5z" ref-time1) "-1000"))) + (time-stamp-test "%5z" "-1000" :literal)) (let ((time-stamp-time-zone "CET-1")) - (should (equal (time-stamp-string "%5z" ref-time1) "+0100"))) + (time-stamp-test "%5z" "+0100" :literal)) ;; implemented since 2019, recommended (with compat caveat) since 2024 ;; See also the "formatz" tests below, which since 2021 test more ;; variants with more offsets. - (should (equal (time-stamp-string "%-z" ref-time1) "+00")) - (should (equal (time-stamp-string "%:::z" ref-time1) "+00")) - (should (equal (time-stamp-string "%:z" ref-time1) "+00:00")) + (time-stamp-test "%-z" "+00" :literal) + (time-stamp-test "%:::z" "+00" :literal) + (time-stamp-test "%:z" "+00:00" :literal) ;; implemented since 2019 - (should (equal (time-stamp-string "%::z" ref-time1) "+00:00:00")) - (should (equal (time-stamp-string "%9::z" ref-time1) "+00:00:00")))) + (time-stamp-test ("%::z" "%9::z") "+00:00:00" :literal) + )) (ert-deftest time-stamp-format-non-date-conversions () "Test `time-stamp' formats for non-date items." (with-time-stamp-test-env (with-time-stamp-system-name "test-system-name.example.org" ;; implemented and recommended since 1995 - (should (equal (time-stamp-string "%%" ref-time1) "%")) ;% last char - (should (equal (time-stamp-string "%%P" ref-time1) "%P")) ;% not last char - (should (equal (time-stamp-string "%f" ref-time1) - "0-9AZaz (time)_stamped.file$+^")) - (should (equal (time-stamp-string "%F" ref-time1) - "/emacs/test/0-9AZaz (time)_stamped.file$+^")) + (time-stamp-test "%%" "%" :literal) ;% last char + (time-stamp-test "%%P" "%P" :literal) ;% not last char + (time-stamp-test "%f" "0-9AZaz (time)_stamped.file$+^" :literal) + (time-stamp-test "%F" "/emacs/test/0-9AZaz (time)_stamped.file$+^" :literal) (with-temp-buffer - (should (equal (time-stamp-string "%f" ref-time1) "(no file)")) - (should (equal (time-stamp-string "%F" ref-time1) "(no file)"))) - (should (equal (time-stamp-string "%h" ref-time1) "test-mail-host-name")) + (time-stamp-test ("%f" "%F") "(no file)") :literal) + (time-stamp-test "%h" "test-mail-host-name" :literal) (let ((mail-host-address nil)) - (should (equal (time-stamp-string "%h" ref-time1) - "test-system-name.example.org"))) + (time-stamp-test "%h" "test-system-name.example.org" :literal)) ;; recommended 1997-2019, warned since 2024 - (time-stamp-should-warn - (equal (time-stamp-string "%s" ref-time1) - "test-system-name.example.org")) - (time-stamp-should-warn - (equal (time-stamp-string "%U" ref-time1) "100%d Tester")) - (time-stamp-should-warn - (equal (time-stamp-string "%u" ref-time1) "test-logname")) + (time-stamp-test "%s" "test-system-name.example.org" :literal :warn) + (time-stamp-test "%U" "100%d Tester" :literal :warn) + (time-stamp-test "%u" "test-logname" :literal :warn) ;; implemented since 2001, recommended since 2019 - (should (equal (time-stamp-string "%L" ref-time1) "100%d Tester")) - (should (equal (time-stamp-string "%l" ref-time1) "test-logname")) + (time-stamp-test "%L" "100%d Tester" :literal) + (time-stamp-test "%l" "test-logname" :literal) ;; implemented since 2007, recommended since 2019 - (should (equal (time-stamp-string "%Q" ref-time1) - "test-system-name.example.org")) - (should (equal (time-stamp-string "%q" ref-time1) "test-system-name")) + (time-stamp-test "%Q" "test-system-name.example.org" :literal) + (time-stamp-test "%q" "test-system-name" :literal) ;; implemented since 2025 - (should (equal (time-stamp-string "%X" ref-time1) - "test-system-name.example.org")) - (should (equal (time-stamp-string "%x" ref-time1) "test-system-name"))) + (time-stamp-test "%X" "test-system-name.example.org" :literal) + (time-stamp-test "%x" "test-system-name" :literal) + ) (with-time-stamp-system-name "sysname-no-dots" ;; implemented since 2007, recommended since 2019 - (should (equal (time-stamp-string "%Q" ref-time1) "sysname-no-dots")) - (should (equal (time-stamp-string "%q" ref-time1) "sysname-no-dots")) + (time-stamp-test ("%Q" "%q") "sysname-no-dots" :literal) ;; implemented since 2025 - (should (equal (time-stamp-string "%X" ref-time1) "sysname-no-dots")) - (should (equal (time-stamp-string "%x" ref-time1) "sysname-no-dots")) + (time-stamp-test ("%X" "%x") "sysname-no-dots" :literal) ))) (ert-deftest time-stamp-format-ignored-modifiers () @@ -808,72 +665,57 @@ (ert-deftest time-stamp-format-non-conversions () "Test that without a %, the text is copied literally." (with-time-stamp-test-env - (should (equal (time-stamp-string "No percent" ref-time1) "No percent")))) + (time-stamp-test "No percent" "No percent" :literal))) (ert-deftest time-stamp-format-multiple-conversions () "Test that multiple %-conversions are independent." (with-time-stamp-test-env - (let ((Mon (format-time-string "%a" ref-time1 t)) - (MON (format-time-string "%^a" ref-time1 t)) - (Monday (format-time-string "%A" ref-time1 t))) - ;; change-case flag is independent - (should (equal (time-stamp-string "%a.%#a.%a" ref-time1) - (concat Mon "." MON "." Mon))) - ;; up-case flag is independent - (should (equal (time-stamp-string "%a.%^a.%a" ref-time1) - (concat Mon "." MON "." Mon))) - ;; underscore flag is independent - (should (equal (time-stamp-string "%_d.%d.%_d" ref-time1) " 2.02. 2")) - (should (equal (time-stamp-string "%_7z.%7z.%_7z" ref-time1) - "+000000.+0000 .+000000")) - ;; minus flag is independent - (should (equal (time-stamp-string "%d.%-d.%d" ref-time1) "02.2.02")) - (should (equal (time-stamp-string "%3z.%-3z.%3z" ref-time1) - "+0000.+00.+0000")) - ;; 0 flag is independent - (should (equal (time-stamp-string "%2d.%02d.%2d" ref-time1) " 2.02. 2")) - (should (equal (time-stamp-string "%6:::z.%06:::z.%6:::z" ref-time1) - "+00 .+00:00.+00 ")) - ;; field width is independent - (should (equal - (time-stamp-string "%6Y.%Y.%6Y" ref-time1) " 2006.2006. 2006")) - ;; colon modifier is independent - (should (equal (time-stamp-string "%a.%:a.%a" ref-time1) - (concat Mon "." Monday "." Mon))) - (should (equal (time-stamp-string "%5z.%5::z.%5z" ref-time1) - "+0000.+00:00:00.+0000")) - ;; format character is independent - (should (equal (time-stamp-string "%H:%M%%%S" ref-time1) "15:04%05"))))) + ;; change-case flag is independent + (time-stamp-test "%a.%#a.%a" "%a.%^a.%a") + ;; up-case flag is independent + (time-stamp-test "%a.%^a.%a" "%a.%^a.%a") + ;; underscore flag is independent + (time-stamp-test "%_d.%d.%_d" " 2.02. 2" :literal) + (time-stamp-test "%_7z.%7z.%_7z" "+000000.+0000 .+000000" :literal) + ;; minus flag is independent + (time-stamp-test "%d.%-d.%d" "02.2.02" :literal) + (time-stamp-test "%3z.%-3z.%3z" "+0000.+00.+0000" :literal) + ;; 0 flag is independent + (time-stamp-test "%2d.%02d.%2d" " 2.02. 2" :literal) + (time-stamp-test "%6:::z.%06:::z.%6:::z" "+00 .+00:00.+00 " :literal) + ;; field width is independent + (time-stamp-test "%6Y.%Y.%6Y" " 2006.2006. 2006" :literal) + ;; colon modifier is independent + (time-stamp-test "%a.%:a.%a" "%a.%A.%a") + (time-stamp-test "%5z.%5::z.%5z" "+0000.+00:00:00.+0000" :literal) + ;; format character is independent + (time-stamp-test "%H:%M%%%S" "15:04%05" :literal) + )) (ert-deftest time-stamp-format-string-width () "Test `time-stamp' string width modifiers." (with-time-stamp-test-env - (let ((UTC-abbr (format-time-string "%Z" ref-time1 t))) - (should (equal (time-stamp-string "%1%" ref-time3) "%")) - (should (equal (time-stamp-string "%2%" ref-time3) " %")) - (should (equal (time-stamp-string "%9%" ref-time3) " %")) - (should (equal (time-stamp-string "%10%" ref-time3) " %")) - (should (equal (time-stamp-string "%03d" ref-time3) "025")) - (should (equal (time-stamp-string "%3d" ref-time3) " 25")) - (should (equal (time-stamp-string "%_3d" ref-time3) " 25")) - (should (equal (time-stamp-string "%99z" ref-time1) - (time-stamp-string "%100z" ref-time1))) - (should (equal (time-stamp-string "%099Y" ref-time1) - (time-stamp-string "%0100Y" ref-time1))) - ;; since 2024 - (should (equal (time-stamp-string "%0d" ref-time1) "02")) - (should (equal (time-stamp-string "%0d" ref-time2) "18")) - ;; broken 2019-2024 - (should (equal (time-stamp-string "%-Z" ref-time1) UTC-abbr)) - (should (equal (time-stamp-string "%_Z" ref-time1) UTC-abbr))))) + (time-stamp-test "%1%" "%" :literal) + (time-stamp-test "%2%" " %" :literal) + (time-stamp-test "%9%" " %" :literal) + (time-stamp-test "%10%" " %" :literal) + (time-stamp-test "%03d" "%03d") + (time-stamp-test ("%3d" "%_3d") "%_3d") + (should (equal (time-stamp-string "%99z" ref-time1) + (time-stamp-string "%100z" ref-time1))) + (should (equal (time-stamp-string "%099Y" ref-time1) + (time-stamp-string "%0100Y" ref-time1))) + ;; since 2024 + (time-stamp-test "%0d" "%d") + ;; broken 2019-2024 + (time-stamp-test ("%-Z" "%_Z") "%Z") + )) (ert-deftest time-stamp-format-letter-case () "Test `time-stamp' upcase and downcase modifiers not tested elsewhere." (with-time-stamp-test-env - (let ((MONDAY (format-time-string "%^A" ref-time1 t))) - (should (equal (time-stamp-string "%*^A" ref-time1) MONDAY)) - (should (equal (time-stamp-string "%*#A" ref-time1) MONDAY)) - ))) + (time-stamp-test ("%*^A" "%*#A") "%^A") + )) ;;; Tests of helper functions commit 7aef4db23d6d2d79d803c6ab708bbe40896e7b4f Author: F. Jason Park Date: Tue Oct 21 21:51:00 2025 -0700 ; Prefer EMACS_EMBA_CI for selecting ERC tests * test/lisp/erc/erc-scenarios-keep-place-indicator.el (erc-scenarios-keep-place-indicator--follow): * test/lisp/erc/erc-stamp-tests.el (erc-echo-timestamp): * test/lisp/erc/erc-tests.el (erc--channel-modes): Use "EMACS_EMBA_CI" for EMBA-specific test selection instead of "CI", which is a Gitlab "predefined" variable absent from .job-template's Docker subprocess. diff --git a/test/lisp/erc/erc-scenarios-keep-place-indicator.el b/test/lisp/erc/erc-scenarios-keep-place-indicator.el index cc05bf105cb..2e0babfd2ae 100644 --- a/test/lisp/erc/erc-scenarios-keep-place-indicator.el +++ b/test/lisp/erc/erc-scenarios-keep-place-indicator.el @@ -31,9 +31,10 @@ ;; away, the indicator is updated if it's earlier in the buffer. (ert-deftest erc-scenarios-keep-place-indicator--follow () :tags `(:expensive-test - ,@(and (getenv "CI") '(:unstable)) + ,@(and (getenv "EMACS_EMBA_CI") '(:unstable)) ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) + ;; ERC's tests also run in external CI that exports this variable. (when (getenv "CI") (ert-skip "Times out intermittently")) diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index dc3332460d0..aa5f8d949b7 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -278,7 +278,8 @@ (kill-buffer))))) (ert-deftest erc-echo-timestamp () - :tags (and (null (getenv "CI")) '(:unstable)) + ;; Only mark :unstable when running locally. + :tags (and (null (getenv "CI")) (null (getenv "EMACS_EMBA_CI")) '(:unstable)) (should-not erc-echo-timestamps) (should-not erc-stamp--last-stamp) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 5eb084c48ee..1b486c68584 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -930,7 +930,8 @@ (should-not calls)))) (ert-deftest erc--channel-modes () - :tags (and (null (getenv "CI")) '(:unstable)) + ;; Only mark :unstable when running locally. + :tags (and (null (getenv "CI")) (null (getenv "EMACS_EMBA_CI")) '(:unstable)) (setq erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test") commit c2127c541eba7900f19948813906333fe53d3895 Author: Stefan Monnier Date: Wed Oct 22 17:58:16 2025 -0400 lisp/comint.el (comint--mark-yanked-as-output): Use `letrec` diff --git a/lisp/comint.el b/lisp/comint.el index b7c609ed469..927e8d17f8a 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -2313,14 +2313,12 @@ Make backspaces delete the previous character." ;; `yank' removes the field text property from the text it inserts ;; due to `yank-excluded-properties', so arrange for this text ;; property to be reapplied in the `after-change-functions'. - (let (fun) - (setq - fun - (lambda (beg1 end1 _len1) - (remove-hook 'after-change-functions fun t) - (when (and (= beg beg1) - (= end end1)) - (comint--mark-as-output beg1 end1)))) + (letrec ((fun + (lambda (beg1 end1 _len1) + (remove-hook 'after-change-functions fun t) + (when (and (= beg beg1) + (= end end1)) + (comint--mark-as-output beg1 end1))))) (add-hook 'after-change-functions fun nil t))) (defun comint--unmark-string-as-output (string) commit 287fb2fbad6a75cc88ccd875ddcb38c18f75338f Author: Stefan Monnier Date: Wed Oct 22 17:12:10 2025 -0400 (custom-initialize-after-file): New function Some global minor modes require initialization. Those that are preloaded currently abuse `custom-initialize-delay` for that, but it's suboptimal and doesn't help those that aren't preloaded. So introduce a new function to fill that need. While at it, make `define-globalized-minor-mode` use it automatically when useful. * lisp/custom.el (custom-initialize-after-file-load): New function. * lisp/tooltip.el (tooltip-mode): * lisp/paren.el (show-paren-mode): * lisp/rfn-eshadow.el (file-name-shadow-mode): * lisp/epa-hook.el (auto-encryption-mode): * lisp/minibuffer.el (minibuffer-regexp-mode, minibuffer-nonselected-mode): * lisp/electric.el (electric-indent-mode): Use it instead of `custom-initialize-delay` since the value does not depend on the runtime context. (electric-quote-mode): Don't use `custom-initialize-delay` since the default value is nil anyway. * lisp/emacs-lisp/easy-mmode.el (define-globalized-minor-mode): Automatically add `:initialize` if needed. * lisp/emacs-lisp/eldoc.el (global-eldoc-mode): Remove `:initialize`, now provided automatically. * doc/lispref/customize.texi (Variable Definitions): * doc/lispref/modes.texi (Defining Minor Modes): Document and Suggest `custom-initialize-after-file-load` instead of `custom-initialize-delay`. diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index 2c6f02a088c..170bdc5e42c 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -434,14 +434,12 @@ Use the @code{:set} function to initialize the variable, if it is already set or has been customized; otherwise, just use @code{set-default-toplevel-value}. -@item custom-initialize-delay +@item custom-initialize-after-file-load This function behaves like @code{custom-initialize-set}, but it -delays the actual initialization to the next Emacs start. This should -be used in files that are preloaded (or for autoloaded variables), so -that the initialization is done in the run-time context rather than -the build-time context. This also has the side-effect that the -(delayed) initialization is performed with the @code{:set} function. -@xref{Building Emacs}. +delays the actual initialization until after the containing file is loaded. +This can be useful to break the common dependency where the setter +is (or uses) a function which needs to be defined after the variable, +such as when a global minor mode has a non-@code{nil} @code{:init-value}. @end table @item :local @var{value} diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 8c8cbf32b61..6d7c586e23c 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1868,18 +1868,19 @@ marking the @code{define-minor-mode} form as autoloaded. @item :init-value @var{init-value} This is the value to which the @var{mode} variable is initialized. Except in unusual circumstances (see below), this value must be -@code{nil}. If the mode is global (see below) and preloaded, and the -initial value is @code{t}, i.e., the mode is turned on by default, you -should consider forcing Emacs to run the mode function at startup, like -this: +@code{nil}. Note that @code{define-minor-mode} does not automatically +run the body of the minor mode to ensure the mode is really enabled +according to this value, so if the mode is global (see above) and the +initial value is non-@code{nil}, you should consider forcing Emacs to +run the mode function when loading the mode, like this: @lisp - :initialize #'custom-initialize-delay + :initialize #'custom-initialize-after-file-load @end lisp @noindent -otherwise, the minor mode might not appear in the @file{*Help*} buffer -generated by @kbd{C-h m} (@pxref{Mode Help}). +otherwise, the minor mode might say it's enabled even though it has not +been properly set up. @item :lighter @var{lighter} The string @var{lighter} says what to display in the mode line diff --git a/etc/NEWS b/etc/NEWS index de959aed9f3..f61825f531b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2674,6 +2674,13 @@ New faces have been added to 'icomplete-vertical-mode': ** Customize ++++ +*** New function 'custom-initialize-after-file-load'. +Useful to delay initialization to the end of the file, so it can use +functions defined later than the variable, as is common for minor modes. +'define-globalized-minor-mode' now automatically uses it if the +init-value is non-nil. + --- *** New major mode 'Customize-dirlocals-mode'. This is intended for customizing directory-local variables in the diff --git a/lisp/custom.el b/lisp/custom.el index ceb598b6787..69d09d9e293 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -140,6 +140,7 @@ For the standard setting, use `set-default-toplevel-value'." Once this list has been processed, this var is set to a non-list value.") (defun custom-initialize-delay (symbol value) + ;; FIXME: Rename to `custom-initialize-after-dump'? "Delay initialization of SYMBOL to the next Emacs start. This is used in files that are preloaded (or for autoloaded variables), so that the initialization is done in the run-time @@ -159,6 +160,27 @@ the :set function." ;; delay it, so initialize it "normally" (bug#47072). (custom-initialize-reset symbol value))) +(defun custom-initialize-after-file-load (symbol value) + "Delay initialization to after the current file is loaded. +This is handy when the initialization needs functions defined after the variable, +such as for global minor modes." + ;; Defvar it so as to mark it special, etc (bug#25770). + (internal--define-uninitialized-variable symbol) + + ;; Until the var is actually initialized, it is kept unbound. + ;; This seemed to be at least as good as setting it to an arbitrary + ;; value like nil (evaluating `value' is not an option because it + ;; may have undesirable side-effects). + (if (not load-file-name) + ;; There's no "after file" to speak of. + (custom-initialize-set symbol value) + (let ((thisfile load-file-name)) + (letrec ((f (lambda (file) + (when (equal file thisfile) + (remove-hook 'after-load-functions f) + (custom-initialize-set symbol value))))) + (add-hook 'after-load-functions f))))) + (defun custom-declare-variable (symbol default doc &rest args) "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments. DEFAULT should be an expression to evaluate to compute the default value, diff --git a/lisp/electric.el b/lisp/electric.el index a1131499be6..d235a384620 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -383,7 +383,7 @@ indent the line according to context and rules of the major mode. This is a global minor mode. To toggle the mode in a single buffer, use `electric-indent-local-mode'." :global t :group 'electricity - :initialize 'custom-initialize-delay + :initialize #'custom-initialize-after-file-load :init-value t (if (not electric-indent-mode) (unless (catch 'found @@ -767,7 +767,7 @@ ones listed here. Also see `electric-quote-replace-consecutive'. This is a global minor mode. To toggle the mode in a single buffer, use `electric-quote-local-mode'." :global t :group 'electricity - :initialize 'custom-initialize-delay + ;; :initialize #'custom-initialize-after-file-load :init-value nil (if (not electric-quote-mode) (unless (catch 'found diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index c5c95a1be20..8e51825854a 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -522,6 +522,12 @@ on if the hook has explicitly disabled it. (when (easy-mmode--globalized-predicate-p ,MODE-predicate) (funcall ,turn-on-function))))) (_ (push keyw extra-keywords) (push (pop body) extra-keywords)))) + (setq extra-keywords (nreverse extra-keywords)) + + (when (and (plist-get extra-keywords :init-value) + (null (plist-get extra-keywords :initialize))) + (setq extra-keywords `(:initialize #'custom-initialize-after-file-load + . ,extra-keywords))) `(progn (progn @@ -553,7 +559,7 @@ Disable the mode if ARG is a negative number.\n\n" "`%s' is used to control which modes this minor mode is used in." MODE-predicate)) "")) - :global t ,@group ,@(nreverse extra-keywords) + :global t ,@group ,@extra-keywords ;; Setup hook to handle future mode changes and new buffers. (if ,global-mode diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index eb5f112f4a9..b82ee981eb7 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -238,7 +238,6 @@ expression point is on." :lighter eldoc-minor-mode-string ;;;###autoload (define-globalized-minor-mode global-eldoc-mode eldoc-mode turn-on-eldoc-mode - :initialize 'custom-initialize-delay :init-value t ;; For `read--expression', the usual global mode mechanism of ;; `change-major-mode-hook' runs in the minibuffer before diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el index 0f83528bae5..61dba3f244d 100644 --- a/lisp/epa-hook.el +++ b/lisp/epa-hook.el @@ -99,11 +99,10 @@ interface, update `file-name-handler-alist'." (define-minor-mode auto-encryption-mode "Toggle automatic file encryption/decryption (Auto Encryption mode)." :global t :init-value t :group 'epa-file :version "23.1" - ;; We'd like to use custom-initialize-set here so the setup is done - ;; before dumping, but at the point where the defcustom is evaluated, + ;; At the point where the defcustom is evaluated, ;; the corresponding function isn't defined yet, so - ;; custom-initialize-set signals an error. - :initialize 'custom-initialize-delay + ;; custom-initialize-set would signal an error. + :initialize #'custom-initialize-after-file-load (setq file-name-handler-alist (delq epa-file-handler file-name-handler-alist)) (remove-hook 'find-file-hook 'epa-file-find-file-hook) diff --git a/lisp/font-core.el b/lisp/font-core.el index 7c8230f54e7..41bdb94085c 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -270,9 +270,7 @@ means that Font Lock mode is turned on for buffers in C and C++ modes only." (define-globalized-minor-mode global-font-lock-mode font-lock-mode turn-on-font-lock-if-desired - ;; What was this :extra-args thingy for? --Stef - ;; :extra-args (dummy) - :initialize 'custom-initialize-delay + :initialize #'custom-initialize-delay :init-value (not (or noninteractive emacs-basic-display)) :group 'font-lock :version "22.1") diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 29628fcb831..bd20d757340 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2349,7 +2349,7 @@ Runs of equal candidate strings are eliminated. GROUP-FUN is a (goto-char (point-max)) (recenter -1))))) (remove-hook 'window-scroll-functions - 'completion--lazy-insert-strings-on-scroll t)) + #'completion--lazy-insert-strings-on-scroll t)) (defun completion--lazy-insert-strings (&optional button) (setq button (or button completions--lazy-insert-button)) @@ -5617,7 +5617,7 @@ and make sexp navigation more intuitive. The list of prompts activating this mode in specific minibuffer interactions is customizable via `minibuffer-regexp-prompts'." :global t - :initialize #'custom-initialize-delay + :initialize #'custom-initialize-after-file-load :init-value t (if minibuffer-regexp-mode (progn @@ -5711,7 +5711,7 @@ Use the face `minibuffer-nonselected' to highlight the contents of the minibuffer window when the minibuffer remains active but its window is no longer selected." :global t - :initialize #'custom-initialize-delay + :initialize #'custom-initialize-after-file-load :init-value t :version "31.1" (if minibuffer-nonselected-mode diff --git a/lisp/paren.el b/lisp/paren.el index 5a70e2771b3..a286811b74b 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -155,7 +155,7 @@ this mode is enabled in. This is a global minor mode. To toggle the mode in a single buffer, use `show-paren-local-mode'." :global t :group 'paren-showing - :initialize 'custom-initialize-delay + :initialize #'custom-initialize-after-file-load :init-value t ;; Enable or disable the mechanism. ;; First get rid of the old idle timer. diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el index 0cbdf57b4c8..6db466b72c6 100644 --- a/lisp/rfn-eshadow.el +++ b/lisp/rfn-eshadow.el @@ -214,11 +214,10 @@ ignored (because the result is passed through `file-name-shadow-properties', which can be used to make that portion dim, invisible, or otherwise less visually noticeable." :global t - ;; We'd like to use custom-initialize-set here so the setup is done - ;; before dumping, but at the point where the defcustom is evaluated, + ;; At the point where the defcustom is evaluated, ;; the corresponding function isn't defined yet, so ;; custom-initialize-set signals an error. - :initialize 'custom-initialize-delay + :initialize #'custom-initialize-after-file-load :init-value t :group 'minibuffer :version "22.1" diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 51a9841b49f..cbea89906fd 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -53,19 +53,19 @@ echo area, instead of making a pop-up window." ;; Even if we start on a text-only terminal, make this non-nil by ;; default because we can open a graphical frame later (multi-tty). :init-value t - :initialize 'custom-initialize-delay + :initialize #'custom-initialize-after-file-load :group 'tooltip (if (and tooltip-mode (fboundp 'x-show-tip)) (progn - (add-hook 'pre-command-hook 'tooltip-hide) - (add-hook 'tooltip-functions 'tooltip-help-tips) - (add-hook 'x-pre-popup-menu-hook 'tooltip-hide)) + (add-hook 'pre-command-hook #'tooltip-hide) + (add-hook 'tooltip-functions #'tooltip-help-tips) + (add-hook 'x-pre-popup-menu-hook #'tooltip-hide)) (unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode) - (remove-hook 'pre-command-hook 'tooltip-hide) - (remove-hook 'x-pre-popup-menu-hook 'tooltip-hide)) - (remove-hook 'tooltip-functions 'tooltip-help-tips)) + (remove-hook 'pre-command-hook #'tooltip-hide) + (remove-hook 'x-pre-popup-menu-hook #'tooltip-hide)) + (remove-hook 'tooltip-functions #'tooltip-help-tips)) (setq show-help-function - (if tooltip-mode 'tooltip-show-help 'tooltip-show-help-non-mode))) + (if tooltip-mode #'tooltip-show-help #'tooltip-show-help-non-mode))) ;;; Customizable settings commit 100963b492e42f0ed50b65aa32788ee65a68d3ed Author: Eli Zaretskii Date: Wed Oct 22 19:03:53 2025 +0300 ; * src/frame.c (frame_get): Fix a thinko. diff --git a/src/frame.c b/src/frame.c index f61ecc8d083..01e21d323ae 100644 --- a/src/frame.c +++ b/src/frame.c @@ -172,7 +172,7 @@ frame_get (Lisp_Object name) Lisp_Object _list_var, frame; FOR_EACH_FRAME (_list_var, frame) - if (Fstring_equal (XFRAME (frame)->name, name)) + if (!NILP (Fstring_equal (XFRAME (frame)->name, name))) return frame; return Qnil; } commit 1a75481932e3e23eaab1b6ad1b2cbb7535a6a312 Author: Alan Mackenzie Date: Wed Oct 22 12:44:34 2025 +0000 Allow renaming of frames to F on text terminals This fixes bug#79649. Creating duplicate names F is prevented, ensuring that select-frame-by-name is still effective on text terminals. * src/frame.c (frame_get, frame_next_F_name): New functions. (make_terminal_frame): Use frame_next_F_name. (set_term_frame_name): In place of disallowing F, check that the requested F doesn't already exist. * etc/NEWS (Frames): Add an entry for this amendment. diff --git a/etc/NEWS b/etc/NEWS index 1bfdc326a66..de959aed9f3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -435,6 +435,11 @@ This will inhibit implied resizing while a new frame is made and can be useful on tiling window managers where the initial frame size should be specified by external means. +--- +*** Frames can now be renamed to F on text terminals. +Unlike with other frame names, an attempt to rename to F throws +an error when a frame of that name already exists. + ** Mode Line +++ diff --git a/src/frame.c b/src/frame.c index 6a93945ce33..f61ecc8d083 100644 --- a/src/frame.c +++ b/src/frame.c @@ -163,6 +163,20 @@ check_tty (struct frame *f) error ("tty frame should be used"); } +/* Return a frame with the given NAME (a string) or nil. Note that if + there are several frames with this NAME, the first found is returned. + This function was inspired by Fget_buffer. */ +static Lisp_Object +frame_get (Lisp_Object name) +{ + Lisp_Object _list_var, frame; + + FOR_EACH_FRAME (_list_var, frame) + if (Fstring_equal (XFRAME (frame)->name, name)) + return frame; + return Qnil; +} + /* Return the value of frame parameter PROP in frame FRAME. */ Lisp_Object @@ -1288,6 +1302,20 @@ make_minibuffer_frame (void) static intmax_t tty_frame_count; +static Lisp_Object +frame_next_F_name (void) +{ + char string_name[24]; + Lisp_Object list, frame; + + next_name: sprintf (string_name, "F%"PRIdMAX, ++tty_frame_count); + FOR_EACH_FRAME (list, frame) + if (!NILP (XFRAME (frame)->name) + && !strcmp (string_name, SSDATA (XFRAME (frame)->name))) + goto next_name; + return build_string (string_name); +} + struct frame * make_initial_frame (void) { @@ -1427,7 +1455,7 @@ make_terminal_frame (struct terminal *terminal, Lisp_Object parent, XSETFRAME (frame, f); Vframe_list = Fcons (frame, Vframe_list); - fset_name (f, make_formatted_string ("F%"PRIdMAX, ++tty_frame_count)); + fset_name (f, frame_next_F_name()); SET_FRAME_VISIBLE (f, true); @@ -3664,8 +3692,7 @@ set_term_frame_name (struct frame *f, Lisp_Object name) before we do any consing. */ if (frame_name_fnn_p (SSDATA (f->name), SBYTES (f->name))) return; - - name = make_formatted_string ("F%"PRIdMAX, ++tty_frame_count); + name = frame_next_F_name (); } else { @@ -3675,10 +3702,11 @@ set_term_frame_name (struct frame *f, Lisp_Object name) if (! NILP (Fstring_equal (name, f->name))) return; - /* Don't allow the user to set the frame name to F, so it - doesn't clash with the names we generate for terminal frames. */ - if (frame_name_fnn_p (SSDATA (name), SBYTES (name))) - error ("Frame names of the form F are usurped by Emacs"); + /* Stop the user setting the name to F if it is already in use. */ + if (frame_name_fnn_p (SSDATA (name), SBYTES (name)) + && !NILP (frame_get (name))) + error ("Frame of the form F named `%s' already exists", + SSDATA (name)); } fset_name (f, name); commit 6a3d22f3a05e80eea6b8fec66c2b8dfbd358cea9 Author: Mattias Engdegård Date: Wed Oct 22 09:02:08 2025 +0200 ; * src/lisp.h (struct Lisp_String): mention terminating NUL diff --git a/src/lisp.h b/src/lisp.h index 8da5f4f1475..e7b15069f00 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1579,6 +1579,9 @@ struct Lisp_String ptrdiff_t size_byte; INTERVAL intervals; /* Text properties in this string. */ + /* The data is always followed by a NUL, not included in size or + size_byte, for C interoperability, but may also contain NULs + itself. */ unsigned char *data; } s; struct Lisp_String *next; commit ef58006feee208912a1881822a78065538f89a65 Author: Elías Gabriel Pérez Date: Wed Oct 22 09:42:29 2025 +0300 ; * lisp/progmodes/hideshow.el: More fixes for recent changes. (hs-discard-overlays, hs-show-block): Fix the case when `hs-allow-nesting` is enabled (bug#79616). diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index bbe42a7de91..6158253ee53 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -632,7 +632,7 @@ Skip \"internal\" overlays if `hs-allow-nesting' is non-nil." (when (< to from) (setq from (prog1 to (setq to from)))) (if hs-allow-nesting - (let (ov) + (let ((from from) ov) (while (> to (setq from (next-overlay-change from))) (when (setq ov (hs-overlay-at from)) (setq from (overlay-end ov)) @@ -1233,14 +1233,17 @@ See documentation for functions `hs-hide-block' and `run-hooks'." (or ;; first see if we have something at the end of the line (let ((ov (hs-overlay-at (line-end-position))) - (here (point))) + (here (point)) + ov-start ov-end) (when ov (goto-char (cond (end (overlay-end ov)) ((eq 'comment (overlay-get ov 'hs)) here) (t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset))))) + (setq ov-start (overlay-start ov)) + (setq ov-end (overlay-end ov)) (delete-overlay ov) - (hs--refresh-indicators (overlay-start ov) (overlay-end ov)) + (hs--refresh-indicators ov-start ov-end) t)) ;; not immediately obvious, look for a suitable block (let ((c-reg (hs-inside-comment-p)) commit 1b5fef63b483fba9908543da39365bd522ad6e4a Author: F. Jason Park Date: Mon Oct 20 20:47:41 2025 -0700 Release ERC 5.6.1 * lisp/erc/erc.el: Change "Version" header from 5.6.1-git to 5.6.1. A `customize-package-emacs-version-alist' mapping to Emacs 31.1 was already added at some point during the course of development for this release. The ERCVER variable in doc/misc/erc.texi was updated when moving to the "-git" suffixed version. (erc-version): Change version from 5.6.1-git to 5.6.1. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 6ebb137311b..91c0c8f3ecc 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -12,7 +12,7 @@ ;; David Edmondson (dme@dme.org) ;; Michael Olson (mwolson@gnu.org) ;; Kelvin White (kwhite@gnu.org) -;; Version: 5.6.1-git +;; Version: 5.6.1 ;; Package-Requires: ((emacs "27.1") (compat "29.1.4.5")) ;; Keywords: IRC, chat, client, Internet ;; URL: https://www.gnu.org/software/emacs/erc.html @@ -70,7 +70,7 @@ (require 'auth-source) (eval-when-compile (require 'subr-x)) -(defconst erc-version "5.6.1-git" +(defconst erc-version "5.6.1" "This version of ERC.") (defvar erc-official-location commit 61f4d97a0b58a527feb01424a6696d9b560f106f Author: F. Jason Park Date: Thu Oct 16 19:41:37 2025 -0700 ; Remove unwanted noise from ERC test output Omit newlines and other stray chars, such as "^G", from log output when running tests for ERC non-interactively. * test/lisp/erc/erc-match-tests.el (erc-add-entry-to-list, erc-pals) (erc-fools, erc-keywords, erc-dangerous-hosts): Make `inhibit-message' non-nil when `noninteractive'. * test/lisp/erc/erc-sasl-tests.el (erc-sasl--read-password--basic): Make `inhibit-message' non-nil when `noninteractive'. * test/lisp/erc/erc-scenarios-base-buffer-display.el (erc-scenarios-base-buffer-display--interactive-default): Make `inhibit-message' non-nil when `noninteractive'. * test/lisp/erc/erc-scenarios-services-misc.el (erc-scenarios-services-prompt): Make `inhibit-message' non-nil when `noninteractive'. * test/lisp/erc/erc-services-tests.el (erc-nickserv-get-password): Make `inhibit-message' non-nil when `noninteractive'. * test/lisp/erc/erc-stamp-tests.el (erc-timestamp-intangible--left): Make `inhibit-message' non-nil when `noninteractive'. * test/lisp/erc/erc-tests.el (erc-cmd-UNIGNORE, erc-hide-prompt) (erc--check-prompt-input-for-excess-lines, erc-select-read-args, erc-tls) (erc--interactive, erc-server-select): Make `inhibit-message' non-nil when `noninteractive'. (erc--modify-local-map): Inhibit call to `ding' because it inserts an 07 char, which shows up in the test result logs. diff --git a/test/lisp/erc/erc-match-tests.el b/test/lisp/erc/erc-match-tests.el index 09a5394fb3c..e25adc5e03c 100644 --- a/test/lisp/erc/erc-match-tests.el +++ b/test/lisp/erc/erc-match-tests.el @@ -33,6 +33,7 @@ (ert-skip "Freezes on Android as of 31.0.50")) (let ((erc-pals '("z")) + (inhibit-message noninteractive) (erc-match-quote-when-adding 'ask)) (ert-info ("Default (ask)") @@ -83,6 +84,7 @@ (erc-add-server-user "tester" (make-erc-server-user :nickname "tester")) (let ((erc-match-quote-when-adding t) + (inhibit-message noninteractive) erc-pals calls rvs) (cl-letf (((symbol-function 'completing-read) (lambda (&rest r) (push r calls) (pop rvs)))) @@ -117,6 +119,7 @@ (erc-add-server-user "tester" (make-erc-server-user :nickname "tester")) (let ((erc-match-quote-when-adding t) + (inhibit-message noninteractive) erc-fools calls rvs) (cl-letf (((symbol-function 'completing-read) (lambda (&rest r) (push r calls) (pop rvs)))) @@ -145,6 +148,7 @@ (ert-deftest erc-keywords () (let ((erc-match-quote-when-adding t) + (inhibit-message noninteractive) erc-keywords calls rvs) (cl-letf (((symbol-function 'completing-read) (lambda (&rest r) (push r calls) (pop rvs)))) @@ -172,6 +176,7 @@ (ert-deftest erc-dangerous-hosts () (let ((erc-match-quote-when-adding t) + (inhibit-message noninteractive) erc-dangerous-hosts calls rvs) (cl-letf (((symbol-function 'completing-read) (lambda (&rest r) (push r calls) (pop rvs)))) diff --git a/test/lisp/erc/erc-sasl-tests.el b/test/lisp/erc/erc-sasl-tests.el index 29fc7bef033..ba8a5b68830 100644 --- a/test/lisp/erc/erc-sasl-tests.el +++ b/test/lisp/erc/erc-sasl-tests.el @@ -44,6 +44,7 @@ (ert-info ("Prompt when no authfn and :password resolves to nil") (let ((erc-session-password nil) + (inhibit-message noninteractive) (erc-sasl--options '((password . :password) (user . :user) (authfn)))) (should (string= (ert-simulate-keys "bar\r" @@ -52,7 +53,8 @@ (ert-info ("Prompt when auth-source fails and `erc-session-password' null") (should-not erc-session-password) - (let ((erc-sasl--options '((password) (authfn . ignore)))) + (let ((inhibit-message noninteractive) + (erc-sasl--options '((password) (authfn . ignore)))) (should (string= (ert-simulate-keys "baz\r" (erc-sasl--read-password "pwd:")) "baz"))))) diff --git a/test/lisp/erc/erc-scenarios-base-buffer-display.el b/test/lisp/erc/erc-scenarios-base-buffer-display.el index f56eab2b499..d816fee578b 100644 --- a/test/lisp/erc/erc-scenarios-base-buffer-display.el +++ b/test/lisp/erc/erc-scenarios-base-buffer-display.el @@ -230,7 +230,8 @@ (erc-user-full-name "tester")) (ert-info ("Connect to foonet") - (with-current-buffer (let (inhibit-interaction) + (with-current-buffer (let ((inhibit-message noninteractive) + (inhibit-interaction nil)) (ert-simulate-keys url (call-interactively #'erc))) (should (string= (buffer-name) (format "127.0.0.1:%d" port))) diff --git a/test/lisp/erc/erc-scenarios-services-misc.el b/test/lisp/erc/erc-scenarios-services-misc.el index 13d66a54d3a..6cb132b192e 100644 --- a/test/lisp/erc/erc-scenarios-services-misc.el +++ b/test/lisp/erc/erc-scenarios-services-misc.el @@ -73,11 +73,12 @@ :nick "tester" :full-name "tester") (should (string= (buffer-name) (format "127.0.0.1:%d" port))) - (ert-simulate-keys "changeme\r" - (erc-d-t-wait-for 10 (eq erc-network 'Libera.Chat)) - (funcall expect 3 "This nickname is registered.") - (funcall expect 3 "You are now identified") - (funcall expect 3 "Last login from")) + (let ((inhibit-message noninteractive)) + (ert-simulate-keys "changeme\r" + (erc-d-t-wait-for 10 (eq erc-network 'Libera.Chat)) + (funcall expect 3 "This nickname is registered.") + (funcall expect 3 "You are now identified") + (funcall expect 3 "Last login from"))) (erc-cmd-QUIT ""))) (erc-services-mode -1) diff --git a/test/lisp/erc/erc-services-tests.el b/test/lisp/erc/erc-services-tests.el index 941dff1761b..43c7b531f92 100644 --- a/test/lisp/erc/erc-services-tests.el +++ b/test/lisp/erc/erc-services-tests.el @@ -558,6 +558,7 @@ (erc-server-current-nick "tester") (erc-networks--id (erc-networks--id-create nil)) (erc-session-port 6697) + (inhibit-message noninteractive) (search (erc-services-tests--wrap-search #'erc-nickserv-get-password))) diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index bf4ce7b9569..dc3332460d0 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -226,6 +226,7 @@ (erc-hide-timestamps t) (erc-insert-timestamp-function 'erc-insert-timestamp-left) (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp)) + (inhibit-message noninteractive) msg erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) (should (not cursor-sensor-inhibit)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 2279496e600..5eb084c48ee 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -68,8 +68,9 @@ (erc-tests-common-make-server-buf) (setq erc-ignore-list (list ".")) ; match anything - (ert-simulate-keys (list ?\r) - (erc-cmd-IGNORE "abc")) + (let ((inhibit-message noninteractive)) + (ert-simulate-keys (list ?\r) + (erc-cmd-IGNORE "abc"))) (should (equal erc-ignore-list (list "abc" "."))) (cl-letf (((symbol-function 'y-or-n-p) #'always)) @@ -179,6 +180,7 @@ (ert-deftest erc-hide-prompt () (let ((erc-hide-prompt erc-hide-prompt) + (inhibit-message noninteractive) ;; erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) @@ -1317,16 +1319,17 @@ (setq calls nil) (ert-info ("Remove existing") - (ert-with-message-capture messages - (erc--modify-local-map nil "C-c C-c" cmd-foo "C-c C-k" cmd-bar) - (with-temp-buffer - (set-window-buffer (selected-window) (current-buffer)) - (use-local-map erc-mode-map) + (erc--modify-local-map nil "C-c C-c" cmd-foo "C-c C-k" cmd-bar) + (with-temp-buffer + (set-window-buffer (selected-window) (current-buffer)) + (use-local-map erc-mode-map) + (cl-letf (((symbol-function 'undefined) + (lambda () + (push (key-description (this-single-command-keys)) + calls)))) (execute-kbd-macro "\C-c\C-c") - (execute-kbd-macro "\C-c\C-k")) - (should (string-search "C-c C-c is undefined" messages)) - (should (string-search "C-c C-k is undefined" messages)) - (should-not calls))))) + (execute-kbd-macro "\C-c\C-k"))) + (should (equal calls '("C-c C-k" "C-c C-c")))))) (ert-deftest erc-ring-previous-command-base-case () (ert-info ("Create ring when nonexistent and do nothing") @@ -1811,6 +1814,7 @@ (ert-info ("With `erc-ask-about-multiline-input'") (let ((erc-inhibit-multiline-input t) + (inhibit-message noninteractive) (erc-ask-about-multiline-input t)) (ert-simulate-keys '(?n ?\r ?y ?\r) (should (erc--check-prompt-input-for-excess-lines "" '("a" "b"))) @@ -3107,8 +3111,9 @@ (ert-deftest erc-select-read-args () (ert-info ("Prompts for switch to TLS by default") - (should (equal (ert-simulate-keys "\r\r\r\ry\r" - (erc-select-read-args)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-keys "\r\r\r\ry\r" + (erc-select-read-args))) (list :server "irc.libera.chat" :port 6697 :nick (user-login-name) @@ -3117,8 +3122,9 @@ (erc-join-buffer . window)))))) (ert-info ("Switches to TLS when port matches default TLS port") - (should (equal (ert-simulate-keys "irc.gnu.org\r6697\r\r\r" - (erc-select-read-args)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-keys "irc.gnu.org\r6697\r\r\r" + (erc-select-read-args))) (list :server "irc.gnu.org" :port 6697 :nick (user-login-name) @@ -3128,8 +3134,9 @@ (ert-info ("Switches to TLS when URL is ircs://") (let ((erc--display-context '((erc-interactive-display . erc)))) - (should (equal (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r" - (erc-select-read-args)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r" + (erc-select-read-args))) (list :server "irc.gnu.org" :port 6697 :nick (user-login-name) @@ -3143,67 +3150,76 @@ (setq-local erc-interactive-display nil) ; cheat to save space (ert-info ("Opt out of non-TLS warning manually") - (should (equal (ert-simulate-keys "\r\r\r\rn\r" - (erc-select-read-args)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-keys "\r\r\r\rn\r" + (erc-select-read-args))) (list :server "irc.libera.chat" :port 6667 :nick (user-login-name))))) (ert-info ("Override default TLS") - (should (equal (ert-simulate-keys "irc://irc.libera.chat\r\r\r\r" - (erc-select-read-args)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-keys "irc://irc.libera.chat\r\r\r\r" + (erc-select-read-args))) (list :server "irc.libera.chat" :port 6667 :nick (user-login-name))))) (ert-info ("Address includes port") - (should (equal (ert-simulate-keys "localhost:6667\rnick\r\r" - (erc-select-read-args)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-keys "localhost:6667\rnick\r\r" + (erc-select-read-args))) (list :server "localhost" :port 6667 :nick "nick")))) (ert-info ("Address includes nick, password skipped via option") - (should (equal (ert-simulate-keys "nick@localhost:6667\r" - (let (erc-prompt-for-password) - (erc-select-read-args))) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-keys "nick@localhost:6667\r" + (let (erc-prompt-for-password) + (erc-select-read-args)))) (list :server "localhost" :port 6667 :nick "nick")))) (ert-info ("Address includes nick and password") - (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r\r" - (erc-select-read-args)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-keys "nick:sesame@localhost:6667\r\r" + (erc-select-read-args))) (list :server "localhost" :port 6667 :nick "nick" :password "sesame")))) (ert-info ("IPv6 address plain") - (should (equal (ert-simulate-keys "::1\r\r\r\r" - (erc-select-read-args)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-keys "::1\r\r\r\r" + (erc-select-read-args))) (list :server "[::1]" :port 6667 :nick (user-login-name))))) (ert-info ("IPv6 address with port") - (should (equal (ert-simulate-keys "[::1]:6667\r\r\r" - (erc-select-read-args)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-keys "[::1]:6667\r\r\r" + (erc-select-read-args))) (list :server "[::1]" :port 6667 :nick (user-login-name))))) (ert-info ("IPv6 address includes nick") - (should (equal (ert-simulate-keys "nick@[::1]:6667\r\r" - (erc-select-read-args)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-keys "nick@[::1]:6667\r\r" + (erc-select-read-args))) (list :server "[::1]" :port 6667 :nick "nick")))) (ert-info ("Extra args use URL nick by default") - (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r\r\r\r" - (let ((current-prefix-arg '(4))) - (erc-select-read-args))) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-keys "nick:sesame@localhost:6667\r\r\r\r" + (let ((current-prefix-arg '(4))) + (erc-select-read-args)))) (list :server "localhost" :port 6667 :nick "nick" @@ -3213,7 +3229,8 @@ (ert-deftest erc-tls () (let (calls env) - (cl-letf (((symbol-function 'user-login-name) + (cl-letf ((inhibit-message noninteractive) + ((symbol-function 'user-login-name) (lambda (&optional _) "tester")) ((symbol-function 'erc-open) (lambda (&rest r) @@ -3329,7 +3346,8 @@ (ert-deftest erc--interactive () (let (calls env) - (cl-letf (((symbol-function 'user-login-name) + (cl-letf ((inhibit-message noninteractive) + ((symbol-function 'user-login-name) (lambda (&optional _) "tester")) ((symbol-function 'erc-open) (lambda (&rest r) @@ -3365,7 +3383,8 @@ (ert-deftest erc-server-select () (let (calls env) - (cl-letf (((symbol-function 'user-login-name) + (cl-letf ((inhibit-message noninteractive) + ((symbol-function 'user-login-name) (lambda (&optional _) "tester")) ((symbol-function 'erc-open) (lambda (&rest r) commit 9a56cf9194cc9132d61d2bbccde48f5ea5e7e34b Author: Stephen Berman Date: Wed Oct 22 00:06:03 2025 +0200 Improve Dired handling of file names with newlines (bug#79528) * doc/emacs/dired.texi (Dired Enter): Update documentation of Dired's display and handling of file names that contain newlines. Document new user option 'dired-auto-toggle-b-switch'. * etc/NEWS: Announce new warning and new user option. * lisp/dired.el (dired-auto-toggle-b-switch): New user option. (dired-internal-noselect): Pop up a warning if the Dired listing displays a literal newline. (dired-switches-escape-p): Take the 'ls' switch '--quoting-style=escape' into account. (dired-mode): Add 'dired--toggle-b-switch' to 'post-command-hook'. (dired-move-to-end-of-filename): When the Dired listing includes a file name containing a newline, this can result in no change in the 'dired-filename' text property on the last file name, so in this case take the position just before the final newline as the end of the last file name to prevent a wrong-type-argument error. (dired--filename-with-newline-p, dired--remove-b-switch) (dired--toggle-b-switch, dired--set-auto-toggle-b-switch) (dired--display-filename-with-newline-warning): New functions. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 7ff43a3c4ac..599c0308cec 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -136,15 +136,57 @@ options (that is, single characters) requiring no arguments, and long options (starting with @samp{--}) whose arguments are specified with @samp{=}. - Dired does not handle files that have names with embedded newline -characters well. If you have many such files, you may consider adding -@samp{-b} to @code{dired-listing-switches}. This will quote all -special characters and allow Dired to handle them better. (You can -also use the @kbd{C-u C-x d} command to add @samp{-b} temporarily.) - -@code{dired-listing-switches} can be declared as connection-local -variable to adjust it to match what a remote system expects -(@pxref{Connection Variables}). +You can declare @code{dired-listing-switches} as a connection-local +variable in order to adjust its value to match what a remote system +expects (@pxref{Connection Variables}). + +@cindex file names with newline character in Dired +@cindex newline character in file names in Dired +@anchor{File names with newline} + When a file name contains a newline character, Dired displays it by +default as a literal newline, so the display of this file name occupies +more than one line in the Dired buffer. If you invoke a Dired operation +on such a file listing, in many cases it will fail and signal an error. +For this reason, when Dired displays a file name containing a literal +newline, Emacs recognizes this and automatically pops up a buffer with +an informative warning. For such file names, Dired offers an +alternative display, using the @command{ls} switch @samp{-b}, in which +newline characters are represented by @samp{\n} and the Dired listing of +the file occupies one line as usual, so you can execute all applicable +Dired operations on it.@footnote{Note that with the @samp{-b} switch +Dired displays tab characters in file names as @samp{\t} and escapes +other control characters and also spaces in file names with @samp{\}.} + + Emacs provides two different ways to make Dired use the @samp{-b} +switch: + +@itemize @bullet +@item +You can add @samp{-b} to @code{dired-listing-switches} before invoking +@code{dired}. Since this variable is a user option, you can alter its +value persistently either by using the Customization interface +(@pxref{Saving Customizations}) or by using the @code{setopt} macro in +your initialization file (@pxref{Examining}).@footnote{If +@code{dired-listing-switches} contains @samp{-b} when you invoke dired +on a directory containing a file name with a newline, the newline is +displayed as @samp{\n}, so Emacs will not pop up a warning.} You can +also add @samp{-b} just for the next @code{dired} invocation by typing +@kbd{C-u C-x d}. + +@item +@vindex dired-auto-toggle-b-switch +If you enable the user option @code{dired-auto-toggle-b-switch}, then +when you visit a directory containing a file whose name has a newline, +Emacs will automatically add the @samp{-b} switch and redisplay the +directory in Dired to show @samp{\n} in the file name. If you edit the +file name and remove the @samp{\n} character, then on completing the +edit Emacs automatically removes the @samp{-b} switch and redisplays the +Dired buffer, so that file names with tab or space characters now show +literal spaces without a backslash. If you enable or disable +@code{dired-auto-toggle-b-switch} after visiting a directory containing +a file name with a newline, Emacs will add or remove the @samp{-b} +switch as appropriate and automatically redisplay the Dired buffer. +@end itemize @vindex dired-switches-in-mode-line Dired displays in the mode line an indication of what were the diff --git a/etc/NEWS b/etc/NEWS index 59807789e9d..1bfdc326a66 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2042,6 +2042,24 @@ name of the directory now reverts the Dired buffer. With a new value of the prefix argument (1), this command copies file names relative to the root directory of the current project. ++++ +*** Warning when Dired displays a file name with a literal newline. +On visiting a directory that contains a file whose name has a newline, +and Dired displays that character as a literal newline, Emacs now +automatically pops up a buffer warning that such a display can be +problematic for Dired and showing a way to change the display to use the +unproblematic character '\n'. + ++++ +*** New user option 'dired-auto-toggle-b-switch'. +When this user option is non-nil and 'dired-listing-switches' does not +include the '-b' switch, then on visiting a directory containing a file +whose name has a newline, Emacs automatically adds the '-b' switch and +redisplays the directory in Dired to show '\n' in the file name instead +of a literal newline. This prevents executing many Dired operations on +such a file from failing and signaling an error. The default value of +this user option is nil. + ** Grep +++ diff --git a/lisp/dired.el b/lisp/dired.el index 258e0550a7d..e400bccebd1 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -550,6 +550,16 @@ displayed instead." :group 'dired :version "30.1") +(defcustom dired-auto-toggle-b-switch nil + "Whether to automatically add or remove the `b' switch. +If non-nil, the function `dired--toggle-b-switch' (which see) is added +to `post-command-hook' in Dired mode." + :type 'boolean + :group 'dired + :initialize #'custom-initialize-default + :set #'dired--set-auto-toggle-b-switch + :version "31.1") + ;;; Internal variables @@ -1437,6 +1447,16 @@ The return value is the target column for the file names." (dired-initial-position dirname)) (when (consp dired-directory) (dired--align-all-files)) + ;; Pop up a warning if the Dired listing displays a literal newline. + ;; We do this here in order to get the warning not only when + ;; interactively invoking `dired' on a directory, but also e.g. when + ;; passing the directory name as a command line argument when + ;; starting Emacs from the shell. + (unless (or dired-auto-toggle-b-switch + (dired-switches-escape-p dired-listing-switches) + (dired-switches-escape-p dired-actual-switches)) + (when (dired--filename-with-newline-p) + (dired--display-filename-with-newline-warning buffer))) (set-buffer old-buf) buffer)) @@ -1699,7 +1719,7 @@ BEG..END is the line where the file info is located." (defun dired-switches-escape-p (switches) "Return non-nil if the string SWITCHES contains -b or --escape." ;; Do not match things like "--block-size" that happen to contain "b". - (dired-check-switches switches "b" "escape")) + (dired-check-switches switches "b" "\\(quoting-style=\\)?escape")) (defun dired-switches-recursive-p (switches) "Return non-nil if the string SWITCHES contains -R or --recursive." @@ -2855,6 +2875,8 @@ Keybindings: (add-hook 'file-name-at-point-functions #'dired-file-name-at-point nil t) (add-hook 'isearch-mode-hook #'dired-isearch-filenames-setup nil t) (add-hook 'context-menu-functions 'dired-context-menu 5 t) + (when dired-auto-toggle-b-switch + (add-hook 'post-command-hook #'dired--toggle-b-switch nil t)) (run-mode-hooks 'dired-mode-hook)) @@ -3439,7 +3461,14 @@ If EOL, it should be an position to use instead of ;; On failure, signals an error (with non-nil NO-ERROR just returns nil). ;; This is the UNIX version. (if (get-text-property (point) 'dired-filename) - (goto-char (next-single-property-change (point) 'dired-filename)) + (goto-char (or (next-single-property-change (point) 'dired-filename) + ;; No property change can happen on or before the + ;; last file name in the Dired listing when there + ;; is at least one prior file name containing a + ;; newline. To prevent an error in this case we + ;; take the position just before the final newline + ;; as the end of the last file name (bug#79528). + (1- (point-max)))) (let ((opoint (point)) (used-F (dired-check-switches dired-actual-switches "F" "classify")) (eol (line-end-position)) @@ -3973,6 +4002,98 @@ Considers buffers closer to the car of `buffer-list' to be more recent." (memq buffer1 (buffer-list)) (not (memq buffer1 (memq buffer2 (buffer-list)))))) +(defun dired--filename-with-newline-p () + "Check if a file name in this directory has a newline. +Return non-nil if at least one file name in this directory contains +either a literal newline or the string \"\\n\")." + (save-excursion + (goto-char (point-min)) + (catch 'found + (while (not (eobp)) + (when (dired-move-to-filename) + (let ((fn (buffer-substring-no-properties + (point) (dired-move-to-end-of-filename)))) + (when (or (memq 10 (seq-into fn 'list)) + (string-search "\\n" fn)) + (throw 'found t)))) + (forward-line))))) + +(defun dired--remove-b-switch () + "Remove all variants of the `b' switch from `dired-actual-switches'. +This removes not only all occurrences of the short form `-b' but also +the long forms `--escape' and `--quoting-style=escape'." + (let (switches) + (dolist (s (string-split dired-actual-switches)) + (when (string-match "\\`-[^-]" s) + (setq s (remove ?b s))) + (unless (or (string= s "-") + (string-match "escape" s)) + (cl-pushnew s switches :test 'equal))) + (mapconcat #'identity (nreverse switches) " "))) + +(defun dired--toggle-b-switch () + "Add or remove `b' switch and redisplay Dired buffer. +When the current Dired buffer has a file name containing a newline, add +the `b' switch to the actual switches if it isn't already among them; +otherwise remove the `b' switch unless it is in `dired-listing-switches'. +Then redisplay the Dired buffer. This function is called from +`post-command-hook' in Dired mode buffers." + (when (eq major-mode 'dired-mode) + (if (and (dired--filename-with-newline-p) dired-auto-toggle-b-switch) + (unless (dired-switches-escape-p dired-actual-switches) + (setq dired-actual-switches (concat dired-actual-switches " -b")) + (dired-revert)) + (unless (dired-switches-escape-p dired-listing-switches) + (when (dired-switches-escape-p dired-actual-switches) + (setq dired-actual-switches (dired--remove-b-switch)) + (dired-revert)))))) + +(defun dired--set-auto-toggle-b-switch (symbol value) + "The :set function for user option `dired-auto-toggle-b-switch'." + (custom-set-default symbol value) + (if value + (add-hook 'post-command-hook #'dired--toggle-b-switch nil t) + (remove-hook 'post-command-hook #'dired--toggle-b-switch t)) + (dolist (b (buffer-list)) + (with-current-buffer b + (dired--toggle-b-switch)))) + +(defun dired--display-filename-with-newline-warning (dir) + "Display a warning if buffer DIR has a file name with a newline." + (let ((msg "Literal newline in file name. +This Dired buffer displays a file name containing a literal newline character. +Executing Dired operations on files displayed this way may fail and signal an +error. To avoid this you can temporarily change the display for all Dired +buffers, so that newlines in file names appear as \"\\n\", by typing `M-:' and +entering `(setopt dired-auto-toggle-b-switch t)' in the minibuffer. To change +the display only for this Dired buffer click or press RETURN `%s'. +See `%s' for other alternatives and more information.")) + (display-warning + 'dired + (format-message + msg + (buttonize "here" + (lambda (_) + (pop-to-buffer dir) + (when (dired--filename-with-newline-p) + (unless (dired-switches-escape-p dired-actual-switches) + (setq dired-actual-switches + (concat dired-actual-switches " -b")) + (dired-revert)))) + nil "mouse-2: Change newline display") + (buttonize "(emacs) Dired Enter" + (lambda (_) + (info "(emacs) Dired Enter") + (declare-function Info-goto-node "info") + (with-current-buffer "*info*" + (Info-goto-node "File names with newline"))) + nil "mouse-2: Jump to Info node"))) + ;; Display *Warnings* buffer with point at start of message instead + ;; of at the end. + (with-current-buffer "*Warnings*" + (set-window-point (get-buffer-window) + (search-backward "Warning (dired)"))))) + ;;; Deleting files commit 38c32ed3eaba5b837f302f1810f712f2b6a903f3 Author: Stefan Monnier Date: Tue Oct 21 15:37:38 2025 -0400 (easy-mmode--less-selective-first): Enable test * test/lisp/emacs-lisp/easy-mmode-tests.el (easy-mmode--less-selective-first): Enable test since it now succeeds. diff --git a/test/lisp/emacs-lisp/easy-mmode-tests.el b/test/lisp/emacs-lisp/easy-mmode-tests.el index 2ee849f6e9d..b81b6fae86d 100644 --- a/test/lisp/emacs-lisp/easy-mmode-tests.el +++ b/test/lisp/emacs-lisp/easy-mmode-tests.el @@ -133,10 +133,6 @@ (ert-deftest easy-mmode--less-selective-first () "Test with the less selective globalized mode going first." - ;; FIXME: This case is broken by the introduction of the - ;; MODE-suppress-set-explicitly mechanism. - ;; This test should be re-enabled as part of resolving bug#79624. - :expected-result :failed (easy-mmode-test-globalized-mode-1 -1) (easy-mmode-test-globalized-mode-2 -1) (easy-mmode-test-globalized-mode-1 1) commit 698a584e92d6ab3a1970ed9c92b1564cc75d9e58 Author: Stefan Monnier Date: Tue Oct 21 15:35:36 2025 -0400 (define-globalized-minor-mode): Remove `MODE-mode-name` hack (bug#79624) Stop trying to detect when a globalized mode enabled its minor mode "too early". This reverts the core of commit 876daebc8594 since the problem it tried to circumvent has been made almost impossible by commit 17e26cf57e18. * lisp/emacs-lisp/easy-mmode.el (define-globalized-minor-mode): Remove the `MODE-mode-name` variable, don't remember in which major mode we enabled the minor mode, and don't disable the minor mode before (re)enabling it. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index e87b9269188..c5c95a1be20 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -501,7 +501,6 @@ on if the hook has explicitly disabled it. (MODE-set-explicitly (intern (concat mode-name "--set-explicitly"))) (MODE-suppress-set-explicitly (intern (concat mode-name "--suppress-set-explicitly"))) - (MODE-major-mode (intern (concat global-mode-name "--major-mode"))) (MODE-predicate (intern (concat (replace-regexp-in-string "-mode\\'" "" global-mode-name) "-modes"))) @@ -528,7 +527,6 @@ on if the hook has explicitly disabled it. (progn (put ',global-mode 'globalized-minor-mode t) :autoload-end - (defvar-local ,MODE-major-mode nil) ,@(when predicate `((defvar ,MODE-predicate)))) ;; The actual global minor-mode (define-minor-mode ,global-mode @@ -620,8 +618,7 @@ list." ;; The function that calls TURN-ON in the current buffer. (defun ,MODE-enable-in-buffer () - (unless (or ,MODE-set-explicitly - (eq ,MODE-major-mode major-mode)) + (unless ,MODE-set-explicitly (let (;; We are not part of the major mode hook so we don't ;; want to set MODE-set-explicitly to t. ;; In particular this is necessary when there are @@ -629,12 +626,7 @@ list." ;; If one of them declines to turn the minor mode on, ;; that should not mean the others can't. (,MODE-suppress-set-explicitly t)) - (if (bound-and-true-p ,MODE-variable) - (progn - (,mode -1) - (funcall ,turn-on-function)) - (funcall ,turn-on-function)))) - (setq ,MODE-major-mode major-mode)) + (funcall ,turn-on-function)))) (put ',MODE-enable-in-buffer 'definition-name ',global-mode)))) (defun easy-mmode--globalized-predicate-p (predicate) commit 9f35d1653f5d82e382edd2499197f8c99d81241f Author: Eshel Yaron Date: Tue Oct 21 11:07:08 2025 +0200 ; elisp-scope.el: Fix error during widget args analysis * lisp/emacs-lisp/elisp-scope.el (elisp-scope--match-spec-to-arg): Simplify and fix handling of empty list. * test/lisp/progmodes/elisp-mode-resources/semantic-highlighting.el: Add test. diff --git a/lisp/emacs-lisp/elisp-scope.el b/lisp/emacs-lisp/elisp-scope.el index d90698ae4e3..4a2f1883986 100644 --- a/lisp/emacs-lisp/elisp-scope.el +++ b/lisp/emacs-lisp/elisp-scope.el @@ -2685,8 +2685,7 @@ ARGS bound to the analyzed arguments." (let ((symbols-with-pos-enabled t)) (and (member arg (cdr spec)) t))) (cl-defmethod elisp-scope--match-spec-to-arg ((spec (head plist)) arg) - (cond - ((consp arg) + (when (listp arg) (let ((res nil) (go t)) (while (and arg go) (let* ((key (car arg)) @@ -2695,17 +2694,14 @@ ARGS bound to the analyzed arguments." (push (if (keywordp bkw) '(symbol . constant) t) res) (push (setq go (elisp-scope--match-spec-to-arg (alist-get bkw (cdr spec) t) val)) res)) (setq arg (cddr arg))) - (when go (cons 'list (nreverse res))))) - ((null arg) t))) + (when go (cons 'list (nreverse res)))))) (cl-defmethod elisp-scope--match-spec-to-arg ((spec (head list)) arg) - (cond - ((consp arg) + (when (listp arg) (let ((specs (cdr spec)) (go t) res) (while (and specs (setq go (elisp-scope--match-spec-to-arg (pop specs) (pop arg)))) (push go res)) - (when go (cons 'list (nreverse res))))) - ((null arg) t))) + (when go (cons 'list (nreverse res)))))) (cl-defmethod elisp-scope--match-spec-to-arg ((spec (head plist-and-then)) arg) (cond diff --git a/test/lisp/progmodes/elisp-mode-resources/semantic-highlighting.el b/test/lisp/progmodes/elisp-mode-resources/semantic-highlighting.el index f4f64bae045..f13398412d3 100644 --- a/test/lisp/progmodes/elisp-mode-resources/semantic-highlighting.el +++ b/test/lisp/progmodes/elisp-mode-resources/semantic-highlighting.el @@ -150,6 +150,13 @@ ))) :version "29.1") +;; Taken from browse-url.el: +(defcustom baz-opt 'browse-url-mail + "Baz." + :type '(function-item :tag "Emacs Mail" :value browse-url-mail)) +;; ^ elisp-widget-type +;; ^ (elisp-constant font-lock-builtin-face) + (e-s-analyze-form #'ignore) ;; ^ (elisp-shorthand-font-lock-face elisp-function) ;; ^ elisp-function commit 93dcc342a5b92429fa0294d723db35f9a453cda3 Author: Eshel Yaron Date: Tue Oct 21 08:42:25 2025 +0200 ; Simplify symbol role ':help' functions. * lisp/progmodes/elisp-mode.el (elisp--annotate-symbol-with-help-echo): Take SYM argument instead of DEF. Apply ':help' function partially with SYM instead of calling it. * lisp/emacs-lisp/elisp-scope.el: Adapt ':help' functions. diff --git a/lisp/emacs-lisp/elisp-scope.el b/lisp/emacs-lisp/elisp-scope.el index 848a8030e4d..d90698ae4e3 100644 --- a/lisp/emacs-lisp/elisp-scope.el +++ b/lisp/emacs-lisp/elisp-scope.el @@ -259,14 +259,11 @@ Interactively, prompt for ROLE." (elisp-scope-define-symbol-role free-variable (variable) :doc "Variable names." :face 'elisp-free-variable - :help (lambda (beg end _def) - (if-let* ((sym (intern (buffer-substring-no-properties beg end)))) - (lambda (&rest _) - (let ((val (if (boundp sym) (truncate-string-to-width (prin1-to-string (symbol-value sym)) 60 nil nil t) "#"))) - (if-let* ((doc (documentation-property sym 'variable-documentation t))) - (format "Special variable `%S'.\n\nValue: %s\n\n%s" sym val doc) - (format "Special variable `%S'.\n\nValue: %s" sym val)))) - "Special variable"))) + :help (lambda (sym &rest _) + (let ((val (if (boundp sym) (truncate-string-to-width (prin1-to-string (symbol-value sym)) 60 nil nil t) "#"))) + (if-let* ((doc (documentation-property sym 'variable-documentation t))) + (format "Special variable `%S'.\n\nValue: %s\n\n%s" sym val doc) + (format "Special variable `%S'.\n\nValue: %s" sym val))))) (elisp-scope-define-symbol-role bound-variable (variable) :doc "Local variable names." @@ -291,8 +288,7 @@ Interactively, prompt for ROLE." (elisp-scope-define-symbol-role face () :doc "Face names." :face 'elisp-face - :help (lambda (beg end _def) - (elisp--help-echo beg end 'face-documentation "Face"))) + :help (apply-partially #'elisp--help-echo 'face-documentation "Face")) (elisp-scope-define-symbol-role callable () :doc "Abstract symbol role of function-like symbols.") @@ -300,12 +296,7 @@ Interactively, prompt for ROLE." (elisp-scope-define-symbol-role function (callable) :doc "Function names." :face 'elisp-function - :help (lambda (beg end def) - (cond ((equal beg def) "Local function definition") - (def "Local function call") - (t (if-let* ((sym (intern-soft (buffer-substring-no-properties beg end)))) - (apply-partially #'elisp--function-help-echo sym) - "Function call"))))) + :help #'elisp--function-help-echo) (elisp-scope-define-symbol-role command (function) :doc "Command names.") @@ -317,27 +308,17 @@ Interactively, prompt for ROLE." (elisp-scope-define-symbol-role non-local-exit (function) :doc "Functions that do not return." - :face 'elisp-non-local-exit - :help (lambda (beg end _def) - (if-let* ((sym (intern-soft (buffer-substring-no-properties beg end)))) - (apply-partially #'elisp--function-help-echo sym) - "Non-local exit"))) + :face 'elisp-non-local-exit) (elisp-scope-define-symbol-role macro (callable) :doc "Macro names." :face 'elisp-macro - :help (lambda (beg end _def) - (if-let* ((sym (intern-soft (buffer-substring-no-properties beg end)))) - (apply-partially #'elisp--function-help-echo sym) - "Macro call"))) + :help #'elisp--function-help-echo) (elisp-scope-define-symbol-role special-form (callable) :doc "Special form names." :face 'elisp-special-form - :help (lambda (beg end _def) - (if-let* ((sym (intern-soft (buffer-substring-no-properties beg end)))) - (apply-partially #'elisp--function-help-echo sym) - "Special form"))) + :help #'elisp--function-help-echo) (elisp-scope-define-symbol-role throw-tag () :doc "Symbols used as `throw'/`catch' tags." @@ -422,15 +403,12 @@ Interactively, prompt for ROLE." (elisp-scope-define-symbol-role condition () :doc "`condition-case' conditions." :face 'elisp-condition - :help (lambda (beg end _def) - (if-let* ((sym (intern (buffer-substring-no-properties beg end)))) - (lambda (&rest _) - (let ((msg (get sym 'error-message))) - (apply #'concat - "`condition-case' condition" - (when (and msg (not (string-empty-p msg))) - `(": " ,msg))))) - "`condition-case' condition"))) + :help (lambda (sym &rest _) + (let ((msg (get sym 'error-message))) + (apply #'concat + "`condition-case' condition" + (when (and msg (not (string-empty-p msg))) + `(": " ,msg)))))) (elisp-scope-define-symbol-role defcondition (condition) :doc "`condition-case' condition definitions." @@ -478,12 +456,9 @@ Interactively, prompt for ROLE." (elisp-scope-define-symbol-role major-mode () :doc "Major mode names." :face 'elisp-major-mode-name - :help (lambda (beg end _def) - (if-let* ((sym (intern (buffer-substring-no-properties beg end)))) - (lambda (&rest _) - (if-let* ((doc (documentation sym))) - (format "Major mode `%S'.\n\n%s" sym doc) - "Major mode")) + :help (lambda (sym &rest _) + (if-let* ((doc (documentation sym))) + (format "Major mode `%S'.\n\n%s" sym doc) "Major mode"))) (elisp-scope-define-symbol-role major-mode-definition (major-mode) @@ -492,8 +467,7 @@ Interactively, prompt for ROLE." (elisp-scope-define-symbol-role block () :doc "`cl-block' block names." - :help (lambda (beg _end def) - (if (equal beg def) "Block definition" "Block"))) + :help "Block") (elisp-scope-define-symbol-role icon () :doc "Icon names." @@ -508,12 +482,9 @@ Interactively, prompt for ROLE." (elisp-scope-define-symbol-role oclosure () :doc "OClosure type names." :face 'elisp-oclosure - :help (lambda (beg end _def) - (if-let* ((sym (intern (buffer-substring-no-properties beg end)))) - (lambda (&rest _) - (if-let* ((doc (oclosure--class-docstring (get sym 'cl--class)))) - (format "OClosure type `%S'.\n\n%s" sym doc) - "OClosure type")) + :help (lambda (sym &rest _) + (if-let* ((doc (oclosure--class-docstring (get sym 'cl--class)))) + (format "OClosure type `%S'.\n\n%s" sym doc) "OClosure type"))) (elisp-scope-define-symbol-role defoclosure () @@ -524,12 +495,9 @@ Interactively, prompt for ROLE." (elisp-scope-define-symbol-role coding () :doc "Coding-system names." :face 'elisp-coding - :help (lambda (beg end _def) - (if-let* ((sym (intern (buffer-substring-no-properties beg end)))) - (lambda (&rest _) - (if-let* ((doc (coding-system-doc-string sym))) - (format "Coding-system `%S'.\n\n%s" sym doc) - "Coding-system")) + :help (lambda (sym &rest _) + (if-let* ((doc (coding-system-doc-string sym))) + (format "Coding-system `%S'.\n\n%s" sym doc) "Coding-system"))) (elisp-scope-define-symbol-role defcoding () @@ -540,12 +508,9 @@ Interactively, prompt for ROLE." (elisp-scope-define-symbol-role charset () :doc "Character set names." :face 'elisp-charset - :help (lambda (beg end _def) - (if-let* ((sym (intern (buffer-substring-no-properties beg end)))) - (lambda (&rest _) - (if-let* ((doc (charset-description sym))) - (format "Character set `%S'.\n\n%s" sym doc) - "Character set")) + :help (lambda (sym &rest _) + (if-let* ((doc (charset-description sym))) + (format "Character set `%S'.\n\n%s" sym doc) "Character set"))) (elisp-scope-define-symbol-role defcharset () @@ -556,12 +521,9 @@ Interactively, prompt for ROLE." (elisp-scope-define-symbol-role completion-category () :doc "Completion categories." :face 'elisp-completion-category - :help (lambda (beg end _def) - (if-let* ((sym (intern (buffer-substring-no-properties beg end)))) - (lambda (&rest _) - (if-let* ((doc (get sym 'completion-category-documentation))) - (format "Completion category `%S'.\n\n%s" sym doc) - "Completion category")) + :help (lambda (sym &rest _) + (if-let* ((doc (get sym 'completion-category-documentation))) + (format "Completion category `%S'.\n\n%s" sym doc) "Completion category"))) (elisp-scope-define-symbol-role completion-category-definition () diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 4a842de6200..aa0f0117036 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -553,28 +553,26 @@ code analysis." (describe-function-1 sym)) (buffer-string)))) -(defun elisp--help-echo-1 (str sym prop &rest _) +(defun elisp--help-echo (prop str sym &rest _) (if-let* ((doc (documentation-property sym prop t))) (format "%s `%S'.\n\n%s" str sym doc) str)) -(defun elisp--help-echo (beg end prop str) - (if-let* ((sym (intern-soft (buffer-substring-no-properties beg end)))) - (apply-partially #'elisp--help-echo-1 str sym prop) - str)) - (defcustom elisp-add-help-echo t "Whether to add `help-echo' property to symbols while highlighting them. This option has effect only if `elisp-fontify-semantically' is non-nil." :version "31.1" :type 'boolean) -(defun elisp--annotate-symbol-with-help-echo (type beg end def) +(defun elisp--annotate-symbol-with-help-echo (role beg end sym) (when elisp-add-help-echo (put-text-property beg end 'help-echo - (when-let* ((hlp (elisp-scope-get-symbol-role-property type :help))) - (if (stringp hlp) hlp (funcall hlp beg end def)))))) + (when-let* ((hlp (elisp-scope-get-symbol-role-property role :help))) + ;; HLP is either a string, or a function that takes SYM as an + ;; additional argument on top of the usual WINDOW, OBJECT and POS + ;; that `help-echo' functions takes. + (if (stringp hlp) hlp (apply-partially hlp sym)))))) (defvar font-lock-beg) (defvar font-lock-end) @@ -605,9 +603,9 @@ semantic highlighting takes precedence." (function :tag "Custom function")) :version "31.1") -(defun elisp-fontify-symbol (role beg _sym id &optional def) +(defun elisp-fontify-symbol (role beg sym id &optional _def) (let ((end (progn (goto-char beg) (read (current-buffer)) (point)))) - (elisp--annotate-symbol-with-help-echo role beg end def) + (elisp--annotate-symbol-with-help-echo role beg end sym) (let ((face (elisp-scope-get-symbol-role-property role :face))) (add-face-text-property beg end face commit bb54174c21923832b9d8c461b19ca3f5f1bfeb12 Author: Eshel Yaron Date: Mon Oct 20 18:03:34 2025 +0200 ; Fix semantic highlighting in presence of shorthands So far, 'scope-elisp-analyze-form' would disable 'read-symbol-shorthands' while reading a source form in order to obtain the "original" length of symbols and pass that length to the callback called for each analyzed symbol. However, 'scope-elisp-analyze-form' could report an incorrect length when a symbol was written with redundant escaping (e.g. 'f\oo'). Moreover, disabling 'read-symbol-shorthands' breaks macro-expansion during analysis, because macros may expect "expanded" symbols, without shorthands. In this commit we address these issues by leaving 'scope-elisp-analyze-form' enabled (so we get expended symbols for macro-expansion) and recovering the original length lazily in the callback, if needed, by going to the beginning of the symbol and searching forward for its end. * lisp/emacs-lisp/elisp-scope.el (elisp-scope--report): Replace LEN argument with SYM, the analyzed symbol itself. Adapt all callers. (elisp-scope-analyze-form): Cease let-binding 'read-symbol-shorthands' to nil while reading. Wrap analysis in 'save-excursion' when reading from current buffer. Update docstring. * lisp/progmodes/elisp-mode.el (elisp-local-references) (elisp-fontify-symbol): Obtain symbol length from buffer. * test/lisp/progmodes/elisp-mode-resources/semantic-highlighting.el: Add test that incorporates 'read-symbol-shorthands'. * test/lisp/progmodes/elisp-mode-tests.el (elisp-test-font-lock): Set up 'read-symbol-shorthands' in test file. diff --git a/lisp/emacs-lisp/elisp-scope.el b/lisp/emacs-lisp/elisp-scope.el index f717a5f4070..848a8030e4d 100644 --- a/lisp/emacs-lisp/elisp-scope.el +++ b/lisp/emacs-lisp/elisp-scope.el @@ -605,8 +605,8 @@ Optional argument LOCAL is a local context to extend." (defvar elisp-scope--quoted nil) -(defsubst elisp-scope--report (role beg len &optional id def) - (funcall elisp-scope--callback role beg len id (or def (and (numberp id) id)))) +(defsubst elisp-scope--report (role beg sym &optional id def) + (funcall elisp-scope--callback role beg sym id (or def (and (numberp id) id)))) (defvar elisp-scope-special-variables nil "List of symbols that are special variables in the current analysis context.") @@ -615,42 +615,40 @@ Optional argument LOCAL is a local context to extend." "Check whether SYM is a special variable in the current analysis context." (or (memq sym elisp-scope-special-variables) (special-variable-p sym))) -(defun elisp-scope--variable (sym beg len id) +(defun elisp-scope--variable (sym beg id) (elisp-scope--report (if id (if (elisp-scope--special-variable-p sym) 'shadowed-variable 'bound-variable) 'free-variable) - beg len id)) + beg sym id)) -(defun elisp-scope--binding (sym beg len) +(defun elisp-scope--binding (sym beg) (elisp-scope--report (if (elisp-scope--special-variable-p sym) 'shadowing-variable 'binding-variable) - beg len beg)) + beg sym beg)) (defun elisp-scope--symbol (sym) (let* ((beg (elisp-scope--sym-pos sym)) (bare (elisp-scope--sym-bare sym)) - (name (symbol-name bare)) - (len (length name))) + (name (symbol-name bare))) (when (and beg (not (booleanp bare))) (cond - ((keywordp bare) (elisp-scope--report 'constant beg len)) + ((keywordp bare) (elisp-scope--report 'constant beg bare)) ((and elisp-scope--current-let-alist-form (= (aref name 0) ?.)) (if (and (length> name 1) (= (aref name 1) ?.)) ;; Double dot escapes `let-alist'. (let* ((unescaped (intern (substring name 1)))) - (elisp-scope--variable unescaped beg len (alist-get unescaped elisp-scope-local-bindings))) - (elisp-scope--report 'bound-variable beg len + (elisp-scope--variable unescaped beg (alist-get unescaped elisp-scope-local-bindings))) + (elisp-scope--report 'bound-variable beg (list 'let-alist (car elisp-scope--current-let-alist-form) bare) (cdr elisp-scope--current-let-alist-form)))) - (t (elisp-scope--variable bare beg len (alist-get bare elisp-scope-local-bindings))))))) + (t (elisp-scope--variable bare beg (alist-get bare elisp-scope-local-bindings))))))) (defun elisp-scope--let-1 (local bindings body) (if bindings (let* ((binding (ensure-list (car bindings))) (sym (car binding)) (bare (elisp-scope--sym-bare sym)) - (len (length (symbol-name bare))) (beg (elisp-scope--sym-pos sym))) - (when beg (elisp-scope--binding bare beg len)) + (when beg (elisp-scope--binding bare beg)) (elisp-scope-1 (cadr binding)) (elisp-scope--let-1 (if bare (elisp-scope--local-new bare beg local) local) (cdr bindings) body)) @@ -667,9 +665,8 @@ Optional argument LOCAL is a local context to extend." (let* ((binding (ensure-list (car bindings))) (sym (car binding)) (bare (bare-symbol sym)) - (len (length (symbol-name bare))) (beg (elisp-scope--sym-pos sym))) - (when beg (elisp-scope--binding bare beg len)) + (when beg (elisp-scope--binding bare beg)) (elisp-scope-1 (cadr binding)) (let ((elisp-scope-local-bindings (elisp-scope--local-new bare beg elisp-scope-local-bindings))) (elisp-scope-let* (cdr bindings) body))) @@ -677,9 +674,7 @@ Optional argument LOCAL is a local context to extend." (defun elisp-scope-interactive (intr spec modes) (when (symbol-with-pos-p intr) - (elisp-scope--report 'special-form - (symbol-with-pos-pos intr) - (length (symbol-name (elisp-scope--sym-bare intr))))) + (elisp-scope--report 'special-form (symbol-with-pos-pos intr) (bare-symbol intr))) (elisp-scope-1 spec) (mapc #'elisp-scope-major-mode-name modes)) @@ -706,18 +701,15 @@ Optional argument LOCAL is a local context to extend." (decl (car-safe form)) ((or (symbol-with-pos-p decl) (symbolp decl))) - ((eq (bare-symbol decl) 'declare))) + (bare (bare-symbol decl)) + ((eq bare 'declare))) (when (symbol-with-pos-p decl) - (elisp-scope--report 'macro - (symbol-with-pos-pos decl) - (length (symbol-name (bare-symbol decl))))) + (elisp-scope--report 'macro (symbol-with-pos-pos decl) bare)) (dolist (spec (cdr form)) (when-let* ((head (car-safe spec)) (bare (elisp-scope--sym-bare head))) (when (symbol-with-pos-p head) - (elisp-scope--report 'function-property-declaration - (symbol-with-pos-pos head) - (length (symbol-name bare)))) + (elisp-scope--report 'function-property-declaration (symbol-with-pos-pos head) bare)) (cl-case bare (completion (elisp-scope-sharpquote (cadr spec))) (interactive-only @@ -752,12 +744,11 @@ Optional argument LOCAL is a local context to extend." (dolist (arg args) (and (symbol-with-pos-p arg) (let* ((beg (symbol-with-pos-pos arg)) - (bare (bare-symbol arg)) - (len (length (symbol-name bare)))) + (bare (bare-symbol arg))) (when (and beg (not (eq bare '_))) (if (memq bare '(&optional &rest)) - (elisp-scope--report 'ampersand beg len) - (elisp-scope--report 'binding-variable beg len beg))))))) + (elisp-scope--report 'ampersand beg bare) + (elisp-scope--report 'binding-variable beg bare beg))))))) ;; Handle BODY. (let ((elisp-scope-local-bindings l)) (elisp-scope-n body outspec)))) @@ -771,7 +762,7 @@ Optional argument LOCAL is a local context to extend." (if (eq 'interactive (elisp-scope--sym-bare (car-safe (car-safe tmp)))) 'defcmd 'defun)) - beg (length (symbol-name bare)))) + beg bare)) (elisp-scope-lambda args body)) (defun elisp-scope-setq (args) (elisp-scope-n args elisp-scope-output-spec)) @@ -792,11 +783,10 @@ Optional argument LOCAL is a local context to extend." (func (car def)) (exps (cdr def)) (beg (elisp-scope--sym-pos func)) - (bare (bare-symbol func)) - (len (length (symbol-name bare)))) + (bare (bare-symbol func))) (when beg ;; TODO: Use a bespoke 'local-function-definition' role. - (elisp-scope--report 'function beg len beg)) + (elisp-scope--report 'function beg bare beg)) (if (cdr exps) ;; def is (FUNC ARGLIST BODY...) (elisp-scope-cl-lambda (car exps) (cdr exps)) @@ -811,10 +801,7 @@ Optional argument LOCAL is a local context to extend." (defun elisp-scope--local-function-analyzer (pos) (lambda (f &rest args) (when (symbol-with-pos-p f) - (elisp-scope--report 'function - (symbol-with-pos-pos f) - (length (symbol-name (bare-symbol f))) - pos)) + (elisp-scope--report 'function (symbol-with-pos-pos f) (bare-symbol f) pos)) (elisp-scope-n args))) (defun elisp-scope-labels (defs forms outspec) @@ -824,10 +811,9 @@ Optional argument LOCAL is a local context to extend." (args (cadr def)) (body (cddr def)) (beg (elisp-scope--sym-pos func)) - (bare (bare-symbol func)) - (len (length (symbol-name bare)))) + (bare (bare-symbol func))) (when beg - (elisp-scope--report 'function beg len beg)) + (elisp-scope--report 'function beg bare beg)) (let ((pos (or beg (cons 'gen (incf elisp-scope--counter))))) (elisp-scope-with-local-definition bare (elisp-scope--local-function-analyzer pos) @@ -842,7 +828,7 @@ Optional argument LOCAL is a local context to extend." (let* ((beg (elisp-scope--sym-pos name)) (bare (bare-symbol name))) (when beg - (elisp-scope--report 'block beg (length (symbol-name bare)) beg)) + (elisp-scope--report 'block beg bare beg)) (let ((elisp-scope-block-alist (elisp-scope--local-new bare beg elisp-scope-block-alist))) (elisp-scope-n body))) (elisp-scope-n body))) @@ -850,8 +836,7 @@ Optional argument LOCAL is a local context to extend." (defun elisp-scope-return-from (name result) (when-let* ((bare (and (symbol-with-pos-p name) (bare-symbol name))) (pos (alist-get bare elisp-scope-block-alist))) - (elisp-scope--report 'block - (symbol-with-pos-pos name) (length (symbol-name bare)) pos)) + (elisp-scope--report 'block (symbol-with-pos-pos name) bare pos)) (elisp-scope-1 result)) (defvar elisp-scope-assume-func nil) @@ -914,7 +899,7 @@ Optional argument LOCAL is a local context to extend." (let* ((var (cadr form)) (bare (elisp-scope--sym-bare var)) (beg (elisp-scope--sym-pos var))) - (when beg (elisp-scope--binding bare beg (length (symbol-name bare)))) + (when beg (elisp-scope--binding bare beg)) (let ((elisp-scope-local-bindings (elisp-scope--local-new bare beg elisp-scope-local-bindings))) (elisp-scope-loop-for-and rest)))) @@ -958,7 +943,7 @@ Optional argument LOCAL is a local context to extend." (let* ((var (car (ensure-list vars))) (bare (bare-symbol var)) (beg (elisp-scope--sym-pos var))) - (when beg (elisp-scope--binding bare beg (length (symbol-name bare)))) + (when beg (elisp-scope--binding bare beg)) (elisp-scope-loop-for (elisp-scope--local-new bare beg local) (cdr-safe vars) rest)) (when-let* ((bare (elisp-scope--sym-bare (car rest))) (more (cdr rest))) @@ -994,7 +979,7 @@ Optional argument LOCAL is a local context to extend." (progn (elisp-scope--symbol var) (elisp-scope-loop (cdr more))) - (when beg (elisp-scope--binding bare beg (length (symbol-name bare)))) + (when beg (elisp-scope--binding bare beg)) (let ((elisp-scope-loop-into-vars (cons bare elisp-scope-loop-into-vars)) (elisp-scope-local-bindings (elisp-scope--local-new bare beg elisp-scope-local-bindings))) (elisp-scope-loop (cdr more))))) @@ -1010,7 +995,7 @@ Optional argument LOCAL is a local context to extend." (beg (symbol-with-pos-pos var)) (l (elisp-scope--local-new bare beg elisp-scope-local-bindings)) (eql (car rest))) - (when beg (elisp-scope--binding bare beg (length (symbol-name bare)))) + (when beg (elisp-scope--binding bare beg)) (if (eq (elisp-scope--sym-bare eql) '=) (let* ((val (cadr rest)) (more (cddr rest))) (elisp-scope-1 val) @@ -1029,7 +1014,7 @@ Optional argument LOCAL is a local context to extend." (let* ((beg (elisp-scope--sym-pos name)) (bare (elisp-scope--sym-bare name))) (when beg - (elisp-scope--report 'block beg (length (symbol-name bare)) beg)) + (elisp-scope--report 'block beg bare beg)) (let ((elisp-scope-block-alist (elisp-scope--local-new bare beg elisp-scope-block-alist))) (elisp-scope-loop rest)))) @@ -1097,12 +1082,12 @@ Optional argument LOCAL is a local context to extend." (let ((bare (elisp-scope--sym-bare name)) (beg (elisp-scope--sym-pos name))) (when beg - (elisp-scope--report 'function beg (length (symbol-name bare)) beg)) + (elisp-scope--report 'function beg bare beg)) (dolist (binding bindings) (let* ((sym (car (ensure-list binding))) (beg (symbol-with-pos-pos sym)) (bare (bare-symbol sym))) - (when beg (elisp-scope--binding bare beg (length (symbol-name bare)))) + (when beg (elisp-scope--binding bare beg)) (elisp-scope-1 (cadr binding)))) (let ((l elisp-scope-local-bindings)) (dolist (binding bindings) @@ -1124,9 +1109,7 @@ Optional argument LOCAL is a local context to extend." (let* ((head (car regexp)) (bare (elisp-scope--sym-bare head))) (when (and bare (symbol-with-pos-p head)) - (elisp-scope--report 'rx-construct - (symbol-with-pos-pos head) (length (symbol-name bare)) - (alist-get bare elisp-scope-rx-alist))) + (elisp-scope--report 'rx-construct (symbol-with-pos-pos head) bare (alist-get bare elisp-scope-rx-alist))) (cond ((memq bare '(literal regex regexp eval)) (elisp-scope-1 (cadr regexp))) @@ -1142,14 +1125,11 @@ Optional argument LOCAL is a local context to extend." (elisp-scope-rx (cdr regexp))))) (when-let* (((symbol-with-pos-p regexp)) (bare (elisp-scope--sym-bare regexp))) - (elisp-scope--report 'rx-construct - (symbol-with-pos-pos regexp) (length (symbol-name bare)) - (alist-get bare elisp-scope-rx-alist))))) + (elisp-scope--report 'rx-construct (symbol-with-pos-pos regexp) bare (alist-get bare elisp-scope-rx-alist))))) (defun elisp-scope-rx-define (name rest) (when-let* ((bare (elisp-scope--sym-bare name))) - (elisp-scope--report 'rx-construct - (symbol-with-pos-pos name) (length (symbol-name bare)) nil)) + (elisp-scope--report 'rx-construct (symbol-with-pos-pos name) bare)) (if (not (cdr rest)) (elisp-scope-rx-1 (car rest)) (let ((l elisp-scope-rx-alist) @@ -1157,13 +1137,11 @@ Optional argument LOCAL is a local context to extend." (rx (cadr rest))) (dolist (arg args) (and (symbol-with-pos-p arg) - (let* ((beg (symbol-with-pos-pos arg)) - (bare (bare-symbol arg)) - (len (length (symbol-name bare)))) - (when beg - (if (memq (bare-symbol arg) '(&optional &rest _)) - (elisp-scope--report 'ampersand beg len) - (elisp-scope--report 'rx-construct beg len beg)))))) + (when-let* ((beg (symbol-with-pos-pos arg)) + (bare (bare-symbol arg))) + (if (memq bare '(&optional &rest _)) + (elisp-scope--report 'ampersand beg bare) + (elisp-scope--report 'rx-construct beg bare beg))))) (dolist (arg args) (when-let* ((bare (bare-symbol arg)) (beg (elisp-scope--sym-pos arg))) @@ -1177,21 +1155,18 @@ Optional argument LOCAL is a local context to extend." (let ((name (car binding)) (rest (cdr binding))) (when-let* ((bare (elisp-scope--sym-bare name)) (beg (symbol-with-pos-pos name))) - (elisp-scope--report 'rx-construct - beg (length (symbol-name bare)) beg)) + (elisp-scope--report 'rx-construct beg bare beg)) (if (cdr rest) (let ((l elisp-scope-rx-alist) (args (car rest)) (rx (cadr rest))) (dolist (arg args) (and (symbol-with-pos-p arg) - (let* ((beg (symbol-with-pos-pos arg)) - (bare (bare-symbol arg)) - (len (length (symbol-name bare)))) - (when beg - (if (memq (bare-symbol arg) '(&optional &rest _)) - (elisp-scope--report 'ampersand beg len) - (elisp-scope--report 'rx-construct beg len beg)))))) + (when-let* ((beg (symbol-with-pos-pos arg)) + (bare (bare-symbol arg))) + (if (memq bare '(&optional &rest _)) + (elisp-scope--report 'ampersand beg bare) + (elisp-scope--report 'rx-construct beg bare beg))))) (dolist (arg args) (when-let* ((bare (bare-symbol arg)) (beg (elisp-scope--sym-pos arg))) @@ -1212,14 +1187,14 @@ Optional argument LOCAL is a local context to extend." (defun elisp-scope-gv-define-expander (name handler) (when-let* ((beg (elisp-scope--sym-pos name)) (bare (elisp-scope--sym-bare name))) - (elisp-scope--report 'defun beg (length (symbol-name bare)))) + (elisp-scope--report 'defun beg bare)) (elisp-scope-1 handler)) (defun elisp-scope-gv-define-simple-setter (name setter rest) (when-let* ((beg (elisp-scope--sym-pos name)) (bare (elisp-scope--sym-bare name))) - (elisp-scope--report 'defun beg (length (symbol-name bare)))) + (elisp-scope--report 'defun beg bare)) (when-let* ((beg (elisp-scope--sym-pos setter)) (bare (elisp-scope--sym-bare setter))) - (elisp-scope--report 'function beg (length (symbol-name bare)))) + (elisp-scope--report 'function beg bare)) (elisp-scope-n rest)) (defun elisp-scope-face (face) @@ -1232,7 +1207,7 @@ Optional argument LOCAL is a local context to extend." (cond ((symbol-with-pos-p face) (when-let* ((beg (elisp-scope--sym-pos face)) (bare (elisp-scope--sym-bare face))) - (elisp-scope--report 'face beg (length (symbol-name bare))))) + (elisp-scope--report 'face beg bare))) ((keywordp (elisp-scope--sym-bare (car-safe face))) (let ((l face)) (while l @@ -1241,16 +1216,15 @@ Optional argument LOCAL is a local context to extend." (setq l (cddr l)) (when-let* ((bare (elisp-scope--sym-bare kw)) ((keywordp bare))) - (when-let* ((beg (elisp-scope--sym-pos kw)) - (len (length (symbol-name bare)))) - (elisp-scope--report 'constant beg len)) + (when-let* ((beg (elisp-scope--sym-pos kw))) + (elisp-scope--report 'constant beg bare)) (when (eq bare :inherit) (when-let* ((beg (elisp-scope--sym-pos vl)) (fbare (elisp-scope--sym-bare vl))) - (elisp-scope--report 'face beg (length (symbol-name fbare)))))))))))) + (elisp-scope--report 'face beg fbare)))))))))) (defun elisp-scope-deftype (name args body) (when-let* ((beg (elisp-scope--sym-pos name)) (bare (elisp-scope--sym-bare name))) - (elisp-scope--report 'deftype beg (length (symbol-name bare)))) + (elisp-scope--report 'deftype beg bare)) (elisp-scope-lambda args body)) (defun elisp-scope-defmethod-1 (local args body) @@ -1262,9 +1236,8 @@ Optional argument LOCAL is a local context to extend." (spec (cadr arg))) (cond ((setq bare (elisp-scope--sym-bare var)) - (when-let* ((beg (elisp-scope--sym-pos var)) - (len (length (symbol-name bare)))) - (elisp-scope--binding bare beg len)) + (when-let* ((beg (elisp-scope--sym-pos var))) + (elisp-scope--binding bare beg)) (cond ((consp spec) (let ((head (car spec)) (form (cadr spec))) @@ -1273,16 +1246,15 @@ Optional argument LOCAL is a local context to extend." (elisp-scope-1 form)))) ((symbol-with-pos-p spec) (when-let* ((beg (symbol-with-pos-pos spec)) - (bare (bare-symbol spec)) - (len (length (symbol-name bare)))) - (elisp-scope--report 'type beg len)))) + (bare (bare-symbol spec))) + (elisp-scope--report 'type beg bare)))) (elisp-scope-defmethod-1 (elisp-scope--local-new bare (elisp-scope--sym-pos var) local) (cdr args) body))))) ((setq bare (elisp-scope--sym-bare arg)) (cond ((memq bare '(&optional &rest &body _)) (when-let* ((beg (elisp-scope--sym-pos arg))) - (elisp-scope--report 'ampersand beg (length (symbol-name bare)))) + (elisp-scope--report 'ampersand beg bare)) (elisp-scope-defmethod-1 local (cdr args) body)) ((eq bare '&context) (let* ((expr-type (cadr args)) @@ -1290,7 +1262,7 @@ Optional argument LOCAL is a local context to extend." (spec (cadr expr-type)) (more (cddr args))) (when-let* ((beg (elisp-scope--sym-pos arg))) - (elisp-scope--report 'ampersand beg (length (symbol-name bare)))) + (elisp-scope--report 'ampersand beg bare)) (elisp-scope-1 expr) (cond ((consp spec) @@ -1300,14 +1272,12 @@ Optional argument LOCAL is a local context to extend." (elisp-scope-1 form)))) ((symbol-with-pos-p spec) (when-let* ((beg (symbol-with-pos-pos spec)) - (bare (bare-symbol spec)) - (len (length (symbol-name bare)))) - (elisp-scope--report 'type beg len beg)))) + (bare (bare-symbol spec))) + (elisp-scope--report 'type beg bare beg)))) (elisp-scope-defmethod-1 local more body))) (t - (when-let* ((beg (elisp-scope--sym-pos arg)) - (len (length (symbol-name bare)))) - (elisp-scope--binding bare beg len)) + (when-let* ((beg (elisp-scope--sym-pos arg))) + (elisp-scope--binding bare beg)) (elisp-scope-defmethod-1 (elisp-scope--local-new bare (elisp-scope--sym-pos arg) local) (cdr args) body)))))) (let ((elisp-scope-local-bindings local)) @@ -1325,7 +1295,7 @@ Optional argument LOCAL is a local context to extend." (defun elisp-scope-defmethod (name rest) (when-let* ((beg (elisp-scope--sym-pos name)) (bare (elisp-scope--sym-bare name))) - (elisp-scope--report 'defun beg (length (symbol-name bare)))) + (elisp-scope--report 'defun beg bare)) ;; [EXTRA] (when (eq (elisp-scope--sym-bare (car rest)) :extra) (elisp-scope--symbol (car rest)) @@ -1340,7 +1310,7 @@ Optional argument LOCAL is a local context to extend." (defun elisp-scope-cl-defun (name arglist body) (let ((beg (elisp-scope--sym-pos name)) (bare (elisp-scope--sym-bare name))) - (when beg (elisp-scope--report 'defun beg (length (symbol-name bare)))) + (when beg (elisp-scope--report 'defun beg bare)) (let ((elisp-scope-block-alist (elisp-scope--local-new bare beg elisp-scope-block-alist))) (elisp-scope-cl-lambda arglist body)))) @@ -1358,7 +1328,7 @@ Optional argument LOCAL is a local context to extend." (if (memq bare '(&optional &rest &body &key &aux &whole &cl-defs &cl-quote)) (progn (when-let* ((beg (elisp-scope--sym-pos head))) - (elisp-scope--report 'ampersand beg (length (symbol-name bare)))) + (elisp-scope--report 'ampersand beg bare)) (cl-case bare (&optional (elisp-scope-cl-lambda-optional (cadr arglist) (cddr arglist) more body)) (&cl-defs (elisp-scope-cl-lambda-defs (cadr arglist) (cddr arglist) more body)) @@ -1367,7 +1337,7 @@ Optional argument LOCAL is a local context to extend." (&aux (elisp-scope-cl-lambda-aux (cadr arglist) (cddr arglist) more body)) (&whole (elisp-scope-cl-lambda-1 (cdr arglist) more body)))) (when-let* ((beg (elisp-scope--sym-pos head))) - (elisp-scope--binding bare beg (length (symbol-name bare)))) + (elisp-scope--binding bare beg)) (let ((elisp-scope-local-bindings (elisp-scope--local-new bare (elisp-scope--sym-pos head) elisp-scope-local-bindings))) @@ -1399,11 +1369,11 @@ Optional argument LOCAL is a local context to extend." body)) (when-let* ((bare (elisp-scope--sym-bare svar))) (when-let* ((beg (elisp-scope--sym-pos svar))) - (elisp-scope--binding bare beg (length (symbol-name bare)))) + (elisp-scope--binding bare beg)) (setq l (elisp-scope--local-new bare (elisp-scope--sym-pos svar) l))) (when-let* ((bare (elisp-scope--sym-bare var))) (when-let* ((beg (elisp-scope--sym-pos var))) - (elisp-scope--binding bare beg (length (symbol-name bare)))) + (elisp-scope--binding bare beg)) (setq l (elisp-scope--local-new bare (elisp-scope--sym-pos var) l))) (cond (arglist @@ -1412,7 +1382,7 @@ Optional argument LOCAL is a local context to extend." ((memq bare '(&rest &body &key &aux)))) (progn (when-let* ((beg (elisp-scope--sym-pos head))) - (elisp-scope--report 'ampersand beg (length (symbol-name bare)))) + (elisp-scope--report 'ampersand beg bare)) (cl-case bare ((&rest &body) (let ((elisp-scope-local-bindings l)) @@ -1434,7 +1404,7 @@ Optional argument LOCAL is a local context to extend." (elisp-scope-cl-lambda-1 var (cons arglist more) body) (when-let* ((bare (elisp-scope--sym-bare var))) (when-let* ((beg (elisp-scope--sym-pos var))) - (elisp-scope--binding bare beg (length (symbol-name bare)))) + (elisp-scope--binding bare beg)) (setq l (elisp-scope--local-new bare (elisp-scope--sym-pos var) l))) (cond (arglist @@ -1443,7 +1413,7 @@ Optional argument LOCAL is a local context to extend." ((memq bare '(&key &aux)))) (progn (when-let* ((beg (elisp-scope--sym-pos head))) - (elisp-scope--report 'ampersand beg (length (symbol-name bare)))) + (elisp-scope--report 'ampersand beg bare)) (cl-case bare (&key (let ((elisp-scope-local-bindings l)) @@ -1474,7 +1444,7 @@ Optional argument LOCAL is a local context to extend." (when-let* ((bare (elisp-scope--sym-bare kw)) ((keywordp bare))) (when-let* ((beg (elisp-scope--sym-pos kw))) - (elisp-scope--report 'constant beg (length (symbol-name bare)))) + (elisp-scope--report 'constant beg bare)) (setq l (elisp-scope--local-new bare (elisp-scope--sym-pos svar) l))) (if (consp var) (let ((elisp-scope-local-bindings l)) @@ -1484,11 +1454,11 @@ Optional argument LOCAL is a local context to extend." body)) (when-let* ((bare (elisp-scope--sym-bare svar))) (when-let* ((beg (elisp-scope--sym-pos svar))) - (elisp-scope--binding bare beg (length (symbol-name bare)))) + (elisp-scope--binding bare beg)) (setq l (elisp-scope--local-new bare (elisp-scope--sym-pos svar) l))) (when-let* ((bare (elisp-scope--sym-bare var))) (when-let* ((beg (elisp-scope--sym-pos var))) - (elisp-scope--binding bare beg (length (symbol-name bare)))) + (elisp-scope--binding bare beg)) (setq l (elisp-scope--local-new bare (elisp-scope--sym-pos var) l))) (cond (arglist @@ -1497,7 +1467,7 @@ Optional argument LOCAL is a local context to extend." ((memq bare '(&aux &allow-other-keys)))) (progn (when-let* ((beg (elisp-scope--sym-pos head))) - (elisp-scope--report 'ampersand beg (length (symbol-name bare)))) + (elisp-scope--report 'ampersand beg bare)) (cl-case bare (&aux (let ((elisp-scope-local-bindings l)) @@ -1523,7 +1493,7 @@ Optional argument LOCAL is a local context to extend." (elisp-scope-cl-lambda-1 var (cons arglist more) body)) (when-let* ((bare (elisp-scope--sym-bare var))) (when-let* ((beg (elisp-scope--sym-pos var))) - (elisp-scope--binding bare beg (length (symbol-name bare)))) + (elisp-scope--binding bare beg)) (setq l (elisp-scope--local-new bare (elisp-scope--sym-pos var) l))) (let ((elisp-scope-local-bindings l)) (cond @@ -1537,16 +1507,15 @@ Optional argument LOCAL is a local context to extend." (arglist (cadr b)) (mbody (cddr b))) (elisp-scope-cl-lambda arglist mbody) - (when-let* ((bare (elisp-scope--sym-bare name)) - (len (length (symbol-name bare)))) + (when-let* ((bare (elisp-scope--sym-bare name))) (let ((beg (elisp-scope--sym-pos name))) ;; TODO: Use a bespoke 'local-macro-definition' role. - (when beg (elisp-scope--report 'macro beg len beg)) + (when beg (elisp-scope--report 'macro beg bare beg)) (let ((pos (or beg (cons 'gen (incf elisp-scope--counter))))) (elisp-scope-with-local-definition bare (lambda (f &rest _) (when (symbol-with-pos-p f) - (elisp-scope--report 'macro (symbol-with-pos-pos f) len pos))) + (elisp-scope--report 'macro (symbol-with-pos-pos f) bare pos))) (elisp-scope-cl-macrolet (cdr bindings) body outspec)))))) (elisp-scope-n body outspec))) @@ -1556,7 +1525,7 @@ Optional argument LOCAL is a local context to extend." (bkw (elisp-scope--sym-bare kw)) ((keywordp bkw))) (when-let* ((beg (elisp-scope--sym-pos kw))) - (elisp-scope--report 'constant beg (length (symbol-name bkw)))) + (elisp-scope--report 'constant beg bkw)) (cl-case bkw ((:init-value :keymap :after-hook :initialize) (elisp-scope-1 (cadr body))) @@ -1586,9 +1555,9 @@ Optional argument LOCAL is a local context to extend." (setq body (cddr body))) (when-let* ((bare (elisp-scope--sym-bare mode)) (beg (elisp-scope--sym-pos mode)) (typ (if command 'defcmd 'defun))) - (elisp-scope--report typ beg (length (symbol-name bare))) + (elisp-scope--report typ beg bare) (unless explicit-var - (elisp-scope--report 'defvar beg (length (symbol-name bare))))) + (elisp-scope--report 'defvar beg bare))) (elisp-scope-n body))) (defun elisp-scope-global-minor-mode-predicate (pred) @@ -1601,9 +1570,8 @@ Optional argument LOCAL is a local context to extend." (defun elisp-scope-major-mode-name (mode) (when-let* ((beg (elisp-scope--sym-pos mode)) (bare (bare-symbol mode)) - ((not (booleanp bare))) - (len (length (symbol-name bare)))) - (elisp-scope--report 'major-mode beg len))) + ((not (booleanp bare)))) + (elisp-scope--report 'major-mode beg bare))) (defun elisp-scope-mode-line-construct (format) (elisp-scope-mode-line-construct-1 format)) @@ -1611,9 +1579,7 @@ Optional argument LOCAL is a local context to extend." (defun elisp-scope-mode-line-construct-1 (format) (cond ((symbol-with-pos-p format) - (elisp-scope--report 'free-variable - (symbol-with-pos-pos format) - (length (symbol-name (bare-symbol format))))) + (elisp-scope--report 'free-variable (symbol-with-pos-pos format) (bare-symbol format))) ((consp format) (let ((head (car format))) (cond @@ -2273,9 +2239,8 @@ ARGS bound to the analyzed arguments." (form (when (consp binding) (if (cdr binding) (cadr binding) (car binding)))) (bare (elisp-scope--sym-bare sym)) - (len (length (symbol-name bare))) (beg (elisp-scope--sym-pos sym))) - (when beg (elisp-scope--binding bare beg len)) + (when beg (elisp-scope--binding bare beg)) (when form (elisp-scope-1 form)) (let ((elisp-scope-local-bindings (elisp-scope--local-new bare beg elisp-scope-local-bindings))) @@ -2311,9 +2276,8 @@ ARGS bound to the analyzed arguments." (let* ((binding (ensure-list (car bindings))) (sym (car binding)) (bare (elisp-scope--sym-bare sym)) - (len (length (symbol-name bare))) (beg (elisp-scope--sym-pos sym))) - (when beg (elisp-scope--binding bare beg len)) + (when beg (elisp-scope--binding bare beg)) (elisp-scope-1 (cadr binding)) (elisp-scope-oclosure-lambda-1 (if bare (elisp-scope--local-new bare beg local) local) @@ -2382,7 +2346,7 @@ ARGS bound to the analyzed arguments." (let* ((label (car labels)) (bare (elisp-scope--sym-bare label))) (when-let* ((beg (elisp-scope--sym-pos label))) - (elisp-scope--report 'label beg (length (symbol-name bare)) beg)) + (elisp-scope--report 'label beg bare beg)) (let ((elisp-scope-label-alist (if bare (elisp-scope--local-new bare (elisp-scope--sym-pos label) elisp-scope-label-alist) @@ -2395,7 +2359,7 @@ ARGS bound to the analyzed arguments." (when-let* ((bare (elisp-scope--sym-bare label)) (pos (alist-get bare elisp-scope-label-alist)) (beg (elisp-scope--sym-pos label))) - (elisp-scope--report 'label beg (length (symbol-name bare)) pos))) + (elisp-scope--report 'label beg bare pos))) (elisp-scope-define-macro-analyzer rx-define (name &rest rest) (elisp-scope-rx-define name rest)) @@ -2421,10 +2385,8 @@ ARGS bound to the analyzed arguments." (elisp-scope-define-macro-analyzer nnoo-define-basics (&optional backend) ;; Unsafe macro! - (let* ((bare (bare-symbol backend)) - (len (length (symbol-name bare))) - (beg (elisp-scope--sym-pos backend))) - (when beg (elisp-scope--report 'nnoo-backend beg len)))) + (when-let* ((beg (elisp-scope--sym-pos backend))) + (elisp-scope--report 'nnoo-backend beg (bare-symbol backend)))) (elisp-scope-define-macro-analyzer gv-define-expander (name handler) (elisp-scope-gv-define-expander name handler)) @@ -2477,9 +2439,8 @@ ARGS bound to the analyzed arguments." (let ((place (car binding))) (if (or (symbol-with-pos-p place) (symbolp place)) (let* ((bare (bare-symbol place)) - (len (length (symbol-name bare))) (beg (elisp-scope--sym-pos place))) - (when beg (elisp-scope--binding bare beg len)) + (when beg (elisp-scope--binding bare beg)) (setq l (elisp-scope--local-new bare beg l))) (elisp-scope-1 place)) (elisp-scope-1 (cadr binding)))) @@ -2530,11 +2491,10 @@ ARGS bound to the analyzed arguments." (let ((l elisp-scope-local-bindings)) (dolist (arg args) (let* ((bare (elisp-scope--sym-bare arg)) - (len (length (symbol-name bare))) (beg (elisp-scope--sym-pos arg))) (if (eq bare '&rest) - (elisp-scope--report 'ampersand beg len) - (when beg (elisp-scope--binding bare beg len)) + (elisp-scope--report 'ampersand beg bare) + (when beg (elisp-scope--binding bare beg)) (setq l (elisp-scope--local-new bare beg l))))) (let ((elisp-scope-local-bindings l)) (elisp-scope-n body)))) @@ -2602,7 +2562,7 @@ ARGS bound to the analyzed arguments." (let* ((bare (bare-symbol var)) (beg (when (symbol-with-pos-p var) (symbol-with-pos-pos var))) (l (elisp-scope--local-new bare beg elisp-scope-local-bindings))) - (when beg (elisp-scope--binding bare beg (length (symbol-name bare)))) + (when beg (elisp-scope--binding bare beg)) (elisp-scope-1 bodyform elisp-scope-output-spec) (dolist (handler handlers) (dolist (cond-name (ensure-list (car-safe handler))) @@ -2611,8 +2571,8 @@ ARGS bound to the analyzed arguments." (clen (length (symbol-name cbare)))) (cond ((booleanp cbare)) - ((keywordp cbare) (elisp-scope--report 'constant cbeg clen)) - (t (elisp-scope--report 'condition cbeg clen))))) + ((keywordp cbare) (elisp-scope--report 'constant cbeg cbare)) + (t (elisp-scope--report 'condition cbeg cbare))))) (let ((elisp-scope-local-bindings l)) (elisp-scope-n (cdr handler) elisp-scope-output-spec))))) @@ -2831,7 +2791,7 @@ ARGS bound to the analyzed arguments." If SYM is not a symbol with position information, do nothing." (when-let* ((beg (elisp-scope--sym-pos sym)) (bare (bare-symbol sym))) - (elisp-scope--report role beg (length (symbol-name bare))))) + (elisp-scope--report role beg bare))) (defvar-local elisp-scope-buffer-file-name nil) @@ -2896,15 +2856,16 @@ are analyzed." ((macrop bare) (elisp-scope-report-s f 'macro) (cond ((elisp-scope-safe-macro-p bare) - (let* ((warning-minimum-log-level :emergency) + (elisp-scope-1 + (let* ((warning-minimum-log-level :emergency) (macroexp-inhibit-compiler-macros t) (symbols-with-pos-enabled t) (message-log-max nil) (inhibit-message t) (macroexpand-all-environment - (append (mapcar #'list elisp-scope-unsafe-macros) macroexpand-all-environment)) - (expanded (ignore-errors (macroexpand-1 form macroexpand-all-environment)))) - (elisp-scope-1 expanded outspec))) + (append (mapcar #'list elisp-scope-unsafe-macros) macroexpand-all-environment))) + (ignore-errors (macroexpand-1 form macroexpand-all-environment))) + outspec)) ((eq (get bare 'edebug-form-spec) t) (elisp-scope-n forms)))) ((functionp bare) (elisp-scope-report-s f 'function) (elisp-scope-n forms)) @@ -2926,16 +2887,15 @@ It is passed to `elisp-scope-1', which see." "Read and analyze code from STREAM, reporting findings via CALLBACK. Call CALLBACK for each analyzed symbol SYM with arguments ROLE, POS, -LEN, ID and DEF, where ROLE is a symbol that specifies the semantics of -SYM; POS is the position of SYM in STREAM; LEN is SYM's length; ID is an -object that uniquely identifies (co-)occurrences of SYM in the current -defun; and DEF is the position in which SYM is locally defined, or nil. -If SYM is itself a binding occurrence, then POS and BINDER are equal. -If SYM is not lexically bound, then BINDER is nil. This function -ignores `read-symbol-shorthands', so SYM and LEN always correspond to -the symbol as it appears in STREAM. +SYM, ID and DEF, where ROLE is a symbol that specifies the semantics of +SYM; POS is the position of SYM in STREAM; ID is an object that uniquely +identifies (co-)occurrences of SYM in the current defun; and DEF is the +position in which SYM is locally defined, or nil. If SYM is itself a +binding occurrence, then POS and DEF are equal. If SYM is not lexically +bound, then DEF is nil. -If STREAM is nil, it defaults to the current buffer. +If STREAM is nil, it defaults to the current buffer. When reading from +the current buffer, this function leaves point at the end of the form. This function recursively analyzes Lisp forms (HEAD . TAIL), usually starting with a top-level form, by inspecting HEAD at each level: @@ -2965,11 +2925,15 @@ for the `identity' function: (lambda (fsym arg) (elisp-scope-report-s fsym \\='function) (elisp-scope-1 arg elisp-scope-output-spec))" - (let ((elisp-scope--counter 0) - (elisp-scope--callback callback) - (read-symbol-shorthands nil) - (max-lisp-eval-depth 32768)) - (elisp-scope-1 (read-positioning-symbols (or stream (current-buffer)))))) + (let* ((stream (or stream (current-buffer))) + (form (read-positioning-symbols stream)) + (elisp-scope--counter 0) + (elisp-scope--callback callback) + (max-lisp-eval-depth 32768)) + (if (eq stream (current-buffer)) + ;; `save-excursion' so CALLBACK can change point freely. + (save-excursion (elisp-scope-1 form)) + (elisp-scope-1 form)))) (provide 'elisp-scope) ;;; elisp-scope.el ends here diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index af7c8b96555..4a842de6200 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -512,10 +512,12 @@ code analysis." (save-excursion (goto-char pos) (beginning-of-defun) - (elisp-scope-analyze-form (lambda (_type beg len id &optional _def) - (when (<= beg pos (+ beg len)) - (setq cur id)) - (when id (setf (alist-get beg all) (list len id)))))) + (elisp-scope-analyze-form + (lambda (_role beg _sym id &optional _def) + (let* ((end (progn (goto-char beg) (read (current-buffer)) (point))) + (len (- end beg))) + (when (<= beg pos end) (setq cur id)) + (when id (setf (alist-get beg all) (list len id))))))) (seq-keep (pcase-lambda (`(,beg ,len ,id)) (when (equal id cur) (cons beg len))) all))) @@ -603,10 +605,10 @@ semantic highlighting takes precedence." (function :tag "Custom function")) :version "31.1") -(defun elisp-fontify-symbol (type beg len id &optional def) - (let ((end (+ beg len))) - (elisp--annotate-symbol-with-help-echo type beg end def) - (let ((face (elisp-scope-get-symbol-role-property type :face))) +(defun elisp-fontify-symbol (role beg _sym id &optional def) + (let ((end (progn (goto-char beg) (read (current-buffer)) (point)))) + (elisp--annotate-symbol-with-help-echo role beg end def) + (let ((face (elisp-scope-get-symbol-role-property role :face))) (add-face-text-property beg end face (cl-case elisp-fontify-symbol-precedence-function diff --git a/test/lisp/progmodes/elisp-mode-resources/semantic-highlighting.el b/test/lisp/progmodes/elisp-mode-resources/semantic-highlighting.el index 24c5a17b8aa..f4f64bae045 100644 --- a/test/lisp/progmodes/elisp-mode-resources/semantic-highlighting.el +++ b/test/lisp/progmodes/elisp-mode-resources/semantic-highlighting.el @@ -149,3 +149,8 @@ ;; ^ (elisp-widget-type font-lock-keyword-face) ))) :version "29.1") + +(e-s-analyze-form #'ignore) +;; ^ (elisp-shorthand-font-lock-face elisp-function) +;; ^ elisp-function +;; ^ elisp-function diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 0e1bff600b1..e36f65805c2 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -1153,7 +1153,9 @@ evaluation of BODY." (lambda () (emacs-lisp-mode) (setq-local trusted-content :all - elisp-fontify-semantically t)))) + elisp-fontify-semantically t + read-symbol-shorthands + '(("e-s-" . "elisp-scope-")))))) (provide 'elisp-mode-tests) ;;; elisp-mode-tests.el ends here commit bcc88bc5c22c3ce9cce50a035d9f87e606043747 Author: Mattias Engdegård Date: Tue Oct 21 12:19:48 2025 +0200 Use 'any' and 'all' to simplify parts of the byte-compiler * lisp/emacs-lisp/byte-opt.el (byte-opt--nary-comparison) (byte-optimize-constant-args, byte-optimize-member) (byte-optimize-append): * lisp/emacs-lisp/bytecomp.el (byte-compile-warnings) (byte-compile-out-toplevel): * lisp/emacs-lisp/cconv.el (cconv-convert): Replace various hand-written 'any' and 'all' expressions with calls to the new functions, for readability and speed. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 0560640952f..73d565d7c12 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1005,19 +1005,19 @@ There can be multiple entries for the same NAME if it has several aliases.") (let* ((op (car form)) (bindings nil) (rev-args nil)) - (if (memq nil (mapcar #'macroexp-copyable-p (cddr form))) - ;; At least one arg beyond the first is non-constant non-variable: - ;; create temporaries for all args to guard against side-effects. - ;; The optimizer will eliminate trivial bindings later. - (let ((i 1)) - (dolist (arg (cdr form)) - (let ((var (make-symbol (format "arg%d" i)))) - (push var rev-args) - (push (list var arg) bindings) - (setq i (1+ i))))) - ;; All args beyond the first are copyable: no temporary variables - ;; required. - (setq rev-args (reverse (cdr form)))) + (if (all #'macroexp-copyable-p (cddr form)) + ;; All args beyond the first are copyable: no temporary variables + ;; required. + (setq rev-args (reverse (cdr form))) + ;; At least one arg beyond the first is non-constant non-variable: + ;; create temporaries for all args to guard against side-effects. + ;; The optimizer will eliminate trivial bindings later. + (let ((i 1)) + (dolist (arg (cdr form)) + (let ((var (make-symbol (format "arg%d" i)))) + (push var rev-args) + (push (list var arg) bindings) + (setq i (1+ i)))))) (let ((prev (car rev-args)) (exprs nil)) (dolist (arg (cdr rev-args)) @@ -1030,14 +1030,11 @@ There can be multiple entries for the same NAME if it has several aliases.") (t form)))) (defun byte-optimize-constant-args (form) - (let ((rest (cdr form))) - (while (and rest (macroexp-const-p (car rest))) - (setq rest (cdr rest))) - (if rest - form + (if (all #'macroexp-const-p (cdr form)) (condition-case () (list 'quote (eval form t)) - (error form))))) + (error form)) + form)) (defun byte-optimize-identity (form) (if (and (cdr form) (null (cdr (cdr form)))) @@ -1099,11 +1096,9 @@ See Info node `(elisp) Integer Basics'." (and (macroexp-const-p arg2) (let ((listval (byteopt--eval-const arg2))) (and (listp listval) - (not (memq nil (mapcar - (lambda (o) - (or (symbolp o) - (byte-optimize--fixnump o))) - listval)))))))) + (all (lambda (o) + (or (symbolp o) (byte-optimize--fixnump o))) + listval)))))) (cons 'memq (cdr form))) (t form))) @@ -1622,7 +1617,7 @@ See Info node `(elisp) Integer Basics'." ;; (list CONSTANTS...) -> '(CONSTANTS...) ((and (consp arg) (eq (car arg) 'list) - (not (memq nil (mapcar #'macroexp-const-p (cdr arg))))) + (all #'macroexp-const-p (cdr arg))) (loop (cons (list 'quote (eval arg)) (cdr args)) newargs)) (t (loop (cdr args) (cons arg newargs))))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 12079e0f53c..7cb944e3b08 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -372,9 +372,7 @@ for the Emacs build itself.") ;;;###autoload (put 'byte-compile-warnings 'safe-local-variable - (lambda (v) - (or (symbolp v) - (null (delq nil (mapcar (lambda (x) (not (symbolp x))) v)))))) + (lambda (v) (or (symbolp v) (all #'symbolp v)))) ;;;###autoload (defun byte-compile-warning-enabled-p (warning &optional symbol) @@ -3344,7 +3342,7 @@ lambda-expression." (cons (nth 1 (car body)) (cdr body)) (cons tmp body)))) (or (eq output-type 'file) - (not (delq nil (mapcar 'consp (cdr (car body)))))))) + (not (any #'consp (cdr (car body))))))) (setq rest (cdr rest))) rest)) (let ((byte-compile-vector (byte-compile-constants-vector))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 170c7828cdd..ad7fc1de5c2 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -311,11 +311,11 @@ ENV is a list where each entry takes the shape either: EXTEND is a list of variables which might need to be accessed even from places where they are shadowed, because some part of ENV causes them to be used at places where they originally did not directly appear." - (cl-assert (not (delq nil (mapcar (lambda (mapping) - (if (eq (cadr mapping) #'apply-partially) - (cconv--set-diff (cdr (cddr mapping)) - extend))) - env)))) + (cl-assert (not (any (lambda (mapping) + (and (eq (cadr mapping) #'apply-partially) + (cconv--set-diff (cdr (cddr mapping)) + extend))) + env))) ;; What's the difference between fvrs and envs? ;; Suppose that we have the code commit 4a39e46d9c3997f9077e1b05a33df117f37d2046 Author: Mattias Engdegård Date: Tue Oct 21 11:22:46 2025 +0200 * lisp/emacs-lisp/shortdoc.el: Add take-while, drop-while, any, all. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 754b2016d9e..7b8ecd1b260 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -761,6 +761,15 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (take 3 '(one two three four))) (ntake :eval (ntake 3 (list 'one 'two 'three 'four))) + (take-while + :eval (take-while #'numberp '(1 2 three 4 five))) + (drop-while + :eval (drop-while #'numberp '(1 2 three 4 five))) + (any + :eval (any #'symbolp '(1 2 three 4 five))) + (all + :eval (all #'symbolp '(one 2 three)) + :eval (all #'symbolp '(one two three))) (elt :eval (elt '(one two three) 1)) (car-safe commit eed2fce5416eb8596efdfcd633c8466f7b56fd77 Author: Mattias Engdegård Date: Tue Oct 21 13:16:27 2025 +0200 Disable one tab-bar-test case on macOS The test works when run interactively and in batch mode started from a terminal, but not from M-x compile. * test/lisp/tab-bar-tests.el (tab-bar-tests-quit-restore-window): Disable on macOS when TERM=dumb. diff --git a/test/lisp/tab-bar-tests.el b/test/lisp/tab-bar-tests.el index 257f6bd37d3..98bf61df177 100644 --- a/test/lisp/tab-bar-tests.el +++ b/test/lisp/tab-bar-tests.el @@ -56,6 +56,9 @@ ;; Skip test on MS-Windows in batch mode, since terminal ;; frames cannot be created in that case. ('windows-nt noninteractive) + ;; This test is unreliable on macOS when run in batch mode + ;; from Emacs (M-x compile). + ('darwin (equal (getenv "TERM") "dumb")) ;; Emba runs the container without "--tty" ;; (the environment variable "TERM" is nil), and this ;; test fails with '(error "Could not open file: /dev/tty")'. commit 11915c6acb9f5463515d4f3891ad8d7134685838 Author: Yuan Fu Date: Tue Oct 21 00:00:24 2025 -0700 ; Fix previous tree-sitter commit * lisp/treesit.el (treesit-font-lock-rules): Use lang instead of current-language, lang = (or cunrrent-language default-language). diff --git a/lisp/treesit.el b/lisp/treesit.el index 9a6dedf1ae5..a8a515c434d 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1605,7 +1605,7 @@ name, it is ignored." current-feature current-override current-reversed - current-language) + lang) result) ;; Clears any configurations set for this query. (setq current-language nil commit 1c8fc379b8d462d87f86e5cf1a98ba3594b7ea87 Author: Elías Gabriel Pérez Date: Thu Oct 2 19:41:40 2025 -0600 hideshow: Define new keymap for all the commands. bug#79569 * lisp/progmodes/hideshow.el (hs-prefix-map): New keymap. (hs-minor-mode-map): Use the new keymap. diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index dd6f4d3fef7..bbe42a7de91 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -471,20 +471,25 @@ info node `(elisp)Overlays'." "Non-nil if using hideshow mode as a minor mode of some other mode. Use the command `hs-minor-mode' to toggle or set this variable.") +(defvar-keymap hs-prefix-map + :doc "Keymap for hideshow commands." + :prefix t + ;; These bindings roughly imitate those used by Outline mode. + "C-h" #'hs-hide-block + "C-s" #'hs-show-block + "C-M-h" #'hs-hide-all + "C-M-s" #'hs-show-all + "C-l" #'hs-hide-level + "C-c" #'hs-toggle-hiding + "C-a" #'hs-show-all + "C-t" #'hs-hide-all + "C-d" #'hs-hide-block + "C-e" #'hs-toggle-hiding) + (defvar-keymap hs-minor-mode-map :doc "Keymap for hideshow minor mode." - ;; These bindings roughly imitate those used by Outline mode. - "C-c @ C-h" #'hs-hide-block - "C-c @ C-s" #'hs-show-block - "C-c @ C-M-h" #'hs-hide-all - "C-c @ C-M-s" #'hs-show-all - "C-c @ C-l" #'hs-hide-level - "C-c @ C-c" #'hs-toggle-hiding - "C-c @ C-a" #'hs-show-all - "C-c @ C-t" #'hs-hide-all - "C-c @ C-d" #'hs-hide-block - "C-c @ C-e" #'hs-toggle-hiding "S-" #'hs-toggle-hiding + "C-c @" hs-prefix-map " " #'hs-indicator-mouse-toggle-hidding) (defvar-keymap hs-indicators-map commit c513224fa3acf2c1ce5be86d52476eaff1c2c2c0 Author: Elías Gabriel Pérez Date: Sat Oct 11 19:10:11 2025 -0600 hideshow: Update the indicators properly after showing/hiding bug#79616 * lisp/progmodes/hideshow.el (hs-discard-overlays) (hs-make-overlay, hs-show-block): Rework 'hs--refresh-indicators' calls. (hs--refresh-indicators): Rework code, add new function arguments. (hs-minor-mode): Properly remove the indicators after turning off the mode. diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 6d3a5bc9fe6..dd6f4d3fef7 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -634,7 +634,8 @@ Skip \"internal\" overlays if `hs-allow-nesting' is non-nil." (delete-overlay ov)))) (dolist (ov (overlays-in from to)) (when (overlay-get ov 'hs) - (delete-overlay ov))))) + (delete-overlay ov)))) + (hs--refresh-indicators from to)) (defun hs-hideable-region-p (beg end) "Return t if region in BEG and END can be hidden." @@ -680,6 +681,7 @@ to call with the newly initialized overlay." (overlay-put ov 'isearch-open-invisible-temporary 'hs-isearch-show-temporary)) (when hs-set-up-overlay (funcall hs-set-up-overlay ov)) + (hs--refresh-indicators b e) ov)) (defun hs-block-positions () @@ -785,14 +787,12 @@ point." (forward-line 1)) `(jit-lock-bounds ,beg . ,end)) -(defun hs--refresh-indicators () - "Update indicators appearance at current block." - (when hs-show-indicators +(defun hs--refresh-indicators (from to) + "Update indicators appearance in FROM and TO." + (when (and hs-show-indicators hs-minor-mode) (save-match-data (save-excursion - ;; Using window-start and window-end is more faster - ;; than computing again the block positions - (hs--add-indicators (window-start) (window-end)))))) + (hs--add-indicators from to))))) (defun hs--get-ellipsis (b e) "Helper function for `hs-make-overlay'. @@ -1235,6 +1235,7 @@ See documentation for functions `hs-hide-block' and `run-hooks'." ((eq 'comment (overlay-get ov 'hs)) here) (t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset))))) (delete-overlay ov) + (hs--refresh-indicators (overlay-start ov) (overlay-end ov)) t)) ;; not immediately obvious, look for a suitable block (let ((c-reg (hs-inside-comment-p)) @@ -1251,7 +1252,6 @@ See documentation for functions `hs-hide-block' and `run-hooks'." (when (and p q) (hs-discard-overlays p q) (goto-char (if end q (1+ p)))))) - (hs--refresh-indicators) (run-hooks 'hs-show-hook))) (defun hs-hide-level (arg) @@ -1354,12 +1354,12 @@ Key bindings: (jit-lock-register #'hs--add-indicators))) (remove-from-invisibility-spec '(hs . t)) - (when hs-show-indicators - (jit-lock-unregister #'hs--add-indicators) - (remove-overlays nil nil 'hs-indicator t)) ;; hs-show-all does nothing unless h-m-m is non-nil. (let ((hs-minor-mode t)) - (hs-show-all)))) + (hs-show-all)) + (when hs-show-indicators + (jit-lock-unregister #'hs--add-indicators) + (remove-overlays nil nil 'hs-indicator t)))) ;;;###autoload (defun turn-off-hideshow () commit 80a17f7a3076a18925ca4d16189e05a80db6c646 Author: Yuan Fu Date: Thu Oct 16 00:16:35 2025 -0700 Cache compiled tree-sitter queries (bug#79363) This way major modes can compute font-lock settings and indentation rules dynamically when the major mode is enabled. We don't want to compute it at package load time because the grammar might not be installed at that point. (Grammar might be (semi)auto-installed when the major mode is enabled.) This commit adds treesit--query-cache and changes treesit-font-lock-rules to not compile the query. Instead, the queries are compiled in treesit-validate-and-compile-font-lock-rules. Go-ts-mode is modified to use this new framework. * lisp/progmodes/go-ts-mode.el (go-ts-mode--iota-query-supported-p): (go-ts-mode--method-elem-supported-p): (go-ts-mode--font-lock-settings-cached): Removed. (go-ts-mode--font-lock-settings): Simply return the result of treesit-font-lock-rules rather than saving to go-ts-mode--font-lock-settings-cached. Use treesit-query-with-optional for computed queries. * lisp/treesit.el (treesit--query-cache): New variable. (treesit-font-lock-settings): Add new field language. (treesit-font-lock-setting-language): New function. (treesit-query-with-optional): New function. (treesit-font-lock-recompute-features): Don't compile query and store language (because we can't derive from compiled query anymore). (treesit-replace-font-lock-feature-settings): Use the new language field. (treesit-validate-and-compile-font-lock-rules): Renamed from treesit-validate-font-lock-rules, add logic to compile queries. (treesit-major-mode-setup): Use treesit-validate-and-compile-font-lock-rules. diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 484c87fed9f..f29615f72b0 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -150,140 +150,124 @@ "max" "min" "new" "panic" "print" "println" "real" "recover") "Go built-in functions for tree-sitter font-locking.") -(defun go-ts-mode--iota-query-supported-p () - "Return t if the iota query is supported by the tree-sitter-go grammar." - (ignore-errors - (or (treesit-query-string "" '((iota) @font-lock-constant-face) 'go) t))) +(defun go-ts-mode--font-lock-settings () + "Return font-lock rules for `go-ts-mode'." + (treesit-font-lock-rules + :language 'go + :feature 'bracket + '(["(" ")" "[" "]" "{" "}"] @font-lock-bracket-face) + + :language 'go + :feature 'comment + '((comment) @font-lock-comment-face) + + :language 'go + :feature 'builtin + `((call_expression + function: ((identifier) @font-lock-builtin-face + (:match ,(rx-to-string + `(seq bol + (or ,@go-ts-mode--builtin-functions) + eol)) + @font-lock-builtin-face)))) + + :language 'go + :feature 'constant + (treesit-query-with-optional 'go + '([(false) (nil) (true)] @font-lock-constant-face + (const_declaration + (const_spec name: (identifier) @font-lock-constant-face + ("," name: (identifier) @font-lock-constant-face)*))) + ;; Optional query added in newer version. + '((iota) @font-lock-constant-face)) + + :language 'go + :feature 'delimiter + '((["," "." ";" ":"]) @font-lock-delimiter-face) + + :language 'go + :feature 'operator + `([,@go-ts-mode--operators] @font-lock-operator-face) + + :language 'go + :feature 'definition + (treesit-query-with-optional 'go + '((function_declaration + name: (identifier) @font-lock-function-name-face) + (method_declaration + name: (field_identifier) @font-lock-function-name-face) + (field_declaration + name: (field_identifier) @font-lock-property-name-face) + (parameter_declaration + name: (identifier) @font-lock-variable-name-face) + (variadic_parameter_declaration + name: (identifier) @font-lock-variable-name-face) + (short_var_declaration + left: (expression_list + (identifier) @font-lock-variable-name-face + ("," (identifier) @font-lock-variable-name-face)*)) + (var_spec name: (identifier) @font-lock-variable-name-face + ("," name: (identifier) @font-lock-variable-name-face)*) + (range_clause + left: (expression_list + (identifier) @font-lock-variable-name-face))) + ;; tree-sitter-go changed method_spec to method_elem in + ;; https://github.com/tree-sitter/tree-sitter-go/commit/b82ab803d887002a0af11f6ce63d72884580bf33 + '((method_elem + name: (field_identifier) @font-lock-function-name-face)) + '((method_spec + name: (field_identifier) @font-lock-function-name-face))) + + :language 'go + :feature 'function + '((call_expression + function: (identifier) @font-lock-function-call-face) + (call_expression + function: (selector_expression + field: (field_identifier) @font-lock-function-call-face))) + + :language 'go + :feature 'keyword + `([,@go-ts-mode--keywords] @font-lock-keyword-face) -;; tree-sitter-go changed method_spec to method_elem in -;; https://github.com/tree-sitter/tree-sitter-go/commit/b82ab803d887002a0af11f6ce63d72884580bf33 -(defun go-ts-mode--method-elem-supported-p () - "Return t if Go grammar uses `method_elem' instead of `method_spec'." - (ignore-errors - (or (treesit-query-string "" '((method_elem) @cap) 'go) t))) + :language 'go + :feature 'label + '((label_name) @font-lock-constant-face) -(defvar go-ts-mode--font-lock-settings-cached nil - "Cached tree-sitter font-lock settings for `go-ts-mode'.") + :language 'go + :feature 'number + '([(float_literal) + (imaginary_literal) + (int_literal)] @font-lock-number-face) + + :language 'go + :feature 'string + '([(interpreted_string_literal) + (raw_string_literal) + (rune_literal)] @font-lock-string-face) + + :language 'go + :feature 'type + '([(package_identifier) (type_identifier)] @font-lock-type-face) + + :language 'go + :feature 'property + '((selector_expression field: (field_identifier) @font-lock-property-use-face) + (keyed_element (_ (identifier) @font-lock-property-use-face))) + + :language 'go + :feature 'variable + '((identifier) @font-lock-variable-use-face) + + :language 'go + :feature 'escape-sequence + :override t + '((escape_sequence) @font-lock-escape-face) -(defun go-ts-mode--font-lock-settings () - "Return tree-sitter font-lock settings for `go-ts-mode'. - -Tree-sitter font-lock settings are evaluated the first time this -function is called. Subsequent calls return the first evaluated value." - (or go-ts-mode--font-lock-settings-cached - (setq go-ts-mode--font-lock-settings-cached - (treesit-font-lock-rules - :language 'go - :feature 'bracket - '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) - - :language 'go - :feature 'comment - '((comment) @font-lock-comment-face) - - :language 'go - :feature 'builtin - `((call_expression - function: ((identifier) @font-lock-builtin-face - (:match ,(rx-to-string - `(seq bol - (or ,@go-ts-mode--builtin-functions) - eol)) - @font-lock-builtin-face)))) - - :language 'go - :feature 'constant - `([(false) (nil) (true)] @font-lock-constant-face - ,@(when (go-ts-mode--iota-query-supported-p) - '((iota) @font-lock-constant-face)) - (const_declaration - (const_spec name: (identifier) @font-lock-constant-face - ("," name: (identifier) @font-lock-constant-face)*))) - - :language 'go - :feature 'delimiter - '((["," "." ";" ":"]) @font-lock-delimiter-face) - - :language 'go - :feature 'operator - `([,@go-ts-mode--operators] @font-lock-operator-face) - - :language 'go - :feature 'definition - `((function_declaration - name: (identifier) @font-lock-function-name-face) - (method_declaration - name: (field_identifier) @font-lock-function-name-face) - (,(if (go-ts-mode--method-elem-supported-p) - 'method_elem - 'method_spec) - name: (field_identifier) @font-lock-function-name-face) - (field_declaration - name: (field_identifier) @font-lock-property-name-face) - (parameter_declaration - name: (identifier) @font-lock-variable-name-face) - (variadic_parameter_declaration - name: (identifier) @font-lock-variable-name-face) - (short_var_declaration - left: (expression_list - (identifier) @font-lock-variable-name-face - ("," (identifier) @font-lock-variable-name-face)*)) - (var_spec name: (identifier) @font-lock-variable-name-face - ("," name: (identifier) @font-lock-variable-name-face)*) - (range_clause - left: (expression_list - (identifier) @font-lock-variable-name-face))) - - :language 'go - :feature 'function - '((call_expression - function: (identifier) @font-lock-function-call-face) - (call_expression - function: (selector_expression - field: (field_identifier) @font-lock-function-call-face))) - - :language 'go - :feature 'keyword - `([,@go-ts-mode--keywords] @font-lock-keyword-face) - - :language 'go - :feature 'label - '((label_name) @font-lock-constant-face) - - :language 'go - :feature 'number - '([(float_literal) - (imaginary_literal) - (int_literal)] @font-lock-number-face) - - :language 'go - :feature 'string - '([(interpreted_string_literal) - (raw_string_literal) - (rune_literal)] @font-lock-string-face) - - :language 'go - :feature 'type - '([(package_identifier) (type_identifier)] @font-lock-type-face) - - :language 'go - :feature 'property - '((selector_expression field: (field_identifier) @font-lock-property-use-face) - (keyed_element (_ (identifier) @font-lock-property-use-face))) - - :language 'go - :feature 'variable - '((identifier) @font-lock-variable-use-face) - - :language 'go - :feature 'escape-sequence - :override t - '((escape_sequence) @font-lock-escape-face) - - :language 'go - :feature 'error - :override t - '((ERROR) @font-lock-warning-face))))) + :language 'go + :feature 'error + :override t + '((ERROR) @font-lock-warning-face))) (defvar-keymap go-ts-mode-map :doc "Keymap used in Go mode, powered by tree-sitter" diff --git a/lisp/treesit.el b/lisp/treesit.el index 69abe869cd8..9a6dedf1ae5 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1279,6 +1279,46 @@ LANGUAGE's name and return the resulting string." "Generic tree-sitter font-lock error" 'treesit-error) + +;; String form and sexp form will be keyed differently, but that's not a +;; big deal. We can't really use a weak table: it's possible that the +;; query won't be referenced if all major modes are closed; error data +;; isn't going to be referenced at all but we need to retend it. +(defvar treesit--query-cache (make-hash-table :test #'equal) + "Cache of compiled queries for font-lock/indentation. + +They keys are (LANG . QUERY), where QUERY can be in string or sexp form; +the values are either compiled queries or error data (returned by +`treesit-query-compile'). + +This table only stores actually (eagerly) compiled queries. (Normally, +compiled query objects are compiled lazily upon first use.)") + +(defun treesit--compile-query-with-cache (lang query) + "Return the cached compiled QUERY for LANG. + +If QUERY isn't cached, compile it and save to cache. + +If QUERY is invalid, signals `treesit-query-error'. The fact that QUERY +is invalid is also stored in cache, and the next call to this function +with the same QUERY will signal too. + +QUERY is compared with `equal', so string form vs sexp form of a query, +and the same query written differently are all considered separate +queries." + (let ((value (gethash (cons lang query) treesit--query-cache))) + (if value + (if (treesit-compiled-query-p value) + value + (signal 'treesit-query-error value)) + (condition-case err + (let ((compiled (treesit-query-compile lang query 'eager))) + (puthash (cons lang query) compiled treesit--query-cache) + compiled) + (treesit-query-error + (puthash (cons lang query) (cdr err) treesit--query-cache) + (signal 'treesit-query-error (cdr err))))))) + (defvar-local treesit-font-lock-settings nil "A list of SETTINGs for treesit-based fontification. @@ -1292,10 +1332,9 @@ debugging: Currently each SETTING has the form: - (QUERY ENABLE FEATURE OVERRIDE REVERSE) + (QUERY ENABLE FEATURE OVERRIDE REVERSE LANGUAGE) -QUERY must be a compiled query. See Info node `(elisp)Pattern -Matching' for how to write a query and compile it. +QUERY is a tree-sitter query in either string, sexp, or compiled form. For SETTING to be activated for font-lock, ENABLE must be t. To disable this SETTING, set ENABLE to nil. @@ -1309,7 +1348,9 @@ t, nil, append, prepend, keep. See more in `treesit-font-lock-rules'. If REVERSED is t, enable the QUERY when FEATURE is not in the feature -list.") +list. + +LANGUAGE is the language of QUERY.") ;; Follow cl-defstruct naming conventions, in case we use cl-defstruct ;; in the future. @@ -1333,6 +1374,10 @@ list.") "Return the REVERSED flag of SETTING in `treesit-font-lock-settings'." (nth 4 setting)) +(defsubst treesit-font-lock-setting-language (setting) + "Return the LANGUAGE of SETTING in `treesit-font-lock-settings'." + (nth 5 setting)) + (defsubst treesit--font-lock-setting-clone-enable (setting) "Return enabled SETTING." (let ((new-setting (copy-tree setting))) @@ -1433,9 +1478,10 @@ QUERY preceded by multiple pairs of :KEYWORD and VALUE: :KEYWORD VALUE... QUERY -QUERY is a tree-sitter query in either the string, s-expression -or compiled form. For each query, captured nodes are highlighted -with the capture name as its face. +QUERY is a tree-sitter query in either the string, s-expression or +compiled form. For each query, captured nodes are highlighted with the +capture name as its face. QUERY is compiled automatically when it's +first used in a major mode. :KEYWORD and VALUE pairs preceding a QUERY add meta information to QUERY. For example, @@ -1554,14 +1600,13 @@ name, it is ignored." (when (null current-feature) (signal 'treesit-font-lock-error `("Feature unspecified, use :feature keyword to specify the feature name for this query" ,token))) - (if (treesit-compiled-query-p token) - (push `(,lang token) result) - (push `(,(treesit-query-compile lang token) - t - ,current-feature - ,current-override - ,current-reversed) - result)) + (push (list token + t + current-feature + current-override + current-reversed + current-language) + result) ;; Clears any configurations set for this query. (setq current-language nil current-override nil @@ -1571,6 +1616,22 @@ name, it is ignored." `("Unexpected value" ,token)))))) (nreverse result)))) +(defun treesit-query-with-optional (language mandatory &rest queries) + "Return the MANDATORY query plus first valid QUERIES. + +MANDATORY query is always included. Queries in QUERIES are included if +they're valid. MANDATORY query and queries in QUERIES must be in sexp +form for composition. + +Use LANGUAGE for validating queries." + (declare (indent 1)) + (let (optional) + (dolist (query queries) + (ignore-errors + (when (treesit--compile-query-with-cache language query) + (push query optional)))) + (append mandatory optional))) + ;; `font-lock-fontify-region-function' has the LOUDLY argument, but ;; `jit-lock-functions' doesn't pass that argument. So even if we set ;; `font-lock-verbose' to t, if jit-lock is enabled (and it's almost @@ -1635,8 +1696,7 @@ and leave settings for other languages unchanged." (additive (or add-list remove-list))) (cl-loop for idx = 0 then (1+ idx) for setting in treesit-font-lock-settings - for lang = (treesit-query-language - (treesit-font-lock-setting-query setting)) + for lang = (treesit-font-lock-setting-language setting) for feature = (treesit-font-lock-setting-feature setting) for current-value = (treesit-font-lock-setting-enable setting) for reversed = (treesit-font-lock-setting-reversed setting) @@ -1681,12 +1741,10 @@ Return a value suitable for `treesit-font-lock-settings'" (let ((result nil)) (dolist (new-setting new-settings) (let ((new-feature (treesit-font-lock-setting-feature new-setting)) - (new-lang (treesit-query-language - (treesit-font-lock-setting-query new-setting)))) + (new-lang (treesit-font-lock-setting-language new-setting))) (dolist (setting settings) (let ((feature (treesit-font-lock-setting-feature setting)) - (lang (treesit-query-language - (treesit-font-lock-setting-query setting)))) + (lang (treesit-font-lock-setting-language setting))) (if (and (eq new-lang lang) (eq new-feature feature)) (push new-setting result) (push setting result)))))) @@ -1729,8 +1787,11 @@ docstring of `treesit-font-lock-rules' for what is a feature." (append rules (nthcdr feature-idx treesit-font-lock-settings))))))) -(defun treesit-validate-font-lock-rules (settings) - "Validate font-lock rules in SETTINGS before major mode starts. +(defun treesit-validate-and-compile-font-lock-rules (settings) + "Validate and resolve font-lock rules in SETTINGS before major mode starts. + +For each enabled setting, if query isn't compiled, compile it and +replace the query In-PLACE. If the tree-sitter grammar currently installed on the system is incompatible with the major mode's font-lock rules, this procedure will @@ -1739,17 +1800,17 @@ user." (let ((faulty-features ())) (dolist (setting settings) (let* ((query (treesit-font-lock-setting-query setting)) - (lang (treesit-query-language query)) + (lang (treesit-font-lock-setting-language setting)) (enabled (treesit-font-lock-setting-enable setting))) - (when (and enabled - (condition-case nil - (progn - (treesit-query-compile lang query 'eager) - nil) - (treesit-query-error t))) - (push (cons (treesit-font-lock-setting-feature setting) - lang) - faulty-features)))) + (when enabled + (condition-case nil + (let ((compiled (treesit--compile-query-with-cache lang query))) + ;; Here we're modifying SETTINGS in-place. + (setcar setting compiled)) + (treesit-query-error + (push (cons (treesit-font-lock-setting-feature setting) + lang) + faulty-features)))))) (when faulty-features (treesit-font-lock-recompute-features nil (mapcar #'car faulty-features)) @@ -1932,7 +1993,7 @@ If LOUDLY is non-nil, display some debugging information." (let* ((query (treesit-font-lock-setting-query setting)) (enable (treesit-font-lock-setting-enable setting)) (override (treesit-font-lock-setting-override setting)) - (language (treesit-query-language query)) + (language (treesit-font-lock-setting-language setting)) (root-nodes (cl-remove-if-not (lambda (node) (eq (treesit-node-language node) language)) @@ -4368,6 +4429,11 @@ before calling this function." (setq treesit-primary-parser (treesit--guess-primary-parser))) ;; Font-lock. (when treesit-font-lock-settings + ;; Functions like `treesit-font-lock-recompute-features' and + ;; `treesit-validate-and-compile-font-lock-rules' modifies + ;; `treesit-font-lock-settings' in-place, so make a copy to protect + ;; the original variable defined in major mode code. + (setq treesit-font-lock-settings (copy-tree treesit-font-lock-settings)) ;; `font-lock-mode' wouldn't set up properly if ;; `font-lock-defaults' is nil, see `font-lock-specified-p'. (setq-local font-lock-defaults @@ -4375,8 +4441,8 @@ before calling this function." (font-lock-fontify-syntactically-function . treesit-font-lock-fontify-region))) (treesit-font-lock-recompute-features) - (add-hook 'pre-redisplay-functions #'treesit--pre-redisplay 0 t) - (treesit-validate-font-lock-rules treesit-font-lock-settings)) + (treesit-validate-and-compile-font-lock-rules treesit-font-lock-settings) + (add-hook 'pre-redisplay-functions #'treesit--pre-redisplay 0 t)) ;; Syntax (add-hook 'syntax-propertize-extend-region-functions #'treesit--pre-syntax-ppss 0 t) commit 4565870dfa01bba7073813fa749113417885417c Author: Elías Gabriel Pérez Date: Mon Oct 13 19:20:27 2025 -0600 hideshow: Add new option for control how the block should be hidden. bug#79585 * doc/emacs/programs.texi (Hideshow): * etc/NEWS: Document changes. * lisp/progmodes/hideshow.el (hs-hide-behavior): New user option. (hs-life-goes-on): Add 'save-excursion' and 'save-match-data'. (hs-hide-block): Rework. diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 22968ea878b..f42f40fa28f 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -1734,6 +1734,7 @@ Hide all blocks @var{n} levels below this block @vindex hs-indicator-type @vindex hs-indicator-maximum-buffer-size @vindex hs-isearch-open +@vindex hs-hide-block-behavior @vindex hs-special-modes-alist These variables can be used to customize Hideshow mode: @@ -1742,6 +1743,12 @@ Hide all blocks @var{n} levels below this block If non-@code{nil}, @kbd{C-c @@ C-M-h} (@code{hs-hide-all}) hides comments too. +@item hs-hide-block-behavior +This variable controls how @code{hs-hide-block} and +@code{hs-toggle-hiding} should hide a block. The possible values can be +'after-bol', hide the innermost block to which the current line belongs; +or 'after-cursor', hide the block after cursor position. + @item hs-display-lines-hidden If non-@code{nil}, display the number of hidden lines next to the ellipsis. diff --git a/etc/NEWS b/etc/NEWS index 94a01a63649..59807789e9d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1057,6 +1057,13 @@ The new icons 'hs-indicator-show' and 'hs-indicator-hide' can be used to customize the indicators appearance only if 'hs-indicator-type' is set to 'margin' or nil. ++++ +*** New user option 'hs-hide-block-behavior'. +This user option controls how 'hs-hide-block' and 'hs-toggle-hiding' +should hide a block. If set to 'after-bol', hide the innermost block to +which the current line belongs. If set to 'after-cursor', hide the block +after cursor position. By default this is set to 'after-bol'. + ** C-ts mode +++ diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index d01f855a7f8..6d3a5bc9fe6 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -253,6 +253,20 @@ use that face for the ellipsis instead." "Hide the comments too when you do an `hs-hide-all'." :type 'boolean) +(defcustom hs-hide-block-behavior 'after-bol + "How hideshow should hide a block. +If set to `after-bol', hide the innermost block to which the current +line belongs. + +If set to `after-cursor', hide the block after cursor position. + +This only have effect in `hs-hide-block' and `hs-toggle-hiding' +commands." + :type '(choice + (const :tag "Hide the block after cursor" after-bol) + (const :tag "Hide the block after beginning of current line" after-cursor)) + :version "31.1") + (defcustom hs-display-lines-hidden nil "If non-nil, display the number of hidden lines next to the ellipsis." :type 'boolean @@ -884,7 +898,10 @@ specifies the limits of the comment, or nil if the block is not a comment. The block beginning is adjusted by `hs-adjust-block-beginning' -and then further adjusted to be at the end of the line." +and then further adjusted to be at the end of the line. + +If hidding the block is successful, return non-nil. +Otherwise, return nil." (if comment-reg (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end) (when-let* ((block (hs-block-positions))) @@ -899,7 +916,8 @@ and then further adjusted to be at the end of the line." (hs-discard-overlays p q))) (goto-char q) (hs-make-overlay p q 'code (- (match-end 0) p))) - (goto-char (if end q (min p (match-end 0))))))))) + (goto-char (if end q (min p (match-end 0)))) + nil))))) (defun hs-inside-comment-p () "Return non-nil if point is inside a comment, otherwise nil. @@ -1056,7 +1074,8 @@ In the dynamic context of this macro, `case-fold-search' is t." (declare (debug t)) `(when hs-minor-mode (let ((case-fold-search t)) - ,@body))) + (save-match-data + (save-excursion ,@body))))) (defun hs-find-block-beginning-match () "Reposition point at the end of match of the block-start regexp. @@ -1176,13 +1195,28 @@ Upon completion, point is repositioned and the normal hook (cond ((and c-reg (or (null (nth 0 c-reg)) (not (hs-hideable-region-p (car c-reg) (nth 1 c-reg))))) - (message "(not enough comment lines to hide)")) - ((or c-reg - (funcall hs-looking-at-block-start-p-func) - (funcall hs-find-block-beginning-func)) - (hs-hide-block-at-point end c-reg) - (hs--refresh-indicators) - (run-hooks 'hs-hide-hook)))))) + (user-error "(not enough comment lines to hide)")) + + (c-reg (hs-hide-block-at-point end c-reg)) + + ((or (and (eq hs-hide-block-behavior 'after-bol) + (save-excursion + (goto-char (line-beginning-position)) + (funcall hs-find-next-block-func hs-block-start-regexp + (line-end-position) nil)) + (goto-char (match-beginning 0))) + (funcall hs-looking-at-block-start-p-func)) + ;; If hidding the block fails (due the block is not hideable) + ;; Then just hide the parent block (if possible) + (unless (save-excursion (hs-hide-block-at-point end)) + (goto-char (1- (point))) + (funcall hs-find-block-beginning-func) + (hs-hide-block-at-point end))) + + ((funcall hs-find-block-beginning-func) + (hs-hide-block-at-point end))) + + (run-hooks 'hs-hide-hook)))) (defun hs-show-block (&optional end) "Select a block and show it. commit 498f89af2ab525c6f3ccdc15f76099c6e644345b Author: Mattias Engdegård Date: Mon Oct 20 17:53:48 2025 +0200 Don't feed the stack overflow detector bad data * src/lisp.h (record_in_backtrace): Don't record the argument address as stack_top because most of the time it won't be on the C stack at all. * src/eval.c (eval_sub): Do it here instead using an address guaranteed to be on the C stack and we are just in the Lisp interpreter anyway. diff --git a/src/eval.c b/src/eval.c index 2dc14b6d431..0c29de9f3ad 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2590,6 +2590,9 @@ eval_sub (Lisp_Object form) /* Declare here, as this array may be accessed by call_debugger near the end of this function. See Bug#21245. */ Lisp_Object argvals[8]; + /* The stack overflow detection probably isn't worth the effort any more + but this may be the least bad spot to feed it. */ + current_thread->stack_top = argvals; retry: diff --git a/src/lisp.h b/src/lisp.h index ecc20600dd0..8da5f4f1475 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3786,7 +3786,7 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; specpdl_ptr->bt.debug_on_exit = false; specpdl_ptr->bt.function = function; - current_thread->stack_top = specpdl_ptr->bt.args = args; + specpdl_ptr->bt.args = args; specpdl_ptr->bt.nargs = nargs; grow_specpdl (); commit e443811bd776623cb85143ff3333112b783ad505 Author: Mattias Engdegård Date: Mon Oct 20 16:25:55 2025 +0200 ; * test/lisp/vc/vc-tests/vc-tests.el: use write-region, again diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index 140926a9263..7d109b31ffc 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -802,7 +802,7 @@ This checks also `vc-backend' and `vc-responsible-backend'." ,@body) (cancel-change-group ,handle) (with-current-buffer ,buf - (basic-save-buffer)))))) + (write-region nil nil buffer-file-name nil t)))))) (defun vc-test--checkin-patch (backend) "Test preparing and checking in patches." commit 095956a745fa44e35f5bab4bfb53ef6b3ccc3f80 Author: Sean Whitton Date: Mon Oct 20 15:16:05 2025 +0100 vc-test--with-temp-change: Use write-region * test/lisp/vc/vc-tests/vc-tests.el (vc-test--with-temp-change): Use write-region (bug#79657). diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index 960bc83f357..140926a9263 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -798,7 +798,7 @@ This checks also `vc-backend' and `vc-responsible-backend'." (with-current-buffer ,buf (activate-change-group ,handle) (insert "bar\n") - (basic-save-buffer) + (write-region nil nil buffer-file-name nil t) ,@body) (cancel-change-group ,handle) (with-current-buffer ,buf commit fb48f6016e3faa669dbdba59971c17ed391eb88c Author: Michael Albinus Date: Mon Oct 20 14:58:38 2025 +0200 Revert "* test/lisp/net/tramp-resources/foo.tar.gz: Remove." This reverts commit e5cd797988a5b2fddaf1c850d797674a299bc574. diff --git a/test/lisp/net/tramp-resources/foo.tar.gz b/test/lisp/net/tramp-resources/foo.tar.gz new file mode 100644 index 00000000000..0d2e9878dd7 Binary files /dev/null and b/test/lisp/net/tramp-resources/foo.tar.gz differ commit e5cd797988a5b2fddaf1c850d797674a299bc574 Author: Michael Albinus Date: Mon Oct 20 14:43:04 2025 +0200 * test/lisp/net/tramp-resources/foo.tar.gz: Remove. diff --git a/test/lisp/net/tramp-resources/foo.tar.gz b/test/lisp/net/tramp-resources/foo.tar.gz deleted file mode 100644 index 0d2e9878dd7..00000000000 Binary files a/test/lisp/net/tramp-resources/foo.tar.gz and /dev/null differ commit c024b9c66160d8d1643ee75eed3174f3b5699b59 Author: Michael Albinus Date: Mon Oct 20 14:42:12 2025 +0200 Tramp cleanup * doc/misc/tramp.texi (Configuration): Extend example. * lisp/net/tramp.el (tramp-skeleton-write-region): * lisp/net/tramp-cache.el (tramp-flush-file-upper-properties): * lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory): Use `when-let*' consequently. * lisp/net/tramp-cmds.el (tramp-file-name-with-method): Add :initialize and :set functions. (tramp-set-file-name-with-method): New defun. (with-tramp-file-name-with-method): Filter out enabled methods. * lisp/net/tramp-compat.el: Add TODO. * test/lisp/net/tramp-archive-tests.el (tramp-archive-test-cascaded-file-archive): Use "foo.zip". * test/lisp/net/tramp-tests.el (tramp--test-instrument-test-case-p): Extend check. (tramp-test48-session-timeout): Adapt test. * test/lisp/net/tramp-archive-resources/foo.zip: Renamed from outer.zip. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 7b3a4808a45..7ddf6758ae5 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -678,7 +678,10 @@ not auto loaded by Emacs. All examples require @value{tramp} to be installed and loaded: @lisp +@group +(require 'tramp) (customize-set-variable 'tramp-verbose 6 "Enable remote command traces") +@end group @end lisp For functions used to configure @value{tramp}, the following clause diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index c8223d859c7..941c502fa83 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -253,19 +253,19 @@ Return VALUE." (defun tramp-flush-file-upper-properties (key file) "Remove some properties of FILE's upper directory." - (when (file-name-absolute-p file) - ;; `file-name-directory' can return nil, for example for "~". - (when-let* ((file (file-name-directory file)) - (file (directory-file-name file))) - (setq key (tramp-file-name-unify key file)) - (unless (eq key tramp-cache-undefined) - (dolist (property (hash-table-keys (tramp-get-hash-table key))) - (when (string-match-p - (rx - bos (| "directory-" "file-name-all-completions" - "file-entries")) - property) - (tramp-flush-file-property key file property))))))) + (when-let* (((file-name-absolute-p file)) + ;; `file-name-directory' can return nil, for example for "~". + (file (file-name-directory file)) + (file (directory-file-name file))) + (setq key (tramp-file-name-unify key file)) + (unless (eq key tramp-cache-undefined) + (dolist (property (hash-table-keys (tramp-get-hash-table key))) + (when (string-match-p + (rx + bos (| "directory-" "file-name-all-completions" + "file-entries")) + property) + (tramp-flush-file-property key file property)))))) ;;;###tramp-autoload (defun tramp-flush-file-properties (key file) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index a4f74383325..db3737500e6 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -632,13 +632,28 @@ For details, see `tramp-rename-files'." "Which method to be used in `tramp-file-name-with-sudo'." :group 'tramp :version "31.1" + ;; It should be a choice of constant strings. See + ;; `with-tramp-file-name-with-method'. :type '(choice (const "su") (const "surs") (const "sudo") (const "sudors") (const "doas") (const "run0") (const "ksu")) + :initialize #'custom-initialize-default + :set #'tramp-set-file-name-with-method :link '(tramp-info-link :tag "Tramp manual" tramp-file-name-with-method)) +(defun tramp-set-file-name-with-method (symbol value) + "Set SYMBOL to value VALUE. +Used in user option `tramp-file-name-with-method'. If VALUE is an +optional method, enable it." + (unless (string-equal (symbol-value symbol) value) + ;; Enable optional method. + (tramp-enable-method value) + ;; Set the value. + (when (assoc value tramp-methods) + (set-default symbol value)))) + (defun tramp-get-file-name-with-method () "Return connection-local value of `tramp-file-name-with-method'." (tramp-compat-connection-local-value tramp-file-name-with-method)) @@ -651,8 +666,11 @@ Run BODY." (if current-prefix-arg (completing-read "Tramp method: " - (mapcar - #'cadr (cdr (get 'tramp-file-name-with-method 'custom-type))) + ;; Filter out enabled methods. + (seq-intersection + (mapcar #'car tramp-methods) + (mapcar + #'cadr (cdr (get 'tramp-file-name-with-method 'custom-type)))) nil t (tramp-get-file-name-with-method)) (tramp-get-file-name-with-method)))) ,@body)) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 5d463bc0062..93190fec3a7 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -259,5 +259,8 @@ value is the default binding of the variable." ;; instead of `condition-case' when the origin of an error shall be ;; kept, for example when the HANDLER propagates the error with ;; `(signal (car err) (cdr err)'. +;; +;; * Starting with Emacs 30.1, use '(_ VALUEFORM)' instead of +;; '(VALUEFORM)' in 'if-let*/when-let*/and-let*'. ;;; tramp-compat.el ends here diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 98e3cae5a79..61f64e4c024 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2934,15 +2934,15 @@ The method used must be an out-of-band method." ;; Try to insert the amount of free space. (goto-char (point-min)) ;; First find the line to put it on. - (when (and (search-forward-regexp - (rx bol (group (* blank) "total")) nil t) - ;; Emacs 29.1 or later. - (not (fboundp 'dired--insert-disk-space))) - (when-let* ((available (get-free-disk-space "."))) - ;; Replace "total" with "total used", to avoid confusion. - (replace-match "\\1 used in directory") - (end-of-line) - (insert " available " available)))) + (when-let* (((search-forward-regexp + (rx bol (group (* blank) "total")) nil t)) + ;; Emacs 29.1 or later. + ((not (fboundp 'dired--insert-disk-space))) + (available (get-free-disk-space "."))) + ;; Replace "total" with "total used", to avoid confusion. + (replace-match "\\1 used in directory") + (end-of-line) + (insert " available " available))) (prog1 (goto-char end-marker) (set-marker beg-marker nil) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ec57aca0568..261fbc1139d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -941,7 +941,7 @@ to be set, depending on VALUE." ;; Cleanup existing buffers. (unless (eq (symbol-value symbol) value) (tramp-cleanup-all-buffers)) - ;; Set the value: + ;; Set the value. (set-default symbol value) ;; Reset the depending variables. (setq tramp-prefix-format (tramp-build-prefix-format) @@ -4088,17 +4088,17 @@ BODY is the backend specific code." (let (last-coding-system-used (need-chown t)) ;; Set file modification time. - (when (or (eq ,visit t) (stringp ,visit)) - (when-let* ((file-attr (file-attributes filename 'integer))) - (set-visited-file-modtime - ;; We must pass modtime explicitly, because FILENAME - ;; can be different from (buffer-file-name), f.e. if - ;; `file-precious-flag' is set. - (or (file-attribute-modification-time file-attr) - (current-time))) - (when (and (= (file-attribute-user-id file-attr) uid) - (= (file-attribute-group-id file-attr) gid)) - (setq need-chown nil)))) + (when-let* (((or (eq ,visit t) (stringp ,visit))) + (file-attr (file-attributes filename 'integer))) + (set-visited-file-modtime + ;; We must pass modtime explicitly, because FILENAME + ;; can be different from (buffer-file-name), f.e. if + ;; `file-precious-flag' is set. + (or (file-attribute-modification-time file-attr) + (current-time))) + (when (and (= (file-attribute-user-id file-attr) uid) + (= (file-attribute-group-id file-attr) gid)) + (setq need-chown nil))) ;; Set the ownership. (when need-chown @@ -7221,6 +7221,7 @@ Consults the auth-source package." (tramp-compat-auth-info-password auth-info)))) ;; Try the password cache. + ;; Starting with Emacs 31.1, this isn't needed anymore. (with-tramp-suspended-timers (setq auth-passwd (password-read diff --git a/test/lisp/net/tramp-archive-resources/outer.zip b/test/lisp/net/tramp-archive-resources/foo.zip similarity index 100% rename from test/lisp/net/tramp-archive-resources/outer.zip rename to test/lisp/net/tramp-archive-resources/foo.zip diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index ec56c4a0f93..5e9ea756b93 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -45,7 +45,7 @@ "A directory file name, which looks like an archive.") (defvar tramp-archive-test-cascaded-file-archive - (ert-resource-file "outer.zip/foo.tar.gz") + (ert-resource-file "foo.zip/foo.tar.gz") "The cascaded test file archive.") (defvar tramp-archive-test-cascaded-archive diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3432e6eb706..2de753fb884 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -181,8 +181,11 @@ The temporary file is not created." `(condition-case err (progn ,@body) (file-error - (unless (string-equal (error-message-string err) - "make-symbolic-link not supported") + (unless (string-match-p + (rx bol (| "make-symbolic-link not supported" + (: "Making symbolic link" + (? ":") " Operation not permitted"))) + (error-message-string err)) (signal (car err) (cdr err)))))) ;; Don't print messages in nested `tramp--test-instrument-test-case' calls. @@ -8540,8 +8543,7 @@ process sentinels. They shall not disturb each other." (ert-deftest tramp-test48-session-timeout () "Check that Tramp handles a session timeout properly." (skip-unless (tramp--test-enabled)) - (skip-unless - (tramp-get-method-parameter tramp-test-vec 'tramp-session-timeout)) + (skip-unless (tramp--test-sh-p)) ;; We want to see the timeout message. (tramp--test-instrument-test-case 3 commit 71526e7584b91bf0c67f7ac87b93642f3d8ec0d8 Author: Eli Zaretskii Date: Mon Oct 20 15:09:07 2025 +0300 Avoid unnecessary y-or-n-p questions in client frames * lisp/server.el (server-visit-files): Don't consider the file as having disappeared if it never existed when visited previously. Doc fix. (Bug#79609) diff --git a/lisp/server.el b/lisp/server.el index 70299d52f18..4390562a580 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1589,6 +1589,7 @@ LINE-COL should be a pair (LINE . COL)." (defun server-visit-files (files proc &optional nowait) "Find FILES and return a list of buffers created. +If some file was deleted since last visited, offer to save its buffer. FILES is an alist whose elements are (FILENAME . FILEPOS) where FILEPOS can be nil or a pair (LINENUMBER . COLUMNNUMBER). PROC is the client that requested this operation. @@ -1620,7 +1621,9 @@ so don't mark these buffers specially, just visit them normally." (cond ((file-exists-p filen) (when (not (verify-visited-file-modtime obuf)) (revert-buffer t nil))) - (t + ;; Only ask the question if the file did exist at some + ;; point, but was deleted since. + ((listp (visited-file-modtime)) (when (y-or-n-p (concat "File no longer exists: " filen ", write buffer to file? ")) commit 61a05c308881fcda2e9f29e58065a4ff6ae1657d Author: João Távora Date: Mon Oct 20 12:53:37 2025 +0100 Eglot: expand on eglot-workspace-configuration sections (bug#79655) * doc/misc/eglot.texi (Project-specific configuration): Clarify section. diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index fac90562f6b..449b871b776 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -1287,14 +1287,24 @@ To apply this to Eglot, and assuming you chose the @end lisp @noindent -This sets the value of @code{eglot-workspace-configuration} in all the -buffers inside the project; each server will use only the section of the -parameters intended for that server, and ignore the rest. Note how -alists are used for associating Emacs mode names with alists associating -variable names with variable values. Then notice how plists are used -inside the value of @code{eglot-workspace-configuration}. - -This following form may also be used: +Note how alists are used for associating Emacs mode names with other +alists, associating variable names with variable values. Then, pay +special attention to how the value of +@code{eglot-workspace-configuration} is a plist and @emph{not} an alist. + +The above form sets the value of @code{eglot-workspace-configuration} in +all the buffers inside the project; each language server will then use +only the section of the parameters intended for it, and ignore the rest. +In our example, @command{pylsp} and @command{gopls} are solely +interested in the @code{:pylsp} and @code{:gopls} parameter section +names, respectively. However, section names don't have to match the +server name and some servers may be even interested in multiple +sections: the @command{typescript-language-server} server is known to be +interested in the @code{:javascript} and @code{:typescript} section +names. + +To avoid sending whole configuration sections to servers who are +decidedly not interested in them, the following form may also be used: @lisp ((python-base-mode @@ -1316,11 +1326,11 @@ buffers. @code{python-base-mode} buffers will have the variable set to @code{(:pylsp (:plugins ...))}. @code{go-mode} buffers will have the variable set to @code{(:gopls (:usePlaceholders t))}. -Some servers will issue workspace configuration for specific files -inside your project. For example, if you know @code{gopls} is asking -about specific files in the @code{src/imported} subdirectory and you -want to set a different option for @code{gopls.usePlaceholders} , you -may use something like: +Some servers will issue workspace configuration for specific source +files inside your project. For example, if you know @code{gopls} is +asking about specific files in the @code{src/imported} subdirectory and +you want to set a different option for @code{gopls.usePlaceholders} , +you may use something like: @lisp ((python-base-mode @@ -1340,10 +1350,10 @@ may use something like: Finally, if one needs to determine the workspace configuration based on some dynamic context, @code{eglot-workspace-configuration} can be set to -a function. The function is called with the @code{eglot-lsp-server} -instance of the connected server (if any) and with -@code{default-directory} set to the root of the project. The function -should return a plist suitable for use as the variable's value. +a function instead of a plist. The function is called with the +@code{eglot-lsp-server} instance of the connected server (if any) and +with @code{default-directory} set to the root of the project. The +function should return a plist suitable for use as the variable's value. @node User-specific configuration @section User-specific configuration commit 3179f3aba0a06cfc9b0b4c95e7c959b75c711524 Author: Mattias Engdegård Date: Mon Oct 20 12:55:19 2025 +0200 ; * lisp/emacs-lisp/rx.el (rx--foldl): Replace with 'all' and 'any'. diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 229f1dbb57b..77237b8e5a7 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -267,13 +267,6 @@ Return (REGEXP . PRECEDENCE)." "Regexp that never matches anything." (cons (list regexp-unmatchable) 'seq)) -;; `cl-every' replacement to avoid bootstrapping problems. -(defun rx--every (pred list) - "Whether PRED is true for every element of LIST." - (while (and list (funcall pred (car list))) - (setq list (cdr list))) - (null list)) - (defun rx--foldl (f x l) "(F (F (F X L0) L1) L2) ... Left-fold the list L, starting with X, by the binary function F." @@ -454,10 +447,10 @@ Each element of ARGS should have been normalised using (defun rx--all-string-branches-p (forms) "Whether FORMS are all strings or `or' forms with the same property." - (rx--every (lambda (x) (or (stringp x) - (and (eq (car-safe x) 'or) - (rx--all-string-branches-p (cdr x))))) - forms)) + (all (lambda (x) (or (stringp x) + (and (eq (car-safe x) 'or) + (rx--all-string-branches-p (cdr x))))) + forms)) (defun rx--collect-or-strings (forms) "All strings from FORMS, which are strings or `or' forms." @@ -598,10 +591,10 @@ classes." ;; regexp engine. Ranges from ASCII to raw bytes will exclude the ;; all non-ASCII non-raw bytes, and ranges from non-ASCII Unicode ;; to raw bytes are ignored. - (unless (or classes - ;; Any interval set covering #x3fff7f should be negated. - (rx--every (lambda (iv) (not (<= (car iv) #x3fff7f (cdr iv)))) - intervals)) + (when (and (not classes) + ;; Any interval set covering #x3fff7f should be negated. + (any (lambda (iv) (<= (car iv) #x3fff7f (cdr iv))) + intervals)) (setq negated (not negated)) (setq intervals (rx--interval-set-complement intervals))) (cond @@ -1132,7 +1125,7 @@ DEF is the definition tuple. Return (REGEXP . PRECEDENCE)." (when (and max-args (> nargs max-args)) (error "The `%s' form takes at most %d argument(s)" (car form) max-args)) - (when (and predicate (not (rx--every predicate (cdr form)))) + (when (and predicate (not (all predicate (cdr form)))) (error "The `%s' form requires arguments satisfying `%s'" (car form) predicate)) (let ((regexp (funcall fn form))) @@ -1535,7 +1528,7 @@ TAIL is on the form ([ARGLIST] DEFINITION)." (`(,def) (list def)) (`(,args ,def) - (unless (and (listp args) (rx--every #'symbolp args)) + (unless (and (listp args) (all #'symbolp args)) (error "Bad argument list for `rx' definition %s: %S" name args)) (list args def)) (_ (error "Bad `rx' definition of %s: %S" name tail)))) commit d1b3eb7eec64ffb9f2d89efda21660cab92bcf0c Author: Mattias Engdegård Date: Fri Oct 10 15:39:15 2025 +0200 Add any and all (bug#79611) * lisp/subr.el (all, any): New. * test/lisp/subr-tests.el (subr-all, subr-any): New tests. * doc/lispref/lists.texi (List Elements): Document. * etc/NEWS: Announce. diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index da6d167c740..37ef8d46525 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -415,6 +415,33 @@ will return a list equal to @var{list}. @end example @end defun +@defun all pred list +This function returns @code{t} if @var{pred} is true for all elements in +@var{list}. + +@example +@group +(all #'numberp '(1 2 3 4)) @result{} t +(all #'numberp '(1 2 a b 3 4)) @result{} nil +(all #'numberp '()) @result{} t +@end group +@end example +@end defun + +@defun any pred list +This function returns non-@code{nil} if @var{pred} is true for at least +one element in @var{list}. The returned value is the longest @var{list} +suffix whose first element satisfies @var{pred}. + +@example +@group +(any #'symbolp '(1 2 3 4)) @result{} nil +(any #'symbolp '(1 2 a b 3 4)) @result{} (a b 3 4) +(any #'symbolp '()) @result{} nil +@end group +@end example +@end defun + @defun last list &optional n This function returns the last link of @var{list}. The @code{car} of this link is the list's last element. If @var{list} is null, diff --git a/etc/NEWS b/etc/NEWS index cf608578c34..94a01a63649 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3142,6 +3142,11 @@ signal an error if they are given a non-integer. ** New functions 'drop-while' and 'take-while'. These work like 'drop' and 'take' but use a predicate instead of counting. ++++ +** New functions 'any' and 'all'. +These return non-nil for lists where any and all elements, respectively, +satisfy a given predicate. + +++ ** The 'defvar-local' macro second argument is now optional. This means that you can now call it with just one argument, like diff --git a/lisp/subr.el b/lisp/subr.el index 403e9dac376..216ad5eb4ab 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1176,6 +1176,20 @@ side-effects, and the argument LIST is not modified." (while (and list (funcall pred (car list))) (setq list (cdr list))) list) + +(defun all (pred list) + "Non-nil if PRED is true for all elements in LIST." + (declare (compiler-macro (lambda (_) `(not (drop-while ,pred ,list))))) + (not (drop-while pred list))) + +(defun any (pred list) + "Non-nil if PRED is true for at least one element in LIST. +Returns the LIST suffix starting at the first element that satisfies PRED, +or nil if none does." + (declare (compiler-macro + (lambda (_) + `(drop-while (lambda (x) (not (funcall ,pred x))) ,list)))) + (drop-while (lambda (x) (not (funcall pred x))) list)) ;;;; Keymap support. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index ae5932d96b3..fc980eae596 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1545,5 +1545,34 @@ final or penultimate step during initialization.")) (should (equal (funcall (subr--identity #'take-while) #'plusp ls) '(3 2 1))))) +(ert-deftest subr-all () + (should (equal (all #'hash-table-p nil) t)) + (let ((ls (append '(3 2 1) '(0) '(-1 -2 -3)))) + (should (equal (all #'numberp ls) t)) + (should (equal (all (lambda (x) (numberp x)) ls) t)) + (should (equal (all #'plusp ls) nil)) + (should (equal (all #'bufferp ls) nil)) + (let ((z 9)) + (should (equal (all (lambda (x) (< x z)) ls) t)) + (should (equal (all (lambda (x) (> x (- z 9))) ls) nil)) + (should (equal (all (lambda (x) (> x z)) ls) nil))) + (should (equal (funcall (subr--identity #'all) #'plusp ls) nil)) + (should (equal (funcall (subr--identity #'all) #'numberp ls) t)))) + +(ert-deftest subr-any () + (should (equal (any #'hash-table-p nil) nil)) + (let ((ls (append '(3 2 1) '(0) '(-1 -2 -3)))) + (should (equal (any #'numberp ls) ls)) + (should (equal (any (lambda (x) (numberp x)) ls) ls)) + (should (equal (any #'plusp ls) ls)) + (should (equal (any #'zerop ls) '(0 -1 -2 -3))) + (should (equal (any #'bufferp ls) nil)) + (let ((z 9)) + (should (equal (any (lambda (x) (< x z)) ls) ls)) + (should (equal (any (lambda (x) (< x (- z 9))) ls) '(-1 -2 -3))) + (should (equal (any (lambda (x) (> x z)) ls) nil))) + (should (equal (funcall (subr--identity #'any) #'minusp ls) '(-1 -2 -3))) + (should (equal (funcall (subr--identity #'any) #'stringp ls) nil)))) + (provide 'subr-tests) ;;; subr-tests.el ends here commit cfe3c1c840d279d584350d2426b572e211df7c93 Author: Mattias Engdegård Date: Fri Oct 10 15:33:55 2025 +0200 Add drop-while and take-while (bug#79611) * lisp/subr.el (internal--effect-free-fun-arg-p) (drop-while, take-while): New. * test/lisp/subr-tests.el (subr-drop-while, subr-take-while): New tests. * doc/lispref/lists.texi (List Elements): Document. * etc/NEWS: Announce. diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 81edcc63d5b..da6d167c740 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -387,6 +387,34 @@ not just rely on the truncation effect unless @var{n} is known to be positive. @end defun +@defun drop-while pred list +This function skips leading list elements for which the predicate @var{pred} +returns non-@code{nil}, and returns the rest. + +@example +@group +(drop-while #'numberp '(1 2 a b 3 4)) + @result{} (a b 3 4) +@end group +@end example +@end defun + +@defun take-while pred list +This function returns the leading list elements for which the predicate +@var{pred} returns non-@code{nil}, and ignores the rest. + +In general, +@code{(append (take-while @var{p} @var{list}) (drop-while @var{p} @var{list}))} +will return a list equal to @var{list}. + +@example +@group +(take-while #'numberp '(1 2 a b 3 4)) + @result{} (1 2) +@end group +@end example +@end defun + @defun last list &optional n This function returns the last link of @var{list}. The @code{car} of this link is the list's last element. If @var{list} is null, diff --git a/etc/NEWS b/etc/NEWS index 63d8ed74f85..cf608578c34 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3138,6 +3138,10 @@ and signal an error if they are given a non-number. They return non-nil if an integer is odd or even, respectively, and signal an error if they are given a non-integer. ++++ +** New functions 'drop-while' and 'take-while'. +These work like 'drop' and 'take' but use a predicate instead of counting. + +++ ** The 'defvar-local' macro second argument is now optional. This means that you can now call it with just one argument, like diff --git a/lisp/subr.el b/lisp/subr.el index 891663f7640..403e9dac376 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1134,6 +1134,48 @@ side-effects, and the argument LIST is not modified." (if (memq elt list) (delq elt (copy-sequence list)) list)) + +(defun internal--effect-free-fun-arg-p (x) + (or (symbolp x) (closurep x) (memq (car-safe x) '(function quote)))) + +(defun take-while (pred list) + "Return the longest prefix of LIST whose elements satisfy PRED." + (declare (compiler-macro + (lambda (_form) + (let* ((tail (make-symbol "tail")) + (pred (macroexpand-all pred macroexpand-all-environment)) + (f (and (not (internal--effect-free-fun-arg-p pred)) + (make-symbol "f"))) + (r (make-symbol "r"))) + `(let (,@(and f `((,f ,pred))) + (,tail ,list) + (,r nil)) + (while (and ,tail (funcall ,(or f pred) (car ,tail))) + (push (car ,tail) ,r) + (setq ,tail (cdr ,tail))) + (nreverse ,r)))))) + (let ((r nil)) + (while (and list (funcall pred (car list))) + (push (car list) r) + (setq list (cdr list))) + (nreverse r))) + +(defun drop-while (pred list) + "Skip initial elements of LIST satisfying PRED and return the rest." + (declare (compiler-macro + (lambda (_form) + (let* ((tail (make-symbol "tail")) + (pred (macroexpand-all pred macroexpand-all-environment)) + (f (and (not (internal--effect-free-fun-arg-p pred)) + (make-symbol "f")))) + `(let (,@(and f `((,f ,pred))) + (,tail ,list)) + (while (and ,tail (funcall ,(or f pred) (car ,tail))) + (setq ,tail (cdr ,tail))) + ,tail))))) + (while (and list (funcall pred (car list))) + (setq list (cdr list))) + list) ;;;; Keymap support. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index a4059a7d290..ae5932d96b3 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1519,5 +1519,31 @@ final or penultimate step during initialization.")) (should (equal (split-string text "[ \t\n\r-]*-\\*-[ \t\n\r-]*") '("" "lexical-binding: t;" ""))))) +(defun subr--identity (x) x) + +(ert-deftest subr-drop-while () + (should (equal (drop-while #'hash-table-p nil) nil)) + (let ((ls (append '(3 2 1) '(0) '(-1 -2 -3)))) + (should (equal (drop-while #'plusp ls) '(0 -1 -2 -3))) + (should (equal (drop-while (lambda (x) (plusp x)) ls) '(0 -1 -2 -3))) + (let ((z 1)) + (should (equal (drop-while (lambda (x) (> x z)) ls) '(1 0 -1 -2 -3)))) + (should (equal (drop-while #'bufferp ls) ls)) + (should (equal (drop-while #'numberp ls) nil)) + (should (equal (funcall (subr--identity #'drop-while) #'plusp ls) + '(0 -1 -2 -3))))) + +(ert-deftest subr-take-while () + (should (equal (take-while #'hash-table-p nil) nil)) + (let ((ls (append '(3 2 1) '(0) '(-1 -2 -3)))) + (should (equal (take-while #'plusp ls) '(3 2 1))) + (should (equal (take-while (lambda (x) (plusp x)) ls) '(3 2 1))) + (let ((z 1)) + (should (equal (take-while (lambda (x) (> x z)) ls) '(3 2)))) + (should (equal (take-while #'bufferp ls) nil)) + (should (equal (take-while #'numberp ls) ls)) + (should (equal (funcall (subr--identity #'take-while) #'plusp ls) + '(3 2 1))))) + (provide 'subr-tests) ;;; subr-tests.el ends here