commit 9f26a8d31b1c7e6a596ca0933f327df5ac60463d (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Thu Aug 18 14:24:30 2022 +0800 Fix the MS-DOS build * config.bat: Generate stdckdint.in.h * msdos/sedlibmk.inp (STDCKDINT_H) (GL_GENERATE_STDCKDINT_H_CONDITION): Update these variables too. diff --git a/config.bat b/config.bat index e9a180c8ee..4adc477bc9 100644 --- a/config.bat +++ b/config.bat @@ -301,6 +301,7 @@ If Exist sys_time.in.h update sys_time.in.h sys_time.in-h If Exist sys_types.in.h update sys_types.in.h sys_types.in-h If Exist time.in.h update time.in.h time.in-h If Exist unistd.in.h update unistd.in.h unistd.in-h +If Exist stdckdint.in.h update stdckdint.in.h stdckdint.in-h If Exist gnulib.mk.in update gnulib.mk.in gnulib.mk-in Rem Only repository has the msdos/autogen directory If Exist Makefile.in sed -f ../msdos/sedlibcf.inp < Makefile.in > makefile.tmp diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index 9847e710c0..79430bbaf1 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -333,6 +333,7 @@ s/@PACKAGE@/emacs/ /^LIMITS_H *=/s/@[^@\n]*@/limits.h/ /^IEEE754_H *=/s/@[^@\n]*@/ieee754.h/ /^STDALIGN_H *=/s/@[^@\n]*@/stdalign.h/ +/^STDCKDINT_H *=/s/@[^@\n]*@/stdckdint.h/ /^STDDEF_H *=/s/@[^@\n]*@/stddef.h/ /^STDINT_H *=/s/@[^@\n]*@/stdint.h/ /^SYS_TIME_H_DEFINES_STRUCT_TIMESPEC *=/s/@[^@\n]*@/0/ @@ -424,6 +425,7 @@ s/= @GL_GENERATE_LIMITS_H_CONDITION@/= / s/= @GL_GENERATE_GMP_H_CONDITION@/= 1/ s/= @GL_GENERATE_GMP_GMP_H_CONDITION@/= / s/= @GL_GENERATE_MINI_GMP_H_CONDITION@/= 1/ +s/= @GL_GENERATE_STDCKDINT_H_CONDITION@/= 1/ s/= @GL_COND_OBJ_STDIO_READ_CONDITION@/= / s/= @GL_COND_OBJ_STDIO_WRITE_CONDITION@/= / s/\$\(MKDIR_P\) malloc// commit 7406ae4c98fdbf9ea53444defcc75ee75e7e2668 Author: Paul Eggert Date: Wed Aug 17 23:12:55 2022 -0700 Fix broken build on Solaris 10 emacs_spawn * src/callproc.c (emacs_spawn) [SETUP_SLAVE_TTY]: pty_flag no longer exists. Use pty_in && std_in >= 0, which at least compiles. diff --git a/src/callproc.c b/src/callproc.c index e8e4c48b5b..2d457b3c84 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1574,7 +1574,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, #endif /* not DONT_REOPEN_PTY */ #ifdef SETUP_SLAVE_PTY - if (pty_flag) + if (pty_in && std_in >= 0) { SETUP_SLAVE_PTY; } commit 9a3f64f4061129b2064ab5bd9d58fa2c49dccbe8 Merge: d0e126b6ed 21751f02d3 Author: Stefan Kangas Date: Thu Aug 18 06:30:28 2022 +0200 ; Merge from origin/emacs-28 The following commit was skipped: 21751f02d3 Backport tempname changes from master (bug#57129) commit 21751f02d36444676db0cf8477822d6522a1f7a6 (refs/remotes/origin/emacs-28) Author: Paul Eggert Date: Wed Aug 17 20:30:26 2022 -0700 Backport tempname changes from master (bug#57129) * lib/tempname.c: Backport from master, which uses current Gnulib. diff --git a/lib/tempname.c b/lib/tempname.c index 5fc5efe031..5adfe629a8 100644 --- a/lib/tempname.c +++ b/lib/tempname.c @@ -77,6 +77,12 @@ typedef uint_fast64_t random_value; #define BASE_62_DIGITS 10 /* 62**10 < UINT_FAST64_MAX */ #define BASE_62_POWER (62LL * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62) +#if _LIBC || (defined CLOCK_MONOTONIC && HAVE_CLOCK_GETTIME) +# define HAS_CLOCK_ENTROPY true +#else +# define HAS_CLOCK_ENTROPY false +#endif + static random_value random_bits (random_value var, bool use_getrandom) { @@ -84,7 +90,7 @@ random_bits (random_value var, bool use_getrandom) /* Without GRND_NONBLOCK it can be blocked for minutes on some systems. */ if (use_getrandom && __getrandom (&r, sizeof r, GRND_NONBLOCK) == sizeof r) return r; -#if _LIBC || (defined CLOCK_MONOTONIC && HAVE_CLOCK_GETTIME) +#if HAS_CLOCK_ENTROPY /* Add entropy if getrandom did not work. */ struct __timespec64 tv; __clock_gettime64 (CLOCK_MONOTONIC, &tv); @@ -213,7 +219,7 @@ static const char letters[] = and return a read-write fd. The file is mode 0600. __GT_DIR: create a directory, which will be mode 0700. - We use a clever algorithm to get hard-to-predict names. */ + */ #ifdef _LIBC static #endif @@ -267,13 +273,20 @@ try_tempname_len (char *tmpl, int suffixlen, void *args, alignment. */ random_value v = ((uintptr_t) &v) / alignof (max_align_t); +#if !HAS_CLOCK_ENTROPY + /* Arrange gen_tempname to return less predictable file names on + systems lacking clock entropy . */ + static random_value prev_v; + v ^= prev_v; +#endif + /* How many random base-62 digits can currently be extracted from V. */ int vdigits = 0; /* Whether to consume entropy when acquiring random bits. On the first try it's worth the entropy cost with __GT_NOCREATE, which is inherently insecure and can use the entropy to make it a bit - less secure. On the (rare) second and later attempts it might + more secure. On the (rare) second and later attempts it might help against DoS attacks. */ bool use_getrandom = tryfunc == try_nocreate; @@ -318,6 +331,9 @@ try_tempname_len (char *tmpl, int suffixlen, void *args, if (fd >= 0) { __set_errno (save_errno); +#if !HAS_CLOCK_ENTROPY + prev_v = v; +#endif return fd; } else if (errno != EEXIST) commit d0e126b6ed37b36e6886e2a7eef9ec1916311750 Author: Po Lu Date: Thu Aug 18 10:32:49 2022 +0800 ; * src/xterm.c (xi_select_hierarchy_events): Fix typo. diff --git a/src/xterm.c b/src/xterm.c index e50c1d4bbb..a329ca59d0 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -27654,7 +27654,7 @@ xi_select_hierarchy_events (struct x_display_info *dpyinfo) memset (m, 0, l); mask.mask_len = l; - mask.deviceid = XIAllDevice; + mask.deviceid = XIAllDevices; XISetMask (m, XI_PropertyEvent); XISetMask (m, XI_HierarchyChanged); commit 79050eeeaf1ebf36cd2bf8be039f99d1e7e82ca8 Author: Po Lu Date: Thu Aug 18 10:31:02 2022 +0800 ; * src/xterm.c (xi_select_hierarchy_events): Fix typo. diff --git a/src/xterm.c b/src/xterm.c index a40440e0da..e50c1d4bbb 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -27654,6 +27654,8 @@ xi_select_hierarchy_events (struct x_display_info *dpyinfo) memset (m, 0, l); mask.mask_len = l; + mask.deviceid = XIAllDevice; + XISetMask (m, XI_PropertyEvent); XISetMask (m, XI_HierarchyChanged); XISetMask (m, XI_DeviceChanged); commit b6b191108000104519f9f6cee70b0ef9bba9dbc6 Author: Paul Eggert Date: Wed Aug 17 18:50:06 2022 -0700 Update from Gnulib by running admin/merge-gnulib diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 67602b9053..8872e5e055 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -1002,7 +1002,7 @@ \global\everypar = {}% } -% leave vertical mode without canceling any first paragraph indent +% leave vertical mode without cancelling any first paragraph indent \gdef\imageindent{% \toks0=\everypar \everypar={}% diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 2ffe89d423..5bb78740d6 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -318,6 +318,7 @@ GL_GENERATE_IEEE754_H_CONDITION = @GL_GENERATE_IEEE754_H_CONDITION@ GL_GENERATE_LIMITS_H_CONDITION = @GL_GENERATE_LIMITS_H_CONDITION@ GL_GENERATE_MINI_GMP_H_CONDITION = @GL_GENERATE_MINI_GMP_H_CONDITION@ GL_GENERATE_STDALIGN_H_CONDITION = @GL_GENERATE_STDALIGN_H_CONDITION@ +GL_GENERATE_STDCKDINT_H_CONDITION = @GL_GENERATE_STDCKDINT_H_CONDITION@ GL_GENERATE_STDDEF_H_CONDITION = @GL_GENERATE_STDDEF_H_CONDITION@ GL_GENERATE_STDINT_H_CONDITION = @GL_GENERATE_STDINT_H_CONDITION@ GL_GNULIB_ACCESS = @GL_GNULIB_ACCESS@ @@ -1198,10 +1199,12 @@ SETTINGS_CFLAGS = @SETTINGS_CFLAGS@ SETTINGS_LIBS = @SETTINGS_LIBS@ SHELL = @SHELL@ SIG_ATOMIC_T_SUFFIX = @SIG_ATOMIC_T_SUFFIX@ +SIZEOF_LONG = @SIZEOF_LONG@ SIZE_T_SUFFIX = @SIZE_T_SUFFIX@ SMALL_JA_DIC = @SMALL_JA_DIC@ SQLITE3_LIBS = @SQLITE3_LIBS@ STDALIGN_H = @STDALIGN_H@ +STDCKDINT_H = @STDCKDINT_H@ STDDEF_H = @STDDEF_H@ STDINT_H = @STDINT_H@ SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@ @@ -1318,6 +1321,7 @@ 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@ gl_GNULIB_ENABLED_scratch_buffer_CONDITION = @gl_GNULIB_ENABLED_scratch_buffer_CONDITION@ +gl_GNULIB_ENABLED_stdckdint_CONDITION = @gl_GNULIB_ENABLED_stdckdint_CONDITION@ gl_GNULIB_ENABLED_strtoll_CONDITION = @gl_GNULIB_ENABLED_strtoll_CONDITION@ gl_GNULIB_ENABLED_utimens_CONDITION = @gl_GNULIB_ENABLED_utimens_CONDITION@ gl_LIBOBJDEPS = @gl_LIBOBJDEPS@ @@ -2267,7 +2271,7 @@ endif ifeq (,$(OMIT_GNULIB_MODULE_intprops)) -EXTRA_DIST += intprops.h +EXTRA_DIST += intprops-internal.h intprops.h endif ## end gnulib module intprops @@ -2872,6 +2876,31 @@ EXTRA_DIST += stdalign.in.h endif ## end gnulib module stdalign +## begin gnulib module stdckdint +ifeq (,$(OMIT_GNULIB_MODULE_stdckdint)) + +ifneq (,$(gl_GNULIB_ENABLED_stdckdint_CONDITION)) +BUILT_SOURCES += $(STDCKDINT_H) + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +ifneq (,$(GL_GENERATE_STDCKDINT_H_CONDITION)) +stdckdint.h: stdckdint.in.h $(top_builddir)/config.status + $(gl_V_at)$(SED_HEADER_STDOUT) \ + $(srcdir)/stdckdint.in.h > $@-t + $(AM_V_at)mv $@-t $@ +else +stdckdint.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += stdckdint.h stdckdint.h-t + +endif +EXTRA_DIST += intprops-internal.h stdckdint.in.h + +endif +## end gnulib module stdckdint + ## begin gnulib module stddef ifeq (,$(OMIT_GNULIB_MODULE_stddef)) diff --git a/lib/group-member.c b/lib/group-member.c index 480a12616a..cd43f36f4e 100644 --- a/lib/group-member.c +++ b/lib/group-member.c @@ -21,12 +21,11 @@ /* Specification. */ #include +#include #include #include #include -#include "intprops.h" - /* Most processes have no more than this many groups, and for these processes we can avoid using malloc. */ enum { GROUPBUF_SIZE = 100 }; @@ -54,7 +53,7 @@ get_group_info (struct group_info *gi) { int n_group_slots = getgroups (0, NULL); size_t nbytes; - if (! INT_MULTIPLY_WRAPV (n_group_slots, sizeof *gi->group, &nbytes)) + if (! ckd_mul (&nbytes, n_group_slots, sizeof *gi->group)) { gi->group = malloc (nbytes); if (gi->group) diff --git a/lib/intprops-internal.h b/lib/intprops-internal.h new file mode 100644 index 0000000000..f6455f7855 --- /dev/null +++ b/lib/intprops-internal.h @@ -0,0 +1,392 @@ +/* intprops-internal.h -- properties of integer types not visible to users + + Copyright (C) 2001-2022 Free Software Foundation, Inc. + + This program 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 program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU 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 _GL_INTPROPS_INTERNAL_H +#define _GL_INTPROPS_INTERNAL_H + +#include + +/* Return a value with the common real type of E and V and the value of V. + 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. */ + +/* True if the real type T is signed. */ +#define _GL_TYPE_SIGNED(t) (! ((t) 0 < (t) -1)) + +/* 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) + + +/* Minimum and maximum values for integer types and expressions. */ + +/* The width in bits of the integer type or expression T. + Do not evaluate T. T must not be a bit-field expression. + Padding bits are not supported; this is checked at compile-time below. */ +#define _GL_TYPE_WIDTH(t) (sizeof (t) * CHAR_BIT) + +/* The maximum and minimum values for the type of the expression E, + after integer promotion. E is not evaluated. */ +#define _GL_INT_MINIMUM(e) \ + (_GL_EXPR_SIGNED (e) \ + ? ~ _GL_SIGNED_INT_MAXIMUM (e) \ + : _GL_INT_CONVERT (e, 0)) +#define _GL_INT_MAXIMUM(e) \ + (_GL_EXPR_SIGNED (e) \ + ? _GL_SIGNED_INT_MAXIMUM (e) \ + : _GL_INT_NEGATE_CONVERT (e, 1)) +#define _GL_SIGNED_INT_MAXIMUM(e) \ + (((_GL_INT_CONVERT (e, 1) << (_GL_TYPE_WIDTH (+ (e)) - 2)) - 1) * 2 + 1) + +/* Work around OpenVMS incompatibility with C99. */ +#if !defined LLONG_MAX && defined __INT64_MAX +# define LLONG_MAX __INT64_MAX +# define LLONG_MIN __INT64_MIN +#endif + +/* This include file assumes that signed types are two's complement without + padding bits; the above macros have undefined behavior otherwise. + If this is a problem for you, please let us know how to fix it for your host. + This assumption is tested by the intprops-tests module. */ + +/* Does the __typeof__ keyword work? This could be done by + 'configure', but for now it's easier to do it by hand. */ +#if (2 <= __GNUC__ \ + || (4 <= __clang_major__) \ + || (1210 <= __IBMC__ && defined __IBM__TYPEOF__) \ + || (0x5110 <= __SUNPRO_C && !__STDC__)) +# define _GL_HAVE___TYPEOF__ 1 +#else +# define _GL_HAVE___TYPEOF__ 0 +#endif + +/* Return 1 if the integer type or expression T might be signed. Return 0 + if it is definitely unsigned. T must not be a bit-field expression. + This macro does not evaluate its argument, and expands to an + integer constant expression. */ +#if _GL_HAVE___TYPEOF__ +# define _GL_SIGNED_TYPE_OR_EXPR(t) _GL_TYPE_SIGNED (__typeof__ (t)) +#else +# define _GL_SIGNED_TYPE_OR_EXPR(t) 1 +#endif + +/* Return 1 if - A would overflow in [MIN,MAX] arithmetic. + A should not have side effects, and A's type should be an + integer with minimum value MIN and maximum MAX. */ +#define _GL_INT_NEGATE_RANGE_OVERFLOW(a, min, max) \ + ((min) < 0 ? (a) < - (max) : 0 < (a)) + +/* True if __builtin_add_overflow (A, B, P) and __builtin_sub_overflow + (A, B, P) work when P is non-null. */ +#ifdef __EDG__ +/* EDG-based compilers like nvc 22.1 cannot add 64-bit signed to unsigned + . */ +# define _GL_HAS_BUILTIN_ADD_OVERFLOW 0 +#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 . */ +#elif 7 <= __GNUC__ +# define _GL_HAS_BUILTIN_ADD_OVERFLOW 1 +#else +# define _GL_HAS_BUILTIN_ADD_OVERFLOW 0 +#endif + +/* True if __builtin_mul_overflow (A, B, P) works when P is non-null. */ +#if defined __clang_major__ && __clang_major__ < 14 +/* Work around Clang bug . */ +# define _GL_HAS_BUILTIN_MUL_OVERFLOW 0 +#else +# define _GL_HAS_BUILTIN_MUL_OVERFLOW _GL_HAS_BUILTIN_ADD_OVERFLOW +#endif + +/* True if __builtin_add_overflow_p (A, B, C) works, and similarly for + __builtin_sub_overflow_p and __builtin_mul_overflow_p. */ +#ifdef __EDG__ +/* In EDG-based compilers like ICC 2021.3 and earlier, + __builtin_add_overflow_p etc. are not treated as integral constant + expressions even when all arguments are. */ +# define _GL_HAS_BUILTIN_OVERFLOW_P 0 +#elif defined __has_builtin +# define _GL_HAS_BUILTIN_OVERFLOW_P __has_builtin (__builtin_mul_overflow_p) +#else +# define _GL_HAS_BUILTIN_OVERFLOW_P (7 <= __GNUC__) +#endif + +#if (!defined _GL_STDCKDINT_H && 202311 <= __STDC_VERSION__ \ + && ! (_GL_HAS_BUILTIN_ADD_OVERFLOW && _GL_HAS_BUILTIN_MUL_OVERFLOW)) +# include +#endif + +/* Store the low-order bits of A + B, A - B, A * B, respectively, into *R. + Return 1 if the result overflows. Arguments should not have side + effects and A, B and *R can be of any integer type other than char, + bool, a bit-precise integer type, or an enumeration type. */ +#if _GL_HAS_BUILTIN_ADD_OVERFLOW +# define _GL_INT_ADD_WRAPV(a, b, r) __builtin_add_overflow (a, b, r) +# define _GL_INT_SUBTRACT_WRAPV(a, b, r) __builtin_sub_overflow (a, b, r) +#elif defined ckd_add && defined ckd_sub && !defined _GL_STDCKDINT_H +# define _GL_INT_ADD_WRAPV(a, b, r) ckd_add (r, + (a), + (b)) +# define _GL_INT_SUBTRACT_WRAPV(a, b, r) ckd_sub (r, + (a), + (b)) +#else +# define _GL_INT_ADD_WRAPV(a, b, r) \ + _GL_INT_OP_WRAPV (a, b, r, +, _GL_INT_ADD_RANGE_OVERFLOW) +# define _GL_INT_SUBTRACT_WRAPV(a, b, r) \ + _GL_INT_OP_WRAPV (a, b, r, -, _GL_INT_SUBTRACT_RANGE_OVERFLOW) +#endif +#if _GL_HAS_BUILTIN_MUL_OVERFLOW +# if ((9 < __GNUC__ + (3 <= __GNUC_MINOR__) \ + || (__GNUC__ == 8 && 4 <= __GNUC_MINOR__)) \ + && !defined __EDG__) +# define _GL_INT_MULTIPLY_WRAPV(a, b, r) __builtin_mul_overflow (a, b, r) +# else + /* Work around GCC bug 91450. */ +# define _GL_INT_MULTIPLY_WRAPV(a, b, r) \ + ((!_GL_SIGNED_TYPE_OR_EXPR (*(r)) && _GL_EXPR_SIGNED (a) && _GL_EXPR_SIGNED (b) \ + && _GL_INT_MULTIPLY_RANGE_OVERFLOW (a, b, 0, (__typeof__ (*(r))) -1)) \ + ? ((void) __builtin_mul_overflow (a, b, r), 1) \ + : __builtin_mul_overflow (a, b, r)) +# endif +#elif defined ckd_mul && !defined _GL_STDCKDINT_H +# define _GL_INT_MULTIPLY_WRAPV(a, b, r) ckd_mul (r, + (a), + (b)) +#else +# define _GL_INT_MULTIPLY_WRAPV(a, b, r) \ + _GL_INT_OP_WRAPV (a, b, r, *, _GL_INT_MULTIPLY_RANGE_OVERFLOW) +#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://llvm.org/bugs/show_bug.cgi?id=25390 + For now, assume all versions of GCC-like compilers generate bogus + warnings for _Generic. This matters only for compilers that + lack relevant builtins. */ +#if __GNUC__ || defined __clang__ +# define _GL__GENERIC_BOGUS 1 +#else +# define _GL__GENERIC_BOGUS 0 +#endif + +/* Store the low-order bits of A B into *R, where OP specifies + the operation and OVERFLOW the overflow predicate. Return 1 if the + result overflows. Arguments should not have side effects, + and A, B and *R can be of any integer type other than char, bool, a + bit-precise integer type, or an enumeration type. */ +#if 201112 <= __STDC_VERSION__ && !_GL__GENERIC_BOGUS +# define _GL_INT_OP_WRAPV(a, b, r, op, overflow) \ + (_Generic \ + (*(r), \ + signed char: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + signed char, SCHAR_MIN, SCHAR_MAX), \ + unsigned char: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + unsigned char, 0, UCHAR_MAX), \ + short int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + short int, SHRT_MIN, SHRT_MAX), \ + unsigned short int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + unsigned short int, 0, USHRT_MAX), \ + int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + int, INT_MIN, INT_MAX), \ + unsigned int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + unsigned int, 0, UINT_MAX), \ + long int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ + long int, LONG_MIN, LONG_MAX), \ + unsigned long int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ + unsigned long int, 0, ULONG_MAX), \ + long long int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ + long long int, LLONG_MIN, LLONG_MAX), \ + unsigned long long int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ + unsigned long long int, 0, ULLONG_MAX))) +#else +/* Store the low-order bits of A B into *R, where OP specifies + the operation and OVERFLOW the overflow predicate. If *R is + signed, its type is ST with bounds SMIN..SMAX; otherwise its type + is UT with bounds U..UMAX. ST and UT are narrower than int. + Return 1 if the result overflows. Arguments should not have side + effects, and A, B and *R can be of any integer type other than + char, bool, a bit-precise integer type, or an enumeration type. */ +# if _GL_HAVE___TYPEOF__ +# define _GL_INT_OP_WRAPV_SMALLISH(a,b,r,op,overflow,st,smin,smax,ut,umax) \ + (_GL_TYPE_SIGNED (__typeof__ (*(r))) \ + ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, st, smin, smax) \ + : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, ut, 0, umax)) +# else +# define _GL_INT_OP_WRAPV_SMALLISH(a,b,r,op,overflow,st,smin,smax,ut,umax) \ + (overflow (a, b, smin, smax) \ + ? (overflow (a, b, 0, umax) \ + ? (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st), 1) \ + : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st)) < 0) \ + : (overflow (a, b, 0, umax) \ + ? (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st)) >= 0 \ + : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st), 0))) +# endif + +# define _GL_INT_OP_WRAPV(a, b, r, op, overflow) \ + (sizeof *(r) == sizeof (signed char) \ + ? _GL_INT_OP_WRAPV_SMALLISH (a, b, r, op, overflow, \ + signed char, SCHAR_MIN, SCHAR_MAX, \ + unsigned char, UCHAR_MAX) \ + : sizeof *(r) == sizeof (short int) \ + ? _GL_INT_OP_WRAPV_SMALLISH (a, b, r, op, overflow, \ + short int, SHRT_MIN, SHRT_MAX, \ + unsigned short int, USHRT_MAX) \ + : sizeof *(r) == sizeof (int) \ + ? (_GL_EXPR_SIGNED (*(r)) \ + ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + int, INT_MIN, INT_MAX) \ + : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + unsigned int, 0, UINT_MAX)) \ + : _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow)) +# ifdef LLONG_MAX +# define _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow) \ + (sizeof *(r) == sizeof (long int) \ + ? (_GL_EXPR_SIGNED (*(r)) \ + ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ + long int, LONG_MIN, LONG_MAX) \ + : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ + unsigned long int, 0, ULONG_MAX)) \ + : (_GL_EXPR_SIGNED (*(r)) \ + ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ + long long int, LLONG_MIN, LLONG_MAX) \ + : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ + unsigned long long int, 0, ULLONG_MAX))) +# else +# define _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow) \ + (_GL_EXPR_SIGNED (*(r)) \ + ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ + long int, LONG_MIN, LONG_MAX) \ + : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ + unsigned long int, 0, ULONG_MAX)) +# endif +#endif + +/* Store the low-order bits of A B into *R, where the operation + is given by OP. Use the unsigned type UT for calculation to avoid + overflow problems. *R's type is T, with extrema TMIN and TMAX. + T can be any signed integer type other than char, bool, a + bit-precise integer type, or an enumeration type. + Return 1 if the result overflows. */ +#define _GL_INT_OP_CALC(a, b, r, op, overflow, ut, t, tmin, tmax) \ + (overflow (a, b, tmin, tmax) \ + ? (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, ut, t), 1) \ + : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, ut, t), 0)) + +/* Return 1 if the integer expressions A - B and -A would overflow, + respectively. Arguments should not have side effects, + and can be any signed integer type other than char, bool, a + bit-precise integer type, or an enumeration type. + These macros are tuned for their last input argument being a constant. */ + +#if _GL_HAS_BUILTIN_OVERFLOW_P +# define _GL_INT_NEGATE_OVERFLOW(a) \ + __builtin_sub_overflow_p (0, a, (__typeof__ (- (a))) 0) +#else +# define _GL_INT_NEGATE_OVERFLOW(a) \ + _GL_INT_NEGATE_RANGE_OVERFLOW (a, _GL_INT_MINIMUM (a), _GL_INT_MAXIMUM (a)) +#endif + +/* Return the low-order bits of A B, where the operation is given + by OP. Use the unsigned type UT for calculation to avoid undefined + behavior on signed integer overflow, and convert the result to type T. + UT is at least as wide as T and is no narrower than unsigned int, + T is two's complement, and there is no padding or trap representations. + Assume that converting UT to T yields the low-order bits, as is + done in all known two's-complement C compilers. E.g., see: + https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html + + According to the C standard, converting UT to T yields an + implementation-defined result or signal for values outside T's + range. However, code that works around this theoretical problem + runs afoul of a compiler bug in Oracle Studio 12.3 x86. See: + https://lists.gnu.org/r/bug-gnulib/2017-04/msg00049.html + As the compiler bug is real, don't try to work around the + theoretical problem. */ + +#define _GL_INT_OP_WRAPV_VIA_UNSIGNED(a, b, op, ut, t) \ + ((t) ((ut) (a) op (ut) (b))) + +/* Return true if the numeric values A + B, A - B, A * B fall outside + the range TMIN..TMAX. Arguments should not have side effects + and can be any integer type other than char, bool, + a bit-precise integer type, or an enumeration type. + TMIN should be signed and nonpositive. + TMAX should be positive, and should be signed unless TMIN is zero. */ +#define _GL_INT_ADD_RANGE_OVERFLOW(a, b, tmin, tmax) \ + ((b) < 0 \ + ? (((tmin) \ + ? ((_GL_EXPR_SIGNED (_GL_INT_CONVERT (a, (tmin) - (b))) || (b) < (tmin)) \ + && (a) < (tmin) - (b)) \ + : (a) <= -1 - (b)) \ + || ((_GL_EXPR_SIGNED (a) ? 0 <= (a) : (tmax) < (a)) && (tmax) < (a) + (b))) \ + : (a) < 0 \ + ? (((tmin) \ + ? ((_GL_EXPR_SIGNED (_GL_INT_CONVERT (b, (tmin) - (a))) || (a) < (tmin)) \ + && (b) < (tmin) - (a)) \ + : (b) <= -1 - (a)) \ + || ((_GL_EXPR_SIGNED (_GL_INT_CONVERT (a, b)) || (tmax) < (b)) \ + && (tmax) < (a) + (b))) \ + : (tmax) < (b) || (tmax) - (b) < (a)) +#define _GL_INT_SUBTRACT_RANGE_OVERFLOW(a, b, tmin, tmax) \ + (((a) < 0) == ((b) < 0) \ + ? ((a) < (b) \ + ? !(tmin) || -1 - (tmin) < (b) - (a) - 1 \ + : (tmax) < (a) - (b)) \ + : (a) < 0 \ + ? ((!_GL_EXPR_SIGNED (_GL_INT_CONVERT ((a) - (tmin), b)) && (a) - (tmin) < 0) \ + || (a) - (tmin) < (b)) \ + : ((! (_GL_EXPR_SIGNED (_GL_INT_CONVERT (tmax, b)) \ + && _GL_EXPR_SIGNED (_GL_INT_CONVERT ((tmax) + (b), a))) \ + && (tmax) <= -1 - (b)) \ + || (tmax) + (b) < (a))) +#define _GL_INT_MULTIPLY_RANGE_OVERFLOW(a, b, tmin, tmax) \ + ((b) < 0 \ + ? ((a) < 0 \ + ? (_GL_EXPR_SIGNED (_GL_INT_CONVERT (tmax, b)) \ + ? (a) < (tmax) / (b) \ + : ((_GL_INT_NEGATE_OVERFLOW (b) \ + ? _GL_INT_CONVERT (b, tmax) >> (_GL_TYPE_WIDTH (+ (b)) - 1) \ + : (tmax) / -(b)) \ + <= -1 - (a))) \ + : _GL_INT_NEGATE_OVERFLOW (_GL_INT_CONVERT (b, tmin)) && (b) == -1 \ + ? (_GL_EXPR_SIGNED (a) \ + ? 0 < (a) + (tmin) \ + : 0 < (a) && -1 - (tmin) < (a) - 1) \ + : (tmin) / (b) < (a)) \ + : (b) == 0 \ + ? 0 \ + : ((a) < 0 \ + ? (_GL_INT_NEGATE_OVERFLOW (_GL_INT_CONVERT (a, tmin)) && (a) == -1 \ + ? (_GL_EXPR_SIGNED (b) ? 0 < (b) + (tmin) : -1 - (tmin) < (b) - 1) \ + : (tmin) / (a) < (b)) \ + : (tmax) / (b) < (a))) + +#endif /* _GL_INTPROPS_INTERNAL_H */ diff --git a/lib/intprops.h b/lib/intprops.h index d4a917f72a..f182ddc1fe 100644 --- a/lib/intprops.h +++ b/lib/intprops.h @@ -15,19 +15,10 @@ You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . */ - #ifndef _GL_INTPROPS_H #define _GL_INTPROPS_H -#include - -/* Return a value with the common real type of E and V and the value of V. - 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)) +#include "intprops-internal.h" /* The extra casts in the following macros work around compiler bugs, e.g., in Cray C 5.0.3.0. */ @@ -37,11 +28,11 @@ #define TYPE_IS_INTEGER(t) ((t) 1.5 == 1) /* True if the real type T is signed. */ -#define TYPE_SIGNED(t) (! ((t) 0 < (t) -1)) +#define TYPE_SIGNED(t) _GL_TYPE_SIGNED (t) /* Return 1 if the real expression E, after promotion, has a signed or floating type. Do not evaluate E. */ -#define EXPR_SIGNED(e) (_GL_INT_NEGATE_CONVERT (e, 1) < 0) +#define EXPR_SIGNED(e) _GL_EXPR_SIGNED (e) /* Minimum and maximum values for integer types and expressions. */ @@ -49,7 +40,7 @@ /* The width in bits of the integer type or expression T. Do not evaluate T. T must not be a bit-field expression. Padding bits are not supported; this is checked at compile-time below. */ -#define TYPE_WIDTH(t) (sizeof (t) * CHAR_BIT) +#define TYPE_WIDTH(t) _GL_TYPE_WIDTH (t) /* The maximum and minimum values for the integer type T. */ #define TYPE_MINIMUM(t) ((t) ~ TYPE_MAXIMUM (t)) @@ -58,51 +49,6 @@ ? (t) -1 \ : ((((t) 1 << (TYPE_WIDTH (t) - 2)) - 1) * 2 + 1))) -/* The maximum and minimum values for the type of the expression E, - after integer promotion. E is not evaluated. */ -#define _GL_INT_MINIMUM(e) \ - (EXPR_SIGNED (e) \ - ? ~ _GL_SIGNED_INT_MAXIMUM (e) \ - : _GL_INT_CONVERT (e, 0)) -#define _GL_INT_MAXIMUM(e) \ - (EXPR_SIGNED (e) \ - ? _GL_SIGNED_INT_MAXIMUM (e) \ - : _GL_INT_NEGATE_CONVERT (e, 1)) -#define _GL_SIGNED_INT_MAXIMUM(e) \ - (((_GL_INT_CONVERT (e, 1) << (TYPE_WIDTH (+ (e)) - 2)) - 1) * 2 + 1) - -/* Work around OpenVMS incompatibility with C99. */ -#if !defined LLONG_MAX && defined __INT64_MAX -# define LLONG_MAX __INT64_MAX -# define LLONG_MIN __INT64_MIN -#endif - -/* This include file assumes that signed types are two's complement without - padding bits; the above macros have undefined behavior otherwise. - If this is a problem for you, please let us know how to fix it for your host. - This assumption is tested by the intprops-tests module. */ - -/* Does the __typeof__ keyword work? This could be done by - 'configure', but for now it's easier to do it by hand. */ -#if (2 <= __GNUC__ \ - || (4 <= __clang_major__) \ - || (1210 <= __IBMC__ && defined __IBM__TYPEOF__) \ - || (0x5110 <= __SUNPRO_C && !__STDC__)) -# define _GL_HAVE___TYPEOF__ 1 -#else -# define _GL_HAVE___TYPEOF__ 0 -#endif - -/* Return 1 if the integer type or expression T might be signed. Return 0 - if it is definitely unsigned. T must not be a bit-field expression. - This macro does not evaluate its argument, and expands to an - integer constant expression. */ -#if _GL_HAVE___TYPEOF__ -# define _GL_SIGNED_TYPE_OR_EXPR(t) TYPE_SIGNED (__typeof__ (t)) -#else -# define _GL_SIGNED_TYPE_OR_EXPR(t) 1 -#endif - /* Bound on length of the string representing an unsigned integer value representable in B bits. log10 (2.0) < 146/485. The smallest value of B where this bound is not tight is 2621. */ @@ -129,12 +75,11 @@ /* Range overflow checks. The INT__RANGE_OVERFLOW macros return 1 if the corresponding C - operators might not yield numerically correct answers due to - arithmetic overflow. They do not rely on undefined or - implementation-defined behavior. Their implementations are simple - and straightforward, but they are harder to use and may be less - efficient than the INT__WRAPV, INT__OK, and - INT__OVERFLOW macros described below. + operators overflow arithmetically when given the same arguments. + These macros do not rely on undefined or implementation-defined behavior. + Although their implementations are simple and straightforward, + they are harder to use and may be less efficient than the + INT__WRAPV, INT__OK, and INT__OVERFLOW macros described below. Example usage: @@ -181,9 +126,7 @@ /* Return 1 if - A would overflow in [MIN,MAX] arithmetic. See above for restrictions. */ #define INT_NEGATE_RANGE_OVERFLOW(a, min, max) \ - ((min) < 0 \ - ? (a) < - (max) \ - : 0 < (a)) + _GL_INT_NEGATE_RANGE_OVERFLOW (a, min, max) /* Return 1 if A * B would overflow in [MIN,MAX] arithmetic. See above for restrictions. Avoid && and || as they tickle @@ -227,43 +170,6 @@ ? (a) < (min) >> (b) \ : (max) >> (b) < (a)) -/* True if __builtin_add_overflow (A, B, P) and __builtin_sub_overflow - (A, B, P) work when P is non-null. */ -#ifdef __EDG__ -/* EDG-based compilers like nvc 22.1 cannot add 64-bit signed to unsigned - . */ -# define _GL_HAS_BUILTIN_ADD_OVERFLOW 0 -#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 . */ -#elif 7 <= __GNUC__ -# define _GL_HAS_BUILTIN_ADD_OVERFLOW 1 -#else -# define _GL_HAS_BUILTIN_ADD_OVERFLOW 0 -#endif - -/* True if __builtin_mul_overflow (A, B, P) works when P is non-null. */ -#if defined __clang_major__ && __clang_major__ < 14 -/* Work around Clang bug . */ -# define _GL_HAS_BUILTIN_MUL_OVERFLOW 0 -#else -# define _GL_HAS_BUILTIN_MUL_OVERFLOW _GL_HAS_BUILTIN_ADD_OVERFLOW -#endif - -/* True if __builtin_add_overflow_p (A, B, C) works, and similarly for - __builtin_sub_overflow_p and __builtin_mul_overflow_p. */ -#ifdef __EDG__ -/* In EDG-based compilers like ICC 2021.3 and earlier, - __builtin_add_overflow_p etc. are not treated as integral constant - expressions even when all arguments are. */ -# define _GL_HAS_BUILTIN_OVERFLOW_P 0 -#elif defined __has_builtin -# define _GL_HAS_BUILTIN_OVERFLOW_P __has_builtin (__builtin_mul_overflow_p) -#else -# define _GL_HAS_BUILTIN_OVERFLOW_P (7 <= __GNUC__) -#endif - /* The _GL*_OVERFLOW macros have the same restrictions as the *_RANGE_OVERFLOW macros, except that they do not assume that operands (e.g., A and B) have the same type as MIN and MAX. Instead, they assume @@ -350,13 +256,18 @@ Because the WRAPV macros convert the result, they report overflow in different circumstances than the OVERFLOW macros do. For example, in the typical case with 16-bit 'short' and 32-bit 'int', - if A, B and R are all of type 'short' then INT_ADD_OVERFLOW (A, B) + if A, B and *R are all of type 'short' then INT_ADD_OVERFLOW (A, B) returns false because the addition cannot overflow after A and B - are converted to 'int', whereas INT_ADD_WRAPV (A, B, &R) returns + are converted to 'int', whereas INT_ADD_WRAPV (A, B, R) returns true or false depending on whether the sum fits into 'short'. These macros are tuned for their last input argument being a constant. + A, B, and *R should be integers; they need not be the same type, + and they need not be all signed or all unsigned. + However, none of the integer types should be bit-precise, + and *R's type should not be char, bool, or an enumeration type. + Return 1 if the integer expressions A * B, A - B, -A, A * B, A / B, A % B, and A << B would overflow, respectively. */ @@ -364,12 +275,7 @@ _GL_BINARY_OP_OVERFLOW (a, b, _GL_ADD_OVERFLOW) #define INT_SUBTRACT_OVERFLOW(a, b) \ _GL_BINARY_OP_OVERFLOW (a, b, _GL_SUBTRACT_OVERFLOW) -#if _GL_HAS_BUILTIN_OVERFLOW_P -# define INT_NEGATE_OVERFLOW(a) INT_SUBTRACT_OVERFLOW (0, a) -#else -# define INT_NEGATE_OVERFLOW(a) \ - INT_NEGATE_RANGE_OVERFLOW (a, _GL_INT_MINIMUM (a), _GL_INT_MAXIMUM (a)) -#endif +#define INT_NEGATE_OVERFLOW(a) _GL_INT_NEGATE_OVERFLOW (a) #define INT_MULTIPLY_OVERFLOW(a, b) \ _GL_BINARY_OP_OVERFLOW (a, b, _GL_MULTIPLY_OVERFLOW) #define INT_DIVIDE_OVERFLOW(a, b) \ @@ -391,224 +297,9 @@ /* Store the low-order bits of A + B, A - B, A * B, respectively, into *R. Return 1 if the result overflows. See above for restrictions. */ -#if _GL_HAS_BUILTIN_ADD_OVERFLOW -# define INT_ADD_WRAPV(a, b, r) __builtin_add_overflow (a, b, r) -# define INT_SUBTRACT_WRAPV(a, b, r) __builtin_sub_overflow (a, b, r) -#else -# define INT_ADD_WRAPV(a, b, r) \ - _GL_INT_OP_WRAPV (a, b, r, +, _GL_INT_ADD_RANGE_OVERFLOW) -# define INT_SUBTRACT_WRAPV(a, b, r) \ - _GL_INT_OP_WRAPV (a, b, r, -, _GL_INT_SUBTRACT_RANGE_OVERFLOW) -#endif -#if _GL_HAS_BUILTIN_MUL_OVERFLOW -# if ((9 < __GNUC__ + (3 <= __GNUC_MINOR__) \ - || (__GNUC__ == 8 && 4 <= __GNUC_MINOR__)) \ - && !defined __EDG__) -# define INT_MULTIPLY_WRAPV(a, b, r) __builtin_mul_overflow (a, b, r) -# else - /* Work around GCC bug 91450. */ -# define INT_MULTIPLY_WRAPV(a, b, r) \ - ((!_GL_SIGNED_TYPE_OR_EXPR (*(r)) && EXPR_SIGNED (a) && EXPR_SIGNED (b) \ - && _GL_INT_MULTIPLY_RANGE_OVERFLOW (a, b, 0, (__typeof__ (*(r))) -1)) \ - ? ((void) __builtin_mul_overflow (a, b, r), 1) \ - : __builtin_mul_overflow (a, b, r)) -# endif -#else -# define INT_MULTIPLY_WRAPV(a, b, r) \ - _GL_INT_OP_WRAPV (a, b, r, *, _GL_INT_MULTIPLY_RANGE_OVERFLOW) -#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://llvm.org/bugs/show_bug.cgi?id=25390 - For now, assume all versions of GCC-like compilers generate bogus - warnings for _Generic. This matters only for compilers that - lack relevant builtins. */ -#if __GNUC__ || defined __clang__ -# define _GL__GENERIC_BOGUS 1 -#else -# define _GL__GENERIC_BOGUS 0 -#endif - -/* Store the low-order bits of A B into *R, where OP specifies - the operation and OVERFLOW the overflow predicate. Return 1 if the - result overflows. See above for restrictions. */ -#if 201112 <= __STDC_VERSION__ && !_GL__GENERIC_BOGUS -# define _GL_INT_OP_WRAPV(a, b, r, op, overflow) \ - (_Generic \ - (*(r), \ - signed char: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - signed char, SCHAR_MIN, SCHAR_MAX), \ - unsigned char: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - unsigned char, 0, UCHAR_MAX), \ - short int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - short int, SHRT_MIN, SHRT_MAX), \ - unsigned short int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - unsigned short int, 0, USHRT_MAX), \ - int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - int, INT_MIN, INT_MAX), \ - unsigned int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - unsigned int, 0, UINT_MAX), \ - long int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ - long int, LONG_MIN, LONG_MAX), \ - unsigned long int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ - unsigned long int, 0, ULONG_MAX), \ - long long int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ - long long int, LLONG_MIN, LLONG_MAX), \ - unsigned long long int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ - unsigned long long int, 0, ULLONG_MAX))) -#else -/* Store the low-order bits of A B into *R, where OP specifies - the operation and OVERFLOW the overflow predicate. If *R is - signed, its type is ST with bounds SMIN..SMAX; otherwise its type - is UT with bounds U..UMAX. ST and UT are narrower than int. - Return 1 if the result overflows. See above for restrictions. */ -# if _GL_HAVE___TYPEOF__ -# define _GL_INT_OP_WRAPV_SMALLISH(a,b,r,op,overflow,st,smin,smax,ut,umax) \ - (TYPE_SIGNED (__typeof__ (*(r))) \ - ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, st, smin, smax) \ - : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, ut, 0, umax)) -# else -# define _GL_INT_OP_WRAPV_SMALLISH(a,b,r,op,overflow,st,smin,smax,ut,umax) \ - (overflow (a, b, smin, smax) \ - ? (overflow (a, b, 0, umax) \ - ? (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st), 1) \ - : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st)) < 0) \ - : (overflow (a, b, 0, umax) \ - ? (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st)) >= 0 \ - : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st), 0))) -# endif - -# define _GL_INT_OP_WRAPV(a, b, r, op, overflow) \ - (sizeof *(r) == sizeof (signed char) \ - ? _GL_INT_OP_WRAPV_SMALLISH (a, b, r, op, overflow, \ - signed char, SCHAR_MIN, SCHAR_MAX, \ - unsigned char, UCHAR_MAX) \ - : sizeof *(r) == sizeof (short int) \ - ? _GL_INT_OP_WRAPV_SMALLISH (a, b, r, op, overflow, \ - short int, SHRT_MIN, SHRT_MAX, \ - unsigned short int, USHRT_MAX) \ - : sizeof *(r) == sizeof (int) \ - ? (EXPR_SIGNED (*(r)) \ - ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - int, INT_MIN, INT_MAX) \ - : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - unsigned int, 0, UINT_MAX)) \ - : _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow)) -# ifdef LLONG_MAX -# define _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow) \ - (sizeof *(r) == sizeof (long int) \ - ? (EXPR_SIGNED (*(r)) \ - ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ - long int, LONG_MIN, LONG_MAX) \ - : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ - unsigned long int, 0, ULONG_MAX)) \ - : (EXPR_SIGNED (*(r)) \ - ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ - long long int, LLONG_MIN, LLONG_MAX) \ - : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ - unsigned long long int, 0, ULLONG_MAX))) -# else -# define _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow) \ - (EXPR_SIGNED (*(r)) \ - ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ - long int, LONG_MIN, LONG_MAX) \ - : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ - unsigned long int, 0, ULONG_MAX)) -# endif -#endif - -/* Store the low-order bits of A B into *R, where the operation - is given by OP. Use the unsigned type UT for calculation to avoid - overflow problems. *R's type is T, with extrema TMIN and TMAX. - T must be a signed integer type. Return 1 if the result overflows. */ -#define _GL_INT_OP_CALC(a, b, r, op, overflow, ut, t, tmin, tmax) \ - (overflow (a, b, tmin, tmax) \ - ? (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, ut, t), 1) \ - : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, ut, t), 0)) - -/* Return the low-order bits of A B, where the operation is given - by OP. Use the unsigned type UT for calculation to avoid undefined - behavior on signed integer overflow, and convert the result to type T. - UT is at least as wide as T and is no narrower than unsigned int, - T is two's complement, and there is no padding or trap representations. - Assume that converting UT to T yields the low-order bits, as is - done in all known two's-complement C compilers. E.g., see: - https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html - - According to the C standard, converting UT to T yields an - implementation-defined result or signal for values outside T's - range. However, code that works around this theoretical problem - runs afoul of a compiler bug in Oracle Studio 12.3 x86. See: - https://lists.gnu.org/r/bug-gnulib/2017-04/msg00049.html - As the compiler bug is real, don't try to work around the - theoretical problem. */ - -#define _GL_INT_OP_WRAPV_VIA_UNSIGNED(a, b, op, ut, t) \ - ((t) ((ut) (a) op (ut) (b))) - -/* Return true if the numeric values A + B, A - B, A * B fall outside - the range TMIN..TMAX. Arguments should be integer expressions - without side effects. TMIN should be signed and nonpositive. - TMAX should be positive, and should be signed unless TMIN is zero. */ -#define _GL_INT_ADD_RANGE_OVERFLOW(a, b, tmin, tmax) \ - ((b) < 0 \ - ? (((tmin) \ - ? ((EXPR_SIGNED (_GL_INT_CONVERT (a, (tmin) - (b))) || (b) < (tmin)) \ - && (a) < (tmin) - (b)) \ - : (a) <= -1 - (b)) \ - || ((EXPR_SIGNED (a) ? 0 <= (a) : (tmax) < (a)) && (tmax) < (a) + (b))) \ - : (a) < 0 \ - ? (((tmin) \ - ? ((EXPR_SIGNED (_GL_INT_CONVERT (b, (tmin) - (a))) || (a) < (tmin)) \ - && (b) < (tmin) - (a)) \ - : (b) <= -1 - (a)) \ - || ((EXPR_SIGNED (_GL_INT_CONVERT (a, b)) || (tmax) < (b)) \ - && (tmax) < (a) + (b))) \ - : (tmax) < (b) || (tmax) - (b) < (a)) -#define _GL_INT_SUBTRACT_RANGE_OVERFLOW(a, b, tmin, tmax) \ - (((a) < 0) == ((b) < 0) \ - ? ((a) < (b) \ - ? !(tmin) || -1 - (tmin) < (b) - (a) - 1 \ - : (tmax) < (a) - (b)) \ - : (a) < 0 \ - ? ((!EXPR_SIGNED (_GL_INT_CONVERT ((a) - (tmin), b)) && (a) - (tmin) < 0) \ - || (a) - (tmin) < (b)) \ - : ((! (EXPR_SIGNED (_GL_INT_CONVERT (tmax, b)) \ - && EXPR_SIGNED (_GL_INT_CONVERT ((tmax) + (b), a))) \ - && (tmax) <= -1 - (b)) \ - || (tmax) + (b) < (a))) -#define _GL_INT_MULTIPLY_RANGE_OVERFLOW(a, b, tmin, tmax) \ - ((b) < 0 \ - ? ((a) < 0 \ - ? (EXPR_SIGNED (_GL_INT_CONVERT (tmax, b)) \ - ? (a) < (tmax) / (b) \ - : ((INT_NEGATE_OVERFLOW (b) \ - ? _GL_INT_CONVERT (b, tmax) >> (TYPE_WIDTH (+ (b)) - 1) \ - : (tmax) / -(b)) \ - <= -1 - (a))) \ - : INT_NEGATE_OVERFLOW (_GL_INT_CONVERT (b, tmin)) && (b) == -1 \ - ? (EXPR_SIGNED (a) \ - ? 0 < (a) + (tmin) \ - : 0 < (a) && -1 - (tmin) < (a) - 1) \ - : (tmin) / (b) < (a)) \ - : (b) == 0 \ - ? 0 \ - : ((a) < 0 \ - ? (INT_NEGATE_OVERFLOW (_GL_INT_CONVERT (a, tmin)) && (a) == -1 \ - ? (EXPR_SIGNED (b) ? 0 < (b) + (tmin) : -1 - (tmin) < (b) - 1) \ - : (tmin) / (a) < (b)) \ - : (tmax) / (b) < (a))) +#define INT_ADD_WRAPV(a, b, r) _GL_INT_ADD_WRAPV (a, b, r) +#define INT_SUBTRACT_WRAPV(a, b, r) _GL_INT_SUBTRACT_WRAPV (a, b, r) +#define INT_MULTIPLY_WRAPV(a, b, r) _GL_INT_MULTIPLY_WRAPV (a, b, r) /* The following macros compute A + B, A - B, and A * B, respectively. If no overflow occurs, they set *R to the result and return 1; @@ -624,6 +315,8 @@ A, B, and *R should be integers; they need not be the same type, and they need not be all signed or all unsigned. + However, none of the integer types should be bit-precise, + and *R's type should not be char, bool, or an enumeration type. These macros work correctly on all known practical hosts, and do not rely on undefined behavior due to signed arithmetic overflow. @@ -635,8 +328,8 @@ These macros are tuned for B being a constant. */ -#define INT_ADD_OK(a, b, r) ! INT_ADD_WRAPV (a, b, r) -#define INT_SUBTRACT_OK(a, b, r) ! INT_SUBTRACT_WRAPV (a, b, r) -#define INT_MULTIPLY_OK(a, b, r) ! INT_MULTIPLY_WRAPV (a, b, r) +#define INT_ADD_OK(a, b, r) (! INT_ADD_WRAPV (a, b, r)) +#define INT_SUBTRACT_OK(a, b, r) (! INT_SUBTRACT_WRAPV (a, b, r)) +#define INT_MULTIPLY_OK(a, b, r) (! INT_MULTIPLY_WRAPV (a, b, r)) #endif /* _GL_INTPROPS_H */ diff --git a/lib/stdckdint.in.h b/lib/stdckdint.in.h new file mode 100644 index 0000000000..90fa62e596 --- /dev/null +++ b/lib/stdckdint.in.h @@ -0,0 +1,37 @@ +/* stdckdint.h -- checked integer arithmetic + + Copyright 2022 Free Software Foundation, Inc. + + This program 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 program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU 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 _GL_STDCKDINT_H +#define _GL_STDCKDINT_H + +#include "intprops-internal.h" + +#include + +/* Store into *R the low-order bits of A + B, A - B, A * B, respectively. + Return 1 if the result overflows, 0 otherwise. + A, B, and *R can have any integer type other than char, bool, a + bit-precise integer type, or an enumeration type. + + These are like the standard macros introduced in C23, except that + arguments should not have side effects. */ + +#define ckd_add(r, a, b) ((bool) _GL_INT_ADD_WRAPV (a, b, r)) +#define ckd_sub(r, a, b) ((bool) _GL_INT_SUBTRACT_WRAPV (a, b, r)) +#define ckd_mul(r, a, b) ((bool) _GL_INT_MULTIPLY_WRAPV (a, b, r)) + +#endif /* _GL_STDCKDINT_H */ diff --git a/lib/tempname.c b/lib/tempname.c index 5fc5efe031..5adfe629a8 100644 --- a/lib/tempname.c +++ b/lib/tempname.c @@ -77,6 +77,12 @@ typedef uint_fast64_t random_value; #define BASE_62_DIGITS 10 /* 62**10 < UINT_FAST64_MAX */ #define BASE_62_POWER (62LL * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62) +#if _LIBC || (defined CLOCK_MONOTONIC && HAVE_CLOCK_GETTIME) +# define HAS_CLOCK_ENTROPY true +#else +# define HAS_CLOCK_ENTROPY false +#endif + static random_value random_bits (random_value var, bool use_getrandom) { @@ -84,7 +90,7 @@ random_bits (random_value var, bool use_getrandom) /* Without GRND_NONBLOCK it can be blocked for minutes on some systems. */ if (use_getrandom && __getrandom (&r, sizeof r, GRND_NONBLOCK) == sizeof r) return r; -#if _LIBC || (defined CLOCK_MONOTONIC && HAVE_CLOCK_GETTIME) +#if HAS_CLOCK_ENTROPY /* Add entropy if getrandom did not work. */ struct __timespec64 tv; __clock_gettime64 (CLOCK_MONOTONIC, &tv); @@ -213,7 +219,7 @@ static const char letters[] = and return a read-write fd. The file is mode 0600. __GT_DIR: create a directory, which will be mode 0700. - We use a clever algorithm to get hard-to-predict names. */ + */ #ifdef _LIBC static #endif @@ -267,13 +273,20 @@ try_tempname_len (char *tmpl, int suffixlen, void *args, alignment. */ random_value v = ((uintptr_t) &v) / alignof (max_align_t); +#if !HAS_CLOCK_ENTROPY + /* Arrange gen_tempname to return less predictable file names on + systems lacking clock entropy . */ + static random_value prev_v; + v ^= prev_v; +#endif + /* How many random base-62 digits can currently be extracted from V. */ int vdigits = 0; /* Whether to consume entropy when acquiring random bits. On the first try it's worth the entropy cost with __GT_NOCREATE, which is inherently insecure and can use the entropy to make it a bit - less secure. On the (rare) second and later attempts it might + more secure. On the (rare) second and later attempts it might help against DoS attacks. */ bool use_getrandom = tryfunc == try_nocreate; @@ -318,6 +331,9 @@ try_tempname_len (char *tmpl, int suffixlen, void *args, if (fd >= 0) { __set_errno (save_errno); +#if !HAS_CLOCK_ENTROPY + prev_v = v; +#endif return fd; } else if (errno != EEXIST) diff --git a/lib/tempname.h b/lib/tempname.h index c172820f7f..5e3c5e1550 100644 --- a/lib/tempname.h +++ b/lib/tempname.h @@ -48,7 +48,7 @@ extern "C" { and return a read-write fd. The file is mode 0600. GT_DIR: create a directory, which will be mode 0700. - We use a clever algorithm to get hard-to-predict names. */ + */ extern int gen_tempname (char *tmpl, int suffixlen, int flags, int kind); /* Similar, except X_SUFFIX_LEN gives the number of Xs. */ extern int gen_tempname_len (char *tmpl, int suffixlen, int flags, int kind, diff --git a/lib/verify.h b/lib/verify.h index c5c63ae97c..47b6ee661b 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -303,13 +303,16 @@ template # define assume(R) ((R) ? (void) 0 : __builtin_unreachable ()) #elif 1200 <= _MSC_VER # define assume(R) __assume (R) +#elif 202311L <= __STDC_VERSION__ +# include +# define assume(R) ((R) ? (void) 0 : unreachable ()) #elif (defined GCC_LINT || defined lint) && _GL_HAS_BUILTIN_TRAP /* Doing it this way helps various packages when configured with --enable-gcc-warnings, which compiles with -Dlint. It's nicer - when 'assume' silences warnings even with older GCCs. */ + if 'assume' silences warnings with GCC 3.4 through GCC 4.4.7 (2012). */ # define assume(R) ((R) ? (void) 0 : __builtin_trap ()) #else - /* Some tools grok NOTREACHED, e.g., Oracle Studio 12.6. */ + /* Some older tools grok NOTREACHED, e.g., Oracle Studio 12.6 (2017). */ # define assume(R) ((R) ? (void) 0 : /*NOTREACHED*/ (void) 0) #endif diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index fb5f1b52a4..0c43dde716 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -171,6 +171,7 @@ AC_DEFUN([gl_EARLY], # Code from module stat-time: # Code from module std-gnu11: # Code from module stdalign: + # Code from module stdckdint: # Code from module stddef: # Code from module stdint: # Code from module stdio: @@ -631,6 +632,7 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_61bcaca76b3e6f9ae55d57a1c3193bc4=false gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false gl_gnulib_enabled_scratch_buffer=false + gl_gnulib_enabled_stdckdint=false gl_gnulib_enabled_strtoll=false gl_gnulib_enabled_utimens=false gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false @@ -743,6 +745,9 @@ AC_DEFUN([gl_INIT], if test $HAVE_GROUP_MEMBER = 0; then func_gl_gnulib_m4code_d3b2383720ee0e541357aa2aac598e2b fi + if test $HAVE_GROUP_MEMBER = 0; then + func_gl_gnulib_m4code_stdckdint + fi fi } func_gl_gnulib_m4code_lchmod () @@ -880,6 +885,20 @@ AC_DEFUN([gl_INIT], func_gl_gnulib_m4code_61bcaca76b3e6f9ae55d57a1c3193bc4 fi } + func_gl_gnulib_m4code_stdckdint () + { + if ! $gl_gnulib_enabled_stdckdint; then + AC_CHECK_HEADERS_ONCE([stdckdint.h]) + if test $ac_cv_header_stdckdint_h = yes; then + GL_GENERATE_STDCKDINT_H=false + else + GL_GENERATE_STDCKDINT_H=true + fi + gl_CONDITIONAL_HEADER([stdckdint.h]) + AC_PROG_MKDIR_P + gl_gnulib_enabled_stdckdint=true + fi + } func_gl_gnulib_m4code_strtoll () { if ! $gl_gnulib_enabled_strtoll; then @@ -1006,6 +1025,7 @@ AC_DEFUN([gl_INIT], AM_CONDITIONAL([gl_GNULIB_ENABLED_61bcaca76b3e6f9ae55d57a1c3193bc4], [$gl_gnulib_enabled_61bcaca76b3e6f9ae55d57a1c3193bc4]) AM_CONDITIONAL([gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c], [$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c]) AM_CONDITIONAL([gl_GNULIB_ENABLED_scratch_buffer], [$gl_gnulib_enabled_scratch_buffer]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_stdckdint], [$gl_gnulib_enabled_stdckdint]) AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll]) AM_CONDITIONAL([gl_GNULIB_ENABLED_utimens], [$gl_gnulib_enabled_utimens]) AM_CONDITIONAL([gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec], [$gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec]) @@ -1277,6 +1297,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/idx.h lib/ieee754.in.h lib/ignore-value.h + lib/intprops-internal.h lib/intprops.h lib/inttypes.in.h lib/lchmod.c @@ -1349,6 +1370,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/stat-time.c lib/stat-time.h lib/stdalign.in.h + lib/stdckdint.in.h lib/stddef.in.h lib/stdint.in.h lib/stdio-impl.h diff --git a/m4/largefile.m4 b/m4/largefile.m4 index 3e8b5e39a7..ec9677c46d 100644 --- a/m4/largefile.m4 +++ b/m4/largefile.m4 @@ -10,8 +10,10 @@ # It does not set _LARGEFILE_SOURCE=1 on HP-UX/ia64 32-bit, although this # setting of _LARGEFILE_SOURCE is needed so that declares fseeko # and ftello in C++ mode as well. +# Fixed in Autoconf 2.72, which has AC_SYS_YEAR2038. AC_DEFUN([gl_SET_LARGEFILE_SOURCE], [ + m4_ifndef([AC_SYS_YEAR2038], [ AC_REQUIRE([AC_CANONICAL_HOST]) AC_FUNC_FSEEKO case "$host_os" in @@ -20,9 +22,10 @@ AC_DEFUN([gl_SET_LARGEFILE_SOURCE], [Define to 1 to make fseeko visible on some hosts (e.g. glibc 2.2).]) ;; esac + ]) ]) -# Work around a problem in Autoconf through at least 2.71 on glibc 2.34+ +# Work around a problem in Autoconf through 2.71 on glibc 2.34+ # with _TIME_BITS. Also, work around a problem in autoconf <= 2.69: # AC_SYS_LARGEFILE does not configure for large inodes on Mac OS X 10.5, # or configures them incorrectly in some cases. @@ -43,6 +46,7 @@ m4_define([_AC_SYS_LARGEFILE_TEST_INCLUDES], ]) ])# m4_version_prereq 2.70 +m4_ifndef([AC_SYS_YEAR2038], [ # _AC_SYS_LARGEFILE_MACRO_VALUE(C-MACRO, VALUE, # CACHE-VAR, @@ -118,6 +122,7 @@ AS_IF([test "$enable_largefile" != no], [64], [gl_YEAR2038_BODY([])])]) ])# AC_SYS_LARGEFILE +])# m4_ifndef AC_SYS_YEAR2038 # Enable large files on systems where this is implemented by Gnulib, not by the # system headers. diff --git a/m4/year2038.m4 b/m4/year2038.m4 index 06db589ba9..2e4427e6fa 100644 --- a/m4/year2038.m4 +++ b/m4/year2038.m4 @@ -1,4 +1,4 @@ -# year2038.m4 serial 7 +# year2038.m4 serial 8 dnl Copyright (C) 2017-2022 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -7,6 +7,12 @@ dnl with or without modifications, as long as this notice is preserved. dnl Attempt to ensure that 'time_t' can go past the year 2038 and that dnl the functions 'time', 'stat', etc. work with post-2038 timestamps. +m4_ifdef([AC_SYS_YEAR2038], [ + AC_DEFUN([gl_YEAR2038_EARLY]) + AC_DEFUN([gl_YEAR2038], [AC_SYS_YEAR2038]) + AC_DEFUN([gl_YEAR2038_BODY], [_AC_SYS_YEAR2038]) +], [ + AC_DEFUN([gl_YEAR2038_EARLY], [ AC_REQUIRE([AC_CANONICAL_HOST]) @@ -122,3 +128,5 @@ AC_DEFUN([gl_YEAR2038], [ gl_YEAR2038_BODY([require-year2038-safe]) ]) + +]) # m4_ifndef AC_SYS_YEAR2038 commit 3e042c80ce708b2d27da8ff62f19a5706f6d7fc6 Author: Andrea Corallo Date: Wed Aug 17 23:31:41 2022 +0200 * lisp/emacs-lisp/bytecomp.el (byte-compile-log-1): Create buffer if necessary diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 907015eb48..1115ce391d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1161,7 +1161,7 @@ message buffer `default-directory'." ;; Log something that isn't a warning. (defun byte-compile-log-1 (string) - (with-current-buffer byte-compile-log-buffer + (with-current-buffer (get-buffer-create byte-compile-log-buffer) (let ((inhibit-read-only t)) (goto-char (point-max)) (byte-compile-warning-prefix nil nil) commit f0c5de78394cb3155cf51f5946f25610e2ab5d0b Author: Alan Mackenzie Date: Wed Aug 17 20:34:43 2022 +0000 * lisp/progmodes/cc-defs.el (c-safe-scan-lists): Evaluate LIMIT just once diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 04f519dd0a..48ae4368a7 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -794,15 +794,16 @@ right side of it." `(c-safe (scan-lists ,from ,count ,depth))))) (if limit `(save-restriction - (when ,limit - ,(if (numberp count) - (if (< count 0) - `(narrow-to-region ,limit (point-max)) - `(narrow-to-region (point-min) ,limit)) - `(if (< ,count 0) - (narrow-to-region ,limit (point-max)) - (narrow-to-region (point-min) ,limit)))) - ,res) + (let ((-limit- ,limit)) + (when -limit- + ,(if (numberp count) + (if (< count 0) + `(narrow-to-region -limit- (point-max)) + `(narrow-to-region (point-min) -limit-)) + `(if (< ,count 0) + (narrow-to-region -limit- (point-max)) + (narrow-to-region (point-min) -limit-)))) + ,res)) res))) commit 31f289625cb3f72d167f1f9cac246269eeb5c716 Author: Basil L. Contovounesios Date: Wed Aug 17 20:11:25 2022 +0300 Fix Linux APM BIOS flag testing in battery.el Original sin detected by recent byte-compiler improvements; see: https://lists.gnu.org/r/emacs-devel/2022-08/msg00611.html * lisp/battery.el (battery-linux-proc-apm): Treat result of logand as a number, not boolean. diff --git a/lisp/battery.el b/lisp/battery.el index 93f4070e4b..72b3dfdae7 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -369,11 +369,11 @@ The following %-sequences are provided: (setq driver-version (match-string 1)) (setq bios-version (match-string 2)) (setq tem (string-to-number (match-string 3) 16)) - (if (not (logand tem 2)) + (if (zerop (logand tem 2)) (setq bios-interface "not supported") (setq bios-interface "enabled") - (cond ((logand tem 16) (setq bios-interface "disabled")) - ((logand tem 32) (setq bios-interface "disengaged"))) + (cond ((/= (logand tem 16) 0) (setq bios-interface "disabled")) + ((/= (logand tem 32) 0) (setq bios-interface "disengaged"))) (setq tem (string-to-number (match-string 4) 16)) (cond ((= tem 0) (setq line-status "off-line")) ((= tem 1) (setq line-status "on-line")) commit 78460500c75ab3f36ea646a1266ac6803f2d16e6 Author: Stefan Kangas Date: Tue Aug 16 20:51:38 2022 +0200 Shorten new manual section "Shell Command Guessing" * doc/emacs/dired.texi (Shell Command Guessing): Don't document unimportant details, and improve wording to be shorter. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 00028cac0f..33e9270d42 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -1132,17 +1132,13 @@ file named @file{foo.tar} and you press @kbd{!}, Dired will guess that you want to run @samp{tar xvf}, and suggest that as the default shell command. -The default is mentioned in brackets and you can type @kbd{M-n} to get -the default into the minibuffer for editing. If there are several -commands for a given file, e.g., @samp{xtex} and @samp{dvips} for a -@file{.dvi} file, you can type @kbd{M-n} several times to see each of -the matching commands. +You can type @kbd{M-n} to get the default into the minibuffer for +editing. If there are several commands for a given file, type +@kbd{M-n} several times to see each matching command in order. Dired only tries to guess a command for a single file, never for a list of marked files. -The following variables control guessing of shell commands: - @defvar dired-guess-shell-alist-default This variable specifies the predefined rules for guessing shell commands suitable for certain files. Set this to @code{nil} to turn @@ -1151,12 +1147,11 @@ guessing off. The elements of @code{dired-guess-shell-alist-user} @end defvar @defvar dired-guess-shell-alist-user -If non-@code{nil}, this variables specifies the user-defined alist of +If non-@code{nil}, this variable specifies the user-defined alist of file regexps and their suggested commands. These rules take precedence over the predefined rules in the variable -@code{dired-guess-shell-alist-default} (to which they are prepended) -when @code{dired-do-shell-command} is run). The default is -@code{nil}. +@code{dired-guess-shell-alist-default} when +@code{dired-do-shell-command} is run). The default is @code{nil}. Each element of the alist looks like @@ -1173,8 +1168,8 @@ A @samp{*} in the shell command stands for the file name that matched @var{regexp}. When Emacs invokes the @var{command}, it replaces each instance of @samp{*} with the matched file name. -You can set this variable in your Init file. For example, to add -rules for @samp{.foo} and @samp{.bar} file extensions: +To add rules for @samp{.foo} and @samp{.bar} file extensions, add this +to your Init file: @example (setq dired-guess-shell-alist-user @@ -1191,39 +1186,8 @@ rules for @samp{.foo} and @samp{.bar} file extensions: This will override any predefined rules for the same extensions. @end defvar -@defvar dired-guess-shell-case-fold-search -If this variable is non-@code{nil}, -@code{dired-guess-shell-alist-default} and -@code{dired-guess-shell-alist-user} are matched case-insensitively. -The default is @code{t}. -@end defvar - -@defvar dired-guess-shell-gnutar -If this variable is non-@code{nil}, it specifies the name of the GNU -Tar executable (e.g., @file{tar} or @file{gtar}). GNU Tar's @samp{z} -switch is used for compressed archives. If you don't have GNU Tar, -set this to @code{nil}: a pipe using @command{zcat} is then used -instead. -@end defvar - -@defvar dired-guess-shell-gzip-quiet -A non-@code{nil} value of this variable means that @samp{-q} is passed -to @command{gzip}, possibly overriding a verbose option in the -@env{GZIP} environment variable. The default is @code{t}. -@end defvar - -@defvar dired-guess-shell-znew-switches nil -This variable specifies a string of switches passed to @command{znew}. -An example is @samp{-K} which will make @command{znew} keep a -@file{.Z} file when it is smaller than the @file{.gz} file. The -default is @code{nil}: no additional switches are passed to -@command{znew}. -@end defvar - -@defvar dired-shell-command-history nil -This variable holds the history list for commands that read -dired-shell commands. -@end defvar +You can find more user options with @kbd{M-x customize-group @key{RET} +dired-guess @key{RET}}. @node Transforming File Names @section Transforming File Names in Dired commit 9dfabe075698760bd74580d97f647cb2a6a32f1b Author: Stefan Kangas Date: Tue Aug 16 19:52:48 2022 +0200 Assume dired-guess is now always available * lisp/dired-aux.el (dired-read-shell-command): Use dired-guess-shell-command unconditionally, as it is now always available. (dired-do-shell-command): Doc fix; dired-guess is always available. * lisp/dired.el (dired-do-man): Don't require dired-x. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 426273f65e..94b2baf72d 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -780,20 +780,16 @@ which is replaced by the value returned by `dired-mark-prompt', with ARG and FILES as its arguments. FILES should be a list of file names. The result is used as the prompt. -This normally reads using `read-shell-command', but if the -`dired-x' package is loaded, use `dired-guess-shell-command' to -offer a smarter default choice of shell command." +Use `dired-guess-shell-command' to offer a smarter default choice +of shell command." (minibuffer-with-setup-hook (lambda () (setq-local dired-aux-files files) (setq-local minibuffer-default-add-function #'dired-minibuffer-default-add-shell-commands)) (setq prompt (format prompt (dired-mark-prompt arg files))) - (if (functionp 'dired-guess-shell-command) - (dired-mark-pop-up nil 'shell files - 'dired-guess-shell-command prompt files) - (dired-mark-pop-up nil 'shell files - 'read-shell-command prompt nil nil)))) + (dired-mark-pop-up nil 'shell files + 'dired-guess-shell-command prompt files))) ;;;###autoload (defcustom dired-confirm-shell-command t @@ -882,7 +878,7 @@ In a noninteractive call (from Lisp code), you must specify the list of file names explicitly with the FILE-LIST argument, which can be produced by `dired-get-marked-files', for example. -If `dired-x' is loaded, `dired-guess-shell-alist-default' and +`dired-guess-shell-alist-default' and `dired-guess-shell-alist-user' are consulted when the user is prompted for the shell command to use interactively. diff --git a/lisp/dired.el b/lisp/dired.el index 799a9f4716..01098fdf89 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4919,16 +4919,12 @@ Interactively with prefix argument, read FILE-NAME." ;;; Miscellaneous commands (declare-function Man-getpage-in-background "man" (topic)) -(declare-function dired-guess-shell-command "dired-x" (prompt files)) (defvar manual-program) ; from man.el (defun dired-do-man () "In Dired, run `man' on this file." (interactive nil dired-mode) (require 'man) - ;; FIXME: Move `dired-guess-shell-command' to dired.el to remove the - ;; need for requiring `dired-x'. - (require 'dired-x) (let* ((file (dired-get-file-for-visit)) (manual-program (string-replace "*" "%s" (dired-guess-shell-command commit a6412b96e72c32ee981f469a564c8d2155d575aa Author: Stefan Kangas Date: Tue Aug 16 17:14:33 2022 +0200 Move dired-guess commands from dired-x to dired * lisp/dired-x.el (dired-shell-command-history) (dired-guess-shell-alist-default, dired-guess-default) (dired-guess-shell-command): Move from here... * lisp/dired-aux.el (dired-shell-command-history) (dired-guess-shell-alist-default, dired-guess-default) (dired-guess-shell-command): ...to here. (Bug#21981) * lisp/dired-x.el (dired-guess-shell-gnutar) (dired-guess-shell-gzip-quiet, dired-guess-shell-znew-switches) (dired-guess-shell-case-fold-search, dired-guess-shell-alist-user): Move from here... * lisp/dired.el (dired-guess-shell-gnutar) (dired-guess-shell-gzip-quiet, dired-guess-shell-znew-switches) (dired-guess-shell-case-fold-search, dired-guess-shell-alist-user): ...to here. Change :group to dired-guess. (dired-guess): New defgroup. * test/lisp/dired-x-tests.el (dired-guess-default): Move from here... * test/lisp/dired-aux-tests.el (dired-guess-default): ...to here. * doc/misc/dired-x.texi (Features, Technical Details, Installation): Delete any mention of shell command guessing. (Shell Command Guessing): Move from here... * doc/emacs/dired.texi (Shell Command Guessing): ...to here. Adapt to better fit the Emacs Manual conventions. * lisp/dired-aux.el (dired-do-shell-command): Doc fix to adjust for above changes. * etc/NEWS: Announce the above change. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 292c986c1c..00028cac0f 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -41,6 +41,7 @@ you to operate on the listed files. @xref{Directories}. * Operating on Files:: How to copy, rename, print, compress, etc. either one file or several files. * Shell Commands in Dired:: Running a shell command on the marked files. +* Shell Command Guessing:: Guessing shell commands for files. * Transforming File Names:: Using patterns to rename multiple files. * Comparison in Dired:: Running @code{diff} by way of Dired. * Subdirectories in Dired:: Adding subdirectories to the Dired buffer. @@ -1121,6 +1122,109 @@ buffer (@pxref{Dired Updating}). @xref{Single Shell}, for information about running shell commands outside Dired. +@node Shell Command Guessing +@section Shell Command Guessing +@cindex guessing shell commands for files (in Dired) + +Based upon the name of a file, Dired tries to guess what shell command +you might want to apply to it. For example, if you have point on a +file named @file{foo.tar} and you press @kbd{!}, Dired will guess that +you want to run @samp{tar xvf}, and suggest that as the default shell +command. + +The default is mentioned in brackets and you can type @kbd{M-n} to get +the default into the minibuffer for editing. If there are several +commands for a given file, e.g., @samp{xtex} and @samp{dvips} for a +@file{.dvi} file, you can type @kbd{M-n} several times to see each of +the matching commands. + +Dired only tries to guess a command for a single file, never for a +list of marked files. + +The following variables control guessing of shell commands: + +@defvar dired-guess-shell-alist-default +This variable specifies the predefined rules for guessing shell +commands suitable for certain files. Set this to @code{nil} to turn +guessing off. The elements of @code{dired-guess-shell-alist-user} +(defined by the user) will override these rules. +@end defvar + +@defvar dired-guess-shell-alist-user +If non-@code{nil}, this variables specifies the user-defined alist of +file regexps and their suggested commands. These rules take +precedence over the predefined rules in the variable +@code{dired-guess-shell-alist-default} (to which they are prepended) +when @code{dired-do-shell-command} is run). The default is +@code{nil}. + +Each element of the alist looks like + +@example +(@var{regexp} @var{command}@dots{}) +@end example + +@noindent +where each @var{command} can either be a string or a Lisp expression +that evaluates to a string. If several commands are given, all of +them will temporarily be pushed onto the history. + +A @samp{*} in the shell command stands for the file name that matched +@var{regexp}. When Emacs invokes the @var{command}, it replaces each +instance of @samp{*} with the matched file name. + +You can set this variable in your Init file. For example, to add +rules for @samp{.foo} and @samp{.bar} file extensions: + +@example +(setq dired-guess-shell-alist-user + (list + (list "\\.foo$" "@var{foo-command}") ; fixed rule + ;; possibly more rules... + (list "\\.bar$" ; rule with condition test + '(if @var{condition} + "@var{bar-command-1}" + "@var{bar-command-2}")))) +@end example + +@noindent +This will override any predefined rules for the same extensions. +@end defvar + +@defvar dired-guess-shell-case-fold-search +If this variable is non-@code{nil}, +@code{dired-guess-shell-alist-default} and +@code{dired-guess-shell-alist-user} are matched case-insensitively. +The default is @code{t}. +@end defvar + +@defvar dired-guess-shell-gnutar +If this variable is non-@code{nil}, it specifies the name of the GNU +Tar executable (e.g., @file{tar} or @file{gtar}). GNU Tar's @samp{z} +switch is used for compressed archives. If you don't have GNU Tar, +set this to @code{nil}: a pipe using @command{zcat} is then used +instead. +@end defvar + +@defvar dired-guess-shell-gzip-quiet +A non-@code{nil} value of this variable means that @samp{-q} is passed +to @command{gzip}, possibly overriding a verbose option in the +@env{GZIP} environment variable. The default is @code{t}. +@end defvar + +@defvar dired-guess-shell-znew-switches nil +This variable specifies a string of switches passed to @command{znew}. +An example is @samp{-K} which will make @command{znew} keep a +@file{.Z} file when it is smaller than the @file{.gz} file. The +default is @code{nil}: no additional switches are passed to +@command{znew}. +@end defvar + +@defvar dired-shell-command-history nil +This variable holds the history list for commands that read +dired-shell commands. +@end defvar + @node Transforming File Names @section Transforming File Names in Dired diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 50d9914081..002164ed91 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -92,7 +92,6 @@ For @file{dired-x.el} as distributed with GNU Emacs @value{EMACSVER}. * Introduction:: * Installation:: * Omitting Files in Dired:: -* Shell Command Guessing:: * Virtual Dired:: * Advanced Mark Commands:: * Multiple Dired Directories:: @@ -135,9 +134,6 @@ Some features provided by Dired Extra: Omitting uninteresting files from Dired listing (@pxref{Omitting Files in Dired}). @item -Guessing shell commands in Dired buffers -(@pxref{Shell Command Guessing}). -@item Running Dired command in non-Dired buffers (@pxref{Virtual Dired}). @item @@ -165,8 +161,6 @@ When @file{dired-x.el} is loaded, some standard Dired functions from Dired}), if it is active. @code{dired-find-buffer-nocreate} and @code{dired-initial-position} respect the value of @code{dired-find-subdir} (@pxref{Miscellaneous Commands}). -@code{dired-read-shell-command} uses @code{dired-guess-shell-command} -(@pxref{Shell Command Guessing}) to offer a smarter default command. @node Installation @chapter Installation @@ -184,7 +178,6 @@ In your @file{~/.emacs} file, or in the system-wide initialization file (with-eval-after-load 'dired (require 'dired-x) ;; Set dired-x global variables here. For example: - ;; (setq dired-guess-shell-gnutar "gtar") ;; (setq dired-x-hands-off-my-keys nil) )) (add-hook 'dired-mode-hook @@ -436,111 +429,6 @@ Loading @file{dired-x.el} will install Dired Omit by putting call @code{dired-extra-startup}, which in turn calls @code{dired-omit-startup} in your @code{dired-mode-hook}. -@node Shell Command Guessing -@chapter Shell Command Guessing -@cindex guessing shell commands for files. - -Based upon the name of a file, Dired tries to guess what shell -command you might want to apply to it. For example, if you have point -on a file named @file{foo.tar} and you press @kbd{!}, Dired will guess -you want to @samp{tar xvf} it and suggest that as the default shell -command. - -The default is mentioned in brackets and you can type @kbd{M-n} to get -the default into the minibuffer and then edit it, e.g., to change -@samp{tar xvf} to @samp{tar tvf}. If there are several commands for a given -file, e.g., @samp{xtex} and @samp{dvips} for a @file{.dvi} file, you can type -@kbd{M-n} several times to see each of the matching commands. - -Dired only tries to guess a command for a single file, never for a list -of marked files. - -The following variables control guessing of shell commands: - -@defvar dired-guess-shell-alist-default -This variable specifies the predefined rules for guessing shell -commands suitable for certain files. Set this to @code{nil} to turn -guessing off. The elements of @code{dired-guess-shell-alist-user} -(defined by the user) will override these rules. -@end defvar - -@defvar dired-guess-shell-alist-user -If non-@code{nil}, this variables specifies the user-defined alist of -file regexps and their suggested commands. These rules take -precedence over the predefined rules in the variable -@code{dired-guess-shell-alist-default} (to which they are prepended) -when @code{dired-do-shell-command} is run). The default is -@code{nil}. - -Each element of the alist looks like - -@example -(@var{regexp} @var{command}@dots{}) -@end example - -@noindent -where each @var{command} can either be a string or a Lisp expression -that evaluates to a string. If several commands are given, all of -them will temporarily be pushed onto the history. - -A @samp{*} in the shell command stands for the file name that matched -@var{regexp}. When Emacs invokes the @var{command}, it replaces each -instance of @samp{*} with the matched file name. - -You can set this variable in your @file{~/.emacs}. For example, -to add rules for @samp{.foo} and @samp{.bar} file extensions, write - -@example -(setq dired-guess-shell-alist-user - (list - (list "\\.foo$" "@var{foo-command}");; fixed rule - ;; possibly more rules... - (list "\\.bar$";; rule with condition test - '(if @var{condition} - "@var{bar-command-1}" - "@var{bar-command-2}")))) -@end example - -@noindent -This will override any predefined rules for the same extensions. -@end defvar - -@defvar dired-guess-shell-case-fold-search -If this variable is non-@code{nil}, -@code{dired-guess-shell-alist-default} and -@code{dired-guess-shell-alist-user} are matched case-insensitively. -The default is @code{t}. -@end defvar - -@cindex passing GNU Tar its @samp{z} switch. -@defvar dired-guess-shell-gnutar -If this variable is non-@code{nil}, it specifies the name of the GNU -Tar executable (e.g., @file{tar} or @file{gnutar}). GNU Tar's -@samp{z} switch is used for compressed archives. If you don't have -GNU Tar, set this to @code{nil}: a pipe using @command{zcat} is then -used instead. The default is @code{nil}. -@end defvar - -@cindex @code{gzip} -@defvar dired-guess-shell-gzip-quiet -A non-@code{nil} value of this variable means that @samp{-q} is passed -to @command{gzip}, possibly overriding a verbose option in the @env{GZIP} -environment variable. The default is @code{t}. -@end defvar - -@cindex @code{znew} -@defvar dired-guess-shell-znew-switches nil -This variable specifies a string of switches passed to @command{znew}. -An example is @samp{-K} which will make @command{znew} keep a @file{.Z} -file when it is smaller than the @file{.gz} file. The default is -@code{nil}: no additional switches are passed to @command{znew}. -@end defvar - -@defvar dired-shell-command-history nil -This variable holds the history list for commands that read -dired-shell commands. -@end defvar - @node Virtual Dired @chapter Virtual Dired diff --git a/etc/NEWS b/etc/NEWS index 5d87bc9e2e..4b3a48a820 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1159,6 +1159,12 @@ change the input method's translation rules, customize the user option ** Dired ++++ +*** 'dired-guess-shell-command' moved from dired-x to dired. +This means that 'dired-do-shell-command' will now provide smarter +defaults without first having to require 'dired-x'. See the node +"(emacs) Shell Command Guessing" in the Emacs manual for more details. + --- *** 'dired-clean-up-buffers-too' moved from dired-x to dired. This means that Dired now offers to kill buffers visiting files and diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 7ff3e33351..426273f65e 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1070,6 +1070,265 @@ Return the result of `process-file' - zero for success." (pop-to-buffer out-buffer)) res))))) + +;;; Guess shell command + +;; * `dired-guess-shell-command' provides smarter defaults for +;; `dired-read-shell-command'. +;; +;; * `dired-guess-shell-command' calls `dired-guess-default' with list of +;; marked files. +;; +;; * Parse `dired-guess-shell-alist-user' and +;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP +;; that matches the first file in the file list. +;; +;; * If the REGEXP matches all the entries of the file list then evaluate +;; COMMAND, which is either a string or a Lisp expression returning a +;; string. COMMAND may be a list of commands. +;; +;; * Return this command to `dired-guess-shell-command' which prompts user +;; with it. The list of commands is put into the list of default values. +;; If a command is used successfully then it is stored permanently in +;; `dired-shell-command-history'. + +;; Guess what shell command to apply to a file. +(defvar dired-shell-command-history nil + "History list for commands that read dired-shell commands.") + +;; Default list of shell commands. + +;; NOTE: Use `gunzip -c' instead of `zcat' on `.gz' files. Some do not +;; install GNU zip's version of zcat. + +(autoload 'Man-support-local-filenames "man") +(autoload 'vc-responsible-backend "vc") + +(defvar dired-guess-shell-alist-default + (list + (list "\\.tar\\'" + '(if dired-guess-shell-gnutar + (concat dired-guess-shell-gnutar " xvf") + "tar xvf") + ;; Extract files into a separate subdirectory + '(if dired-guess-shell-gnutar + (concat "mkdir " (file-name-sans-extension file) + "; " dired-guess-shell-gnutar " -C " + (file-name-sans-extension file) " -xvf") + (concat "mkdir " (file-name-sans-extension file) + "; tar -C " (file-name-sans-extension file) " -xvf")) + ;; List archive contents. + '(if dired-guess-shell-gnutar + (concat dired-guess-shell-gnutar " tvf") + "tar tvf")) + + ;; REGEXPS for compressed archives must come before the .Z rule to + ;; be recognized: + (list "\\.tar\\.Z\\'" + ;; Untar it. + '(if dired-guess-shell-gnutar + (concat dired-guess-shell-gnutar " zxvf") + (concat "zcat * | tar xvf -")) + ;; Optional conversion to gzip format. + '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") + " " dired-guess-shell-znew-switches)) + + ;; gzip'ed archives + (list "\\.t\\(ar\\.\\)?gz\\'" + '(if dired-guess-shell-gnutar + (concat dired-guess-shell-gnutar " zxvf") + (concat "gunzip -qc * | tar xvf -")) + ;; Extract files into a separate subdirectory + '(if dired-guess-shell-gnutar + (concat "mkdir " (file-name-sans-extension file) + "; " dired-guess-shell-gnutar " -C " + (file-name-sans-extension file) " -zxvf") + (concat "mkdir " (file-name-sans-extension file) + "; gunzip -qc * | tar -C " + (file-name-sans-extension file) " -xvf -")) + ;; Optional decompression. + '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q" "")) + ;; List archive contents. + '(if dired-guess-shell-gnutar + (concat dired-guess-shell-gnutar " ztvf") + (concat "gunzip -qc * | tar tvf -"))) + + ;; bzip2'ed archives + (list "\\.t\\(ar\\.bz2\\|bz\\)\\'" + "bunzip2 -c * | tar xvf -" + ;; Extract files into a separate subdirectory + '(concat "mkdir " (file-name-sans-extension file) + "; bunzip2 -c * | tar -C " + (file-name-sans-extension file) " -xvf -") + ;; Optional decompression. + "bunzip2") + + ;; xz'ed archives + (list "\\.t\\(ar\\.\\)?xz\\'" + "unxz -c * | tar xvf -" + ;; Extract files into a separate subdirectory + '(concat "mkdir " (file-name-sans-extension file) + "; unxz -c * | tar -C " + (file-name-sans-extension file) " -xvf -") + ;; Optional decompression. + "unxz") + + '("\\.shar\\.Z\\'" "zcat * | unshar") + '("\\.shar\\.g?z\\'" "gunzip -qc * | unshar") + + '("\\.e?ps\\'" "ghostview" "xloadimage" "lpr") + (list "\\.e?ps\\.g?z\\'" "gunzip -qc * | ghostview -" + ;; Optional decompression. + '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) + (list "\\.e?ps\\.Z\\'" "zcat * | ghostview -" + ;; Optional conversion to gzip format. + '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") + " " dired-guess-shell-znew-switches)) + + (list "\\.patch\\'" + '(if (eq (ignore-errors (vc-responsible-backend default-directory)) 'Git) + "cat * | git apply" + "cat * | patch")) + (list "\\.patch\\.g?z\\'" "gunzip -qc * | patch" + ;; Optional decompression. + '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) + (list "\\.patch\\.Z\\'" "zcat * | patch" + ;; Optional conversion to gzip format. + '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") + " " dired-guess-shell-znew-switches)) + + ;; The following four extensions are useful with dired-man ("N" key) + ;; FIXME "man ./" does not work with dired-do-shell-command, + ;; because there seems to be no way for us to modify the filename, + ;; only the command. Hmph. `dired-man' works though. + (list "\\.\\(?:[0-9]\\|man\\)\\'" + '(let ((loc (Man-support-local-filenames))) + (cond ((eq loc 'man-db) "man -l") + ((eq loc 'man) "man ./") + (t + "cat * | tbl | nroff -man -h | col -b")))) + (list "\\.\\(?:[0-9]\\|man\\)\\.g?z\\'" + '(let ((loc (Man-support-local-filenames))) + (cond ((eq loc 'man-db) + "man -l") + ((eq loc 'man) + "man ./") + (t "gunzip -qc * | tbl | nroff -man -h | col -b"))) + ;; Optional decompression. + '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) + (list "\\.[0-9]\\.Z\\'" + '(let ((loc (Man-support-local-filenames))) + (cond ((eq loc 'man-db) "man -l") + ((eq loc 'man) "man ./") + (t "zcat * | tbl | nroff -man -h | col -b"))) + ;; Optional conversion to gzip format. + '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") + " " dired-guess-shell-znew-switches)) + '("\\.pod\\'" "perldoc" "pod2man * | nroff -man") + + '("\\.dvi\\'" "xdvi" "dvips") ; preview and printing + '("\\.au\\'" "play") ; play Sun audiofiles + '("\\.mpe?g\\'\\|\\.avi\\'" "xine -p") + '("\\.ogg\\'" "ogg123") + '("\\.mp3\\'" "mpg123") + '("\\.wav\\'" "play") + '("\\.uu\\'" "uudecode") ; for uudecoded files + '("\\.hqx\\'" "mcvert") + '("\\.sh\\'" "sh") ; execute shell scripts + '("\\.xbm\\'" "bitmap") ; view X11 bitmaps + '("\\.gp\\'" "gnuplot") + '("\\.p[bgpn]m\\'" "xloadimage") + '("\\.gif\\'" "xloadimage") ; view gif pictures + '("\\.tif\\'" "xloadimage") + '("\\.png\\'" "display") ; xloadimage 4.1 doesn't grok PNG + '("\\.jpe?g\\'" "xloadimage") + '("\\.fig\\'" "xfig") ; edit fig pictures + '("\\.out\\'" "xgraph") ; for plotting purposes. + '("\\.tex\\'" "latex" "tex") + '("\\.texi\\(nfo\\)?\\'" "makeinfo" "texi2dvi") + '("\\.pdf\\'" "xpdf") + '("\\.doc\\'" "antiword" "strings") + '("\\.rpm\\'" "rpm -qilp" "rpm -ivh") + '("\\.dia\\'" "dia") + '("\\.mgp\\'" "mgp") + + ;; Some other popular archivers. + (list "\\.zip\\'" "unzip" "unzip -l" + ;; Extract files into a separate subdirectory + '(concat "unzip" (if dired-guess-shell-gzip-quiet " -q") + " -d " (file-name-sans-extension file))) + '("\\.zoo\\'" "zoo x//") + '("\\.lzh\\'" "lharc x") + '("\\.arc\\'" "arc x") + '("\\.shar\\'" "unshar") + '("\\.rar\\'" "unrar x") + '("\\.7z\\'" "7z x") + + ;; Compression. + (list "\\.g?z\\'" '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) + (list "\\.dz\\'" "dictunzip") + (list "\\.bz2\\'" "bunzip2") + (list "\\.xz\\'" "unxz") + (list "\\.Z\\'" "uncompress" + ;; Optional conversion to gzip format. + '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") + " " dired-guess-shell-znew-switches)) + + '("\\.sign?\\'" "gpg --verify")) + "Default alist used for shell command guessing. +See `dired-guess-shell-alist-user'.") + +(defun dired-guess-default (files) + "Return a shell command, or a list of commands, appropriate for FILES. +See `dired-guess-shell-alist-user'." + (let* ((case-fold-search dired-guess-shell-case-fold-search) + (programs + (delete-dups + (mapcar + (lambda (command) + (eval command `((file . ,(car files))))) + (seq-reduce + #'append + (mapcar #'cdr + (seq-filter (lambda (elem) + (seq-every-p + (lambda (file) + (string-match-p (car elem) file)) + files)) + (append dired-guess-shell-alist-user + dired-guess-shell-alist-default))) + nil))))) + (if (length= programs 1) + (car programs) + programs))) + +;;;###autoload +(defun dired-guess-shell-command (prompt files) + "Ask user with PROMPT for a shell command, guessing a default from FILES." + (let ((default (dired-guess-default files)) + default-list val) + (if (null default) + ;; Nothing to guess + (read-shell-command prompt nil 'dired-shell-command-history) + (setq prompt (replace-regexp-in-string ": $" " " prompt)) + (if (listp default) + ;; More than one guess + (setq default-list default + default (car default) + prompt (concat + prompt + (format "{%d guesses} " (length default-list)))) + ;; Just one guess + (setq default-list (list default))) + ;; Put the first guess in the prompt but not in the initial value. + (setq prompt (concat prompt (format "[%s]: " default))) + ;; All guesses can be retrieved with M-n + (setq val (read-shell-command prompt nil + 'dired-shell-command-history + default-list)) + ;; If we got a return, then return default. + (if (equal val "") default val)))) + ;;; Commands that delete or redisplay part of the dired buffer diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 9edf837481..cf1ef37694 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -196,35 +196,6 @@ toggle between those two." :type 'boolean :group 'dired-x) -(defcustom dired-guess-shell-gnutar - (catch 'found - (dolist (exe '("tar" "gtar")) - (if (with-temp-buffer - (ignore-errors (call-process exe nil t nil "--version")) - (and (re-search-backward "GNU tar" nil t) t)) - (throw 'found exe)))) - "If non-nil, name of GNU tar executable. -\(E.g., \"tar\" or \"gtar\"). The `z' switch will be used with it for -compressed or gzip'ed tar files. If you don't have GNU tar, set this -to nil: a pipe using `zcat' or `gunzip -c' will be used." - ;; Changed from system-type test to testing --version output. - ;; Maybe test --help for -z instead? - :version "24.1" - :type '(choice (const :tag "Not GNU tar" nil) - (string :tag "Command name")) - :group 'dired-x) - -(defcustom dired-guess-shell-gzip-quiet t - "Non-nil says pass -q to gzip overriding verbose GZIP environment." - :type 'boolean - :group 'dired-x) - -(defcustom dired-guess-shell-znew-switches nil - "If non-nil, then string of switches passed to `znew', example: \"-K\"." - :type '(choice (const :tag "None" nil) - (string :tag "Switches")) - :group 'dired-x) - ;;; Key bindings @@ -726,302 +697,6 @@ Also useful for `auto-mode-alist' like this: default-directory))) (shell-command command output-buffer error-buffer))) - -;;; Guess shell command - -;; Brief Description: -;; -;; * `dired-do-shell-command' is bound to `!' by dired.el. -;; -;; * `dired-guess-shell-command' provides smarter defaults for -;; dired-aux.el's `dired-read-shell-command'. -;; -;; * `dired-guess-shell-command' calls `dired-guess-default' with list of -;; marked files. -;; -;; * Parse `dired-guess-shell-alist-user' and -;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP -;; that matches the first file in the file list. -;; -;; * If the REGEXP matches all the entries of the file list then evaluate -;; COMMAND, which is either a string or a Lisp expression returning a -;; string. COMMAND may be a list of commands. -;; -;; * Return this command to `dired-guess-shell-command' which prompts user -;; with it. The list of commands is put into the list of default values. -;; If a command is used successfully then it is stored permanently in -;; `dired-shell-command-history'. - -;; Guess what shell command to apply to a file. -(defvar dired-shell-command-history nil - "History list for commands that read dired-shell commands.") - -;; Default list of shell commands. - -;; NOTE: Use `gunzip -c' instead of `zcat' on `.gz' files. Some do not -;; install GNU zip's version of zcat. - -(autoload 'Man-support-local-filenames "man") -(autoload 'vc-responsible-backend "vc") - -(defvar dired-guess-shell-alist-default - (list - (list "\\.tar\\'" - '(if dired-guess-shell-gnutar - (concat dired-guess-shell-gnutar " xvf") - "tar xvf") - ;; Extract files into a separate subdirectory - '(if dired-guess-shell-gnutar - (concat "mkdir " (file-name-sans-extension file) - "; " dired-guess-shell-gnutar " -C " - (file-name-sans-extension file) " -xvf") - (concat "mkdir " (file-name-sans-extension file) - "; tar -C " (file-name-sans-extension file) " -xvf")) - ;; List archive contents. - '(if dired-guess-shell-gnutar - (concat dired-guess-shell-gnutar " tvf") - "tar tvf")) - - ;; REGEXPS for compressed archives must come before the .Z rule to - ;; be recognized: - (list "\\.tar\\.Z\\'" - ;; Untar it. - '(if dired-guess-shell-gnutar - (concat dired-guess-shell-gnutar " zxvf") - (concat "zcat * | tar xvf -")) - ;; Optional conversion to gzip format. - '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") - " " dired-guess-shell-znew-switches)) - - ;; gzip'ed archives - (list "\\.t\\(ar\\.\\)?gz\\'" - '(if dired-guess-shell-gnutar - (concat dired-guess-shell-gnutar " zxvf") - (concat "gunzip -qc * | tar xvf -")) - ;; Extract files into a separate subdirectory - '(if dired-guess-shell-gnutar - (concat "mkdir " (file-name-sans-extension file) - "; " dired-guess-shell-gnutar " -C " - (file-name-sans-extension file) " -zxvf") - (concat "mkdir " (file-name-sans-extension file) - "; gunzip -qc * | tar -C " - (file-name-sans-extension file) " -xvf -")) - ;; Optional decompression. - '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q" "")) - ;; List archive contents. - '(if dired-guess-shell-gnutar - (concat dired-guess-shell-gnutar " ztvf") - (concat "gunzip -qc * | tar tvf -"))) - - ;; bzip2'ed archives - (list "\\.t\\(ar\\.bz2\\|bz\\)\\'" - "bunzip2 -c * | tar xvf -" - ;; Extract files into a separate subdirectory - '(concat "mkdir " (file-name-sans-extension file) - "; bunzip2 -c * | tar -C " - (file-name-sans-extension file) " -xvf -") - ;; Optional decompression. - "bunzip2") - - ;; xz'ed archives - (list "\\.t\\(ar\\.\\)?xz\\'" - "unxz -c * | tar xvf -" - ;; Extract files into a separate subdirectory - '(concat "mkdir " (file-name-sans-extension file) - "; unxz -c * | tar -C " - (file-name-sans-extension file) " -xvf -") - ;; Optional decompression. - "unxz") - - '("\\.shar\\.Z\\'" "zcat * | unshar") - '("\\.shar\\.g?z\\'" "gunzip -qc * | unshar") - - '("\\.e?ps\\'" "ghostview" "xloadimage" "lpr") - (list "\\.e?ps\\.g?z\\'" "gunzip -qc * | ghostview -" - ;; Optional decompression. - '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) - (list "\\.e?ps\\.Z\\'" "zcat * | ghostview -" - ;; Optional conversion to gzip format. - '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") - " " dired-guess-shell-znew-switches)) - - (list "\\.patch\\'" - '(if (eq (ignore-errors (vc-responsible-backend default-directory)) 'Git) - "cat * | git apply" - "cat * | patch")) - (list "\\.patch\\.g?z\\'" "gunzip -qc * | patch" - ;; Optional decompression. - '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) - (list "\\.patch\\.Z\\'" "zcat * | patch" - ;; Optional conversion to gzip format. - '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") - " " dired-guess-shell-znew-switches)) - - ;; The following four extensions are useful with dired-man ("N" key) - ;; FIXME "man ./" does not work with dired-do-shell-command, - ;; because there seems to be no way for us to modify the filename, - ;; only the command. Hmph. `dired-man' works though. - (list "\\.\\(?:[0-9]\\|man\\)\\'" - '(let ((loc (Man-support-local-filenames))) - (cond ((eq loc 'man-db) "man -l") - ((eq loc 'man) "man ./") - (t - "cat * | tbl | nroff -man -h | col -b")))) - (list "\\.\\(?:[0-9]\\|man\\)\\.g?z\\'" - '(let ((loc (Man-support-local-filenames))) - (cond ((eq loc 'man-db) - "man -l") - ((eq loc 'man) - "man ./") - (t "gunzip -qc * | tbl | nroff -man -h | col -b"))) - ;; Optional decompression. - '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) - (list "\\.[0-9]\\.Z\\'" - '(let ((loc (Man-support-local-filenames))) - (cond ((eq loc 'man-db) "man -l") - ((eq loc 'man) "man ./") - (t "zcat * | tbl | nroff -man -h | col -b"))) - ;; Optional conversion to gzip format. - '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") - " " dired-guess-shell-znew-switches)) - '("\\.pod\\'" "perldoc" "pod2man * | nroff -man") - - '("\\.dvi\\'" "xdvi" "dvips") ; preview and printing - '("\\.au\\'" "play") ; play Sun audiofiles - '("\\.mpe?g\\'\\|\\.avi\\'" "xine -p") - '("\\.ogg\\'" "ogg123") - '("\\.mp3\\'" "mpg123") - '("\\.wav\\'" "play") - '("\\.uu\\'" "uudecode") ; for uudecoded files - '("\\.hqx\\'" "mcvert") - '("\\.sh\\'" "sh") ; execute shell scripts - '("\\.xbm\\'" "bitmap") ; view X11 bitmaps - '("\\.gp\\'" "gnuplot") - '("\\.p[bgpn]m\\'" "xloadimage") - '("\\.gif\\'" "xloadimage") ; view gif pictures - '("\\.tif\\'" "xloadimage") - '("\\.png\\'" "display") ; xloadimage 4.1 doesn't grok PNG - '("\\.jpe?g\\'" "xloadimage") - '("\\.fig\\'" "xfig") ; edit fig pictures - '("\\.out\\'" "xgraph") ; for plotting purposes. - '("\\.tex\\'" "latex" "tex") - '("\\.texi\\(nfo\\)?\\'" "makeinfo" "texi2dvi") - '("\\.pdf\\'" "xpdf") - '("\\.doc\\'" "antiword" "strings") - '("\\.rpm\\'" "rpm -qilp" "rpm -ivh") - '("\\.dia\\'" "dia") - '("\\.mgp\\'" "mgp") - - ;; Some other popular archivers. - (list "\\.zip\\'" "unzip" "unzip -l" - ;; Extract files into a separate subdirectory - '(concat "unzip" (if dired-guess-shell-gzip-quiet " -q") - " -d " (file-name-sans-extension file))) - '("\\.zoo\\'" "zoo x//") - '("\\.lzh\\'" "lharc x") - '("\\.arc\\'" "arc x") - '("\\.shar\\'" "unshar") - '("\\.rar\\'" "unrar x") - '("\\.7z\\'" "7z x") - - ;; Compression. - (list "\\.g?z\\'" '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) - (list "\\.dz\\'" "dictunzip") - (list "\\.bz2\\'" "bunzip2") - (list "\\.xz\\'" "unxz") - (list "\\.Z\\'" "uncompress" - ;; Optional conversion to gzip format. - '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") - " " dired-guess-shell-znew-switches)) - - '("\\.sign?\\'" "gpg --verify")) - - "Default alist used for shell command guessing. -See `dired-guess-shell-alist-user'.") - -(defcustom dired-guess-shell-alist-user nil - "User-defined alist of rules for suggested commands. -These rules take precedence over the predefined rules in the variable -`dired-guess-shell-alist-default' (to which they are prepended). - -Each element of this list looks like - - (REGEXP COMMAND...) - -COMMAND will be used if REGEXP matches the file to be processed. -If several files are to be processed, REGEXP has to match all the -files. - -Each COMMAND can either be a string or a Lisp expression that evaluates -to a string. If this expression needs to consult the name of the file for -which the shell commands are being requested, it can access that file name -as the variable `file'. - -If several COMMANDs are given, the first one will be the default -and the rest will be added temporarily to the history and can be retrieved -with `previous-history-element' (\\\\[previous-history-element]). - -The variable `dired-guess-shell-case-fold-search' controls whether -REGEXP is matched case-sensitively." - :group 'dired-x - :type '(alist :key-type regexp :value-type (repeat sexp))) - -(defcustom dired-guess-shell-case-fold-search t - "If non-nil, `dired-guess-shell-alist-default' and -`dired-guess-shell-alist-user' are matched case-insensitively." - :group 'dired-x - :type 'boolean) - -(defun dired-guess-default (files) - "Return a shell command, or a list of commands, appropriate for FILES. -See `dired-guess-shell-alist-user'." - (let* ((case-fold-search dired-guess-shell-case-fold-search) - (programs - (delete-dups - (mapcar - (lambda (command) - (eval command `((file . ,(car files))))) - (seq-reduce - #'append - (mapcar #'cdr - (seq-filter (lambda (elem) - (seq-every-p - (lambda (file) - (string-match-p (car elem) file)) - files)) - (append dired-guess-shell-alist-user - dired-guess-shell-alist-default))) - nil))))) - (if (length= programs 1) - (car programs) - programs))) - -(defun dired-guess-shell-command (prompt files) - "Ask user with PROMPT for a shell command, guessing a default from FILES." - (let ((default (dired-guess-default files)) - default-list val) - (if (null default) - ;; Nothing to guess - (read-shell-command prompt nil 'dired-shell-command-history) - (setq prompt (replace-regexp-in-string ": $" " " prompt)) - (if (listp default) - ;; More than one guess - (setq default-list default - default (car default) - prompt (concat - prompt - (format "{%d guesses} " (length default-list)))) - ;; Just one guess - (setq default-list (list default))) - ;; Put the first guess in the prompt but not in the initial value. - (setq prompt (concat prompt (format "[%s]: " default))) - ;; All guesses can be retrieved with M-n - (setq val (read-shell-command prompt nil - 'dired-shell-command-history - default-list)) - ;; If we got a return, then return default. - (if (equal val "") default val)))) - ;;; Visit all marked files simultaneously diff --git a/lisp/dired.el b/lisp/dired.el index 10813e56df..799a9f4716 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -53,6 +53,11 @@ :prefix "dired-" :group 'dired) +(defgroup dired-guess nil + "Guess shell command in Dired." + :prefix "dired-" + :group 'dired) + ;;;###autoload (defcustom dired-listing-switches (purecopy "-al") "Switches passed to `ls' for Dired. MUST contain the `l' option. @@ -419,6 +424,72 @@ is anywhere on its Dired line, except the beginning of the line." :type 'boolean :version "28.1") +(defcustom dired-guess-shell-case-fold-search t + "If non-nil, `dired-guess-shell-alist-default' and +`dired-guess-shell-alist-user' are matched case-insensitively." + :group 'dired-guess + :type 'boolean + :version "29.1") + +(defcustom dired-guess-shell-alist-user nil + "User-defined alist of rules for suggested commands. +These rules take precedence over the predefined rules in the variable +`dired-guess-shell-alist-default' (to which they are prepended). + +Each element of this list looks like + + (REGEXP COMMAND...) + +COMMAND will be used if REGEXP matches the file to be processed. +If several files are to be processed, REGEXP has to match all the +files. + +Each COMMAND can either be a string or a Lisp expression that evaluates +to a string. If this expression needs to consult the name of the file for +which the shell commands are being requested, it can access that file name +as the variable `file'. + +If several COMMANDs are given, the first one will be the default +and the rest will be added temporarily to the history and can be retrieved +with `previous-history-element' (\\\\[previous-history-element]). + +The variable `dired-guess-shell-case-fold-search' controls whether +REGEXP is matched case-sensitively." + :group 'dired-guess + :type '(alist :key-type regexp :value-type (repeat sexp)) + :version "29.1") + +(defcustom dired-guess-shell-gnutar + (catch 'found + (dolist (exe '("tar" "gtar")) + (if (with-temp-buffer + (ignore-errors (call-process exe nil t nil "--version")) + (and (re-search-backward "GNU tar" nil t) t)) + (throw 'found exe)))) + "If non-nil, name of GNU tar executable. +\(E.g., \"tar\" or \"gtar\"). The `z' switch will be used with it for +compressed or gzip'ed tar files. If you don't have GNU tar, set this +to nil: a pipe using `zcat' or `gunzip -c' will be used." + ;; Changed from system-type test to testing --version output. + ;; Maybe test --help for -z instead? + :group 'dired-guess + :type '(choice (const :tag "Not GNU tar" nil) + (string :tag "Command name")) + :version "29.1") + +(defcustom dired-guess-shell-gzip-quiet t + "Non-nil says pass -q to gzip overriding verbose GZIP environment." + :group 'dired-guess + :type 'boolean + :version "29.1") + +(defcustom dired-guess-shell-znew-switches nil + "If non-nil, then string of switches passed to `znew', example: \"-K\"." + :group 'dired-guess + :type '(choice (const :tag "None" nil) + (string :tag "Switches")) + :version "29.1") + ;;; Internal variables diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 694deaae4c..e70898ab74 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -154,5 +154,18 @@ (should (string-match (regexp-quote command) (nth 0 lines))) (dired-test--check-highlighting (nth 0 lines) '(8)))) +(ert-deftest dired-guess-default () + (let ((dired-guess-shell-alist-user nil) + (dired-guess-shell-alist-default + '(("\\.png\\'" "display") + ("\\.gif\\'" "display" "xloadimage") + ("\\.gif\\'" "feh") + ("\\.jpe?g\\'" "xloadimage")))) + (should (equal (dired-guess-default '("/tmp/foo.png")) "display")) + (should (equal (dired-guess-default '("/tmp/foo.gif")) + '("display" "xloadimage" "feh"))) + (should (equal (dired-guess-default '("/tmp/foo.png" "/tmp/foo.txt")) + nil)))) + (provide 'dired-aux-tests) ;;; dired-aux-tests.el ends here diff --git a/test/lisp/dired-x-tests.el b/test/lisp/dired-x-tests.el index cec266b0ef..7acaa3c131 100644 --- a/test/lisp/dired-x-tests.el +++ b/test/lisp/dired-x-tests.el @@ -47,19 +47,6 @@ (should (equal all-but-c (sort (dired-get-marked-files 'local) #'string<)))))) -(ert-deftest dired-guess-default () - (let ((dired-guess-shell-alist-user nil) - (dired-guess-shell-alist-default - '(("\\.png\\'" "display") - ("\\.gif\\'" "display" "xloadimage") - ("\\.gif\\'" "feh") - ("\\.jpe?g\\'" "xloadimage")))) - (should (equal (dired-guess-default '("/tmp/foo.png")) "display")) - (should (equal (dired-guess-default '("/tmp/foo.gif")) - '("display" "xloadimage" "feh"))) - (should (equal (dired-guess-default '("/tmp/foo.png" "/tmp/foo.txt")) - nil)))) - (ert-deftest dired-x--string-to-number () (should (= (dired-x--string-to-number "2.4K") 2457.6)) (should (= (dired-x--string-to-number "2400") 2400)) commit d214dd67cd5910c4c9ecefdf879886c4d01b0c27 Author: Stefan Kangas Date: Wed Aug 17 16:09:31 2022 +0200 Make compat function cperl-putback-char obsolete * lisp/progmodes/cperl-mode.el (cperl-putback-char): Make obsolete. Update callers. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index c0487f066a..2a7bbf0105 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -878,8 +878,9 @@ In regular expressions (including character classes): (and (vectorp cperl-del-back-ch) (= (length cperl-del-back-ch) 1) (setq cperl-del-back-ch (aref cperl-del-back-ch 0))) -(defun cperl-putback-char (c) ; Emacs 19 - (push c unread-command-events)) ; Avoid undefined warning +(defun cperl-putback-char (c) + (declare (obsolete nil "29.1")) + (push c unread-command-events)) (defsubst cperl-put-do-not-fontify (from to &optional post) ;; If POST, do not do it with postponed fontification @@ -2143,7 +2144,7 @@ to nil." (delete-char -1) (delete-char 1)))) (if delete - (cperl-putback-char cperl-del-back-ch)) + (push cperl-del-back-ch unread-command-events)) (if cperl-message-electric-keyword (message "Precede char by C-q to avoid expansion")))))) @@ -2217,7 +2218,7 @@ to nil." (end-of-line) (setq really-delete t))) (if (and delete really-delete) - (cperl-putback-char cperl-del-back-ch)))))) + (push cperl-del-back-ch unread-command-events)))))) (defun cperl-electric-else () "Insert a construction appropriate after a keyword. @@ -2254,7 +2255,7 @@ to nil." (cperl-indent-line) (forward-line -1) (cperl-indent-line) - (cperl-putback-char cperl-del-back-ch) + (push cperl-del-back-ch unread-command-events) (setq this-command 'cperl-electric-else) (if cperl-message-electric-keyword (message "Precede char by C-q to avoid expansion")))))) commit 8d4fe8356cc881d5d842589c789ca8c7c642a8ca Author: Stefan Kangas Date: Wed Aug 17 15:56:13 2022 +0200 * lisp/progmodes/cperl-mode.el: Improve commentary. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 8bf1165deb..c0487f066a 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -28,21 +28,14 @@ ;;; Commentary: -;; This version of the file contains support for the syntax added by -;; the MooseX::Declare CPAN module, as well as Perl 5.10 keyword -;; support. - ;; You can either fine-tune the bells and whistles of this mode or -;; bulk enable them by putting - -;; (setq cperl-hairy t) +;; bulk enable them by putting this in your Init file: -;; in your .emacs file. (Emacs rulers do not consider it politically -;; correct to make whistles enabled by default.) +;; (setq cperl-hairy t) ;; DO NOT FORGET to read micro-docs (available from `Perl' menu) <<<<<< -;; or as help on variables `cperl-tips', `cperl-problems', <<<<<< -;; `cperl-praise', `cperl-speed'. <<<<<< +;; or as help on variables `cperl-tips', `cperl-praise', <<<<<< +;; `cperl-speed'. <<<<<< ;; ;; Or search for "Short extra-docs" further down in this file for ;; details on how to use `cperl-mode' instead of `perl-mode' and lots @@ -50,19 +43,18 @@ ;; The mode information (on C-h m) provides some customization help. -;; Faces used now: three faces for first-class and second-class keywords +;; Faces used: three faces for first-class and second-class keywords ;; and control flow words, one for each: comments, string, labels, ;; functions definitions and packages, arrays, hashes, and variable -;; definitions. If you do not see all these faces, your font-lock does -;; not define them, so you need to define them manually. +;; definitions. -;; This mode supports font-lock, imenu and mode-compile. In the -;; hairy version font-lock is on, but you should activate imenu -;; yourself (note that mode-compile is not standard yet). Well, you -;; can use imenu from keyboard anyway (M-g i), but it is better -;; to bind it like that: +;; This mode supports imenu. You can use imenu from the keyboard +;; (M-g i), but you might prefer binding it like this: +;; +;; (define-key global-map [M-S-down-mouse-3] #'imenu) -;; (define-key global-map [M-S-down-mouse-3] 'imenu) +;; This version supports the syntax added by the MooseX::Declare CPAN +;; module, as well as Perl 5.10 keyword support. ;;; Code: commit 6ad79488c94406213035250be706a37a85e35f27 Author: Stefan Kangas Date: Wed Aug 17 15:50:20 2022 +0200 ; Delete code in cperl-mode.el commented out since 1997 * lisp/progmodes/cperl-mode.el (cperl-menu): Delete some code commented out since 1997. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 6e39855527..8bf1165deb 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1,6 +1,6 @@ ;;; cperl-mode.el --- Perl code editing commands for Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1985-1987, 1991-2022 Free Software Foundation, Inc. +;; Copyright (C) 1985-2022 Free Software Foundation, Inc. ;; Author: Ilya Zakharevich ;; Bob Olson @@ -1131,15 +1131,6 @@ Unless KEEP, removes the old indentation." ["Class Hierarchy from TAGS" cperl-tags-hier-init t] ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] ("Tags" - ;; ["Create tags for current file" cperl-etags t] - ;; ["Add tags for current file" (cperl-etags t) t] - ;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] - ;; ["Add tags for Perl files in directory" (cperl-etags t t) t] - ;; ["Create tags for Perl files in (sub)directories" - ;; (cperl-etags nil 'recursive) t] - ;; ["Add tags for Perl files in (sub)directories" - ;; (cperl-etags t 'recursive) t]) - ;; ;;? cperl-write-tags (&optional file erase recurse dir inbuffer) ["Create tags for current file" (cperl-write-tags nil t) t] ["Add tags for current file" (cperl-write-tags) t] ["Create tags for Perl files in directory" @@ -1889,25 +1880,6 @@ or as help on variables `cperl-tips', `cperl-problems', (cperl-make-indent comment-column 1) ; Indent min 1 c))))) -;;(defun cperl-comment-indent-fallback () -;; "Is called if the standard comment-search procedure fails. -;;Point is at start of real comment." -;; (let ((c (current-column)) target cnt prevc) -;; (if (= c comment-column) nil -;; (setq cnt (skip-chars-backward " \t")) -;; (setq target (max (1+ (setq prevc -;; (current-column))) ; Else indent at comment column -;; comment-column)) -;; (if (= c comment-column) nil -;; (delete-backward-char cnt) -;; (while (< prevc target) -;; (insert "\t") -;; (setq prevc (current-column))) -;; (if (> prevc target) (progn (delete-char -1) (setq prevc (current-column)))) -;; (while (< prevc target) -;; (insert " ") -;; (setq prevc (current-column))))))) - (defun cperl-indent-for-comment () "Substitute for `indent-for-comment' in CPerl." (interactive) @@ -7157,13 +7129,6 @@ One may build such TAGS files from CPerl mode menu." (sort root-packages (default-value 'imenu-sort-function))) root-packages)))) -;;(x-popup-menu t -;; '(keymap "Name1" -;; ("Ret1" "aa") -;; ("Head1" "ab" -;; keymap "Name2" -;; ("Tail1" "x") ("Tail2" "y")))) - (defun cperl-list-fold (list name limit) (let (list1 list2 elt1 (num 0)) (if (<= (length list) limit) list commit 1288955d50440d9d03abdea227b84a49b10cd336 Author: Stefan Kangas Date: Wed Aug 17 15:47:13 2022 +0200 Don't check if autoloaded functions are fboundp * lisp/progmodes/cperl-mode.el (cperl-menu, cperl-init-faces): Assume some autoloaded ps-print.el functions are always there. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 91c00ad048..6e39855527 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1118,8 +1118,7 @@ Unless KEEP, removes the old indentation." (get-text-property (point) 'syntax-type)) '(here-doc pod))] "----" - ["CPerl pretty print (experimental)" cperl-ps-print - (fboundp 'ps-extend-face-list)] + ["CPerl pretty print (experimental)" cperl-ps-print] "----" ["Syntaxify region" cperl-find-pods-heres-region (use-region-p)] @@ -1153,6 +1152,8 @@ Unless KEEP, removes the old indentation." (cperl-write-tags nil nil t t) t])) ("Perl docs" ["Define word at point" imenu-go-find-at-position + ;; This is from imenu-go.el. I can't find it on any ELPA + ;; archive, so I'm not sure if it's still in use or not. (fboundp 'imenu-go-find-at-position)] ["Help on function" cperl-info-on-command t] ["Help on function at point" cperl-info-on-current-command t] @@ -6030,7 +6031,7 @@ default function." cperl-font-lock-keywords-2 (append t-font-lock-keywords-1 cperl-font-lock-keywords-1))) - (if (fboundp 'ps-print-buffer) (cperl-ps-print-init)) + (cperl-ps-print-init) (setq cperl-faces-init t)) (error (message "cperl-init-faces (ignored): %s" errs)))) commit deddd56e3521aa2544575a8b10ffb4c99ee3be74 Author: Brendan O'Dea Date: Wed Aug 17 13:20:15 2022 +0200 em-unix.el: only pass -H option to grep * lisp/eshell/em-unix.el (eshell-grep): Don't add -H, because that breaks agrep/glimpse etc (bug#57247). (eshell/grep, eshell/egrep, eshell/fgrep): Instead add it here. diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 68276b22d9..40b83010f9 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -755,26 +755,21 @@ external command." (eshell-stringify-list (flatten-tree args))) " ")) - (cmd (format "%s -nH %s" - (pcase command - ("egrep" "grep -E") - ("fgrep" "grep -F") - (x x)) - args)) + (cmd (format "%s -n %s" command args)) compilation-scroll-output) (grep cmd))))) (defun eshell/grep (&rest args) "Use Emacs grep facility instead of calling external grep." - (eshell-grep "grep" args t)) + (eshell-grep "grep" (append '("-H") args) t)) (defun eshell/egrep (&rest args) "Use Emacs grep facility instead of calling external grep -E." - (eshell-grep "egrep" args t)) + (eshell-grep "grep" (append '("-EH") args) t)) (defun eshell/fgrep (&rest args) "Use Emacs grep facility instead of calling external grep -F." - (eshell-grep "fgrep" args t)) + (eshell-grep "grep" (append '("-FH") args) t)) (defun eshell/agrep (&rest args) "Use Emacs grep facility instead of calling external agrep." commit 4915ca5dd4245a909c046e6691e8d4a1919890c8 Author: kobarity Date: Wed Aug 17 13:10:16 2022 +0200 Enhance Python font-lock to support multilines * test/lisp/progmodes/python-tests.el (python-tests-assert-faces-after-change): New helper function. (python-font-lock-keywords-level-1-3) (python-font-lock-assignment-statement-multiline-*): New tests. * lisp/progmodes/python.el (python-rx): Add `sp-nl' to represent space or newline (with/without backslash). (python-font-lock-keywords-level-1) (python-font-lock-keywords-maximum-decoration): Allow newlines where appropriate. (python-font-lock-extend-region): New function. (python-mode): Set `python-font-lock-extend-region' to `font-lock-extend-after-change-region-function'. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 44df3186b2..e135039199 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -359,6 +359,7 @@ "Python mode specialized rx macro. This variant of `rx' supports common Python named REGEXPS." `(rx-let ((sp-bsnl (or space (and ?\\ ?\n))) + (sp-nl (or space (and (? ?\\) ?\n))) (block-start (seq symbol-start (or "def" "class" "if" "elif" "else" "try" "except" "finally" "for" "while" "with" @@ -583,9 +584,9 @@ the {...} holes that appear within f-strings." finally return (and result-valid result)))) (defvar python-font-lock-keywords-level-1 - `((,(python-rx symbol-start "def" (1+ space) (group symbol-name)) + `((,(python-rx symbol-start "def" (1+ sp-bsnl) (group symbol-name)) (1 font-lock-function-name-face)) - (,(python-rx symbol-start "class" (1+ space) (group symbol-name)) + (,(python-rx symbol-start "class" (1+ sp-bsnl) (group symbol-name)) (1 font-lock-type-face))) "Font lock keywords to use in `python-mode' for level 1 decoration. @@ -725,12 +726,12 @@ sign in chained assignment." ;; [*a] = 5, 6 ;; are handled separately below (,(python-font-lock-assignment-matcher - (python-rx (? (or "[" "(") (* space)) - grouped-assignment-target (* space) ?, (* space) - (* assignment-target (* space) ?, (* space)) - (? assignment-target (* space)) - (? ?, (* space)) - (? (or ")" "]") (* space)) + (python-rx (? (or "[" "(") (* sp-nl)) + grouped-assignment-target (* sp-nl) ?, (* sp-nl) + (* assignment-target (* sp-nl) ?, (* sp-nl)) + (? assignment-target (* sp-nl)) + (? ?, (* sp-nl)) + (? (or ")" "]") (* sp-bsnl)) (group assignment-operator))) (1 font-lock-variable-name-face) (,(python-rx grouped-assignment-target) @@ -745,19 +746,20 @@ sign in chained assignment." ;; c: Collection = {1, 2, 3} ;; d: Mapping[int, str] = {1: 'bar', 2: 'baz'} (,(python-font-lock-assignment-matcher - (python-rx grouped-assignment-target (* space) - (? ?: (* space) (+ not-simple-operator) (* space)) - assignment-operator)) + (python-rx (or line-start ?\;) (* sp-bsnl) + grouped-assignment-target (* sp-bsnl) + (? ?: (* sp-bsnl) (+ not-simple-operator) (* sp-bsnl)) + assignment-operator)) (1 font-lock-variable-name-face)) ;; special cases ;; (a) = 5 ;; [a] = 5, ;; [*a] = 5, 6 (,(python-font-lock-assignment-matcher - (python-rx (or line-start ?\; ?=) (* space) - (or "[" "(") (* space) - grouped-assignment-target (* space) - (or ")" "]") (* space) + (python-rx (or line-start ?\; ?=) (* sp-bsnl) + (or "[" "(") (* sp-nl) + grouped-assignment-target (* sp-nl) + (or ")" "]") (* sp-bsnl) assignment-operator)) (1 font-lock-variable-name-face)) ;; escape sequences within bytes literals @@ -796,6 +798,18 @@ decorators, exceptions, and assignments.") Which one will be chosen depends on the value of `font-lock-maximum-decoration'.") +(defun python-font-lock-extend-region (beg end _old-len) + "Extend font-lock region given by BEG and END to statement boundaries." + (save-excursion + (save-match-data + (goto-char beg) + (python-nav-beginning-of-statement) + (setq beg (point)) + (goto-char end) + (python-nav-end-of-statement) + (setq end (point)) + (cons beg end)))) + (defconst python-syntax-propertize-function (syntax-propertize-rules @@ -5780,7 +5794,9 @@ REPORT-FN is Flymake's callback function." `(,python-font-lock-keywords nil nil nil nil (font-lock-syntactic-face-function - . python-font-lock-syntactic-face-function))) + . python-font-lock-syntactic-face-function) + (font-lock-extend-after-change-region-function + . python-font-lock-extend-region))) (setq-local syntax-propertize-function python-syntax-propertize-function) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 9e8fa7f552..875c92573e 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -108,6 +108,20 @@ STRING, it is skipped so the next STRING occurrence is selected." while pos collect (cons pos (get-text-property pos 'face)))) +(defun python-tests-assert-faces-after-change (content faces search replace) + "Assert that font faces for CONTENT are equal to FACES after change. +All occurrences of SEARCH are changed to REPLACE." + (python-tests-with-temp-buffer + content + ;; Force enable font-lock mode without jit-lock. + (rename-buffer "*python-font-lock-test*" t) + (let (noninteractive font-lock-support-mode) + (font-lock-mode)) + (while + (re-search-forward search nil t) + (replace-match replace)) + (should (equal faces (python-tests-get-buffer-faces))))) + (defun python-tests-self-insert (char-or-str) "Call `self-insert-command' for chars in CHAR-OR-STR." (let ((chars @@ -226,6 +240,13 @@ aliqua." "def 1func():" '((1 . font-lock-keyword-face) (4)))) +(ert-deftest python-font-lock-keywords-level-1-3 () + (python-tests-assert-faces + "def \\ + func():" + '((1 . font-lock-keyword-face) (4) + (15 . font-lock-function-name-face) (19)))) + (ert-deftest python-font-lock-assignment-statement-1 () (python-tests-assert-faces "a, b, c = 1, 2, 3" @@ -380,6 +401,98 @@ def f(x: CustomInt) -> CustomInt: (128 . font-lock-builtin-face) (131) (144 . font-lock-keyword-face) (150)))) +(ert-deftest python-font-lock-assignment-statement-multiline-1 () + (python-tests-assert-faces-after-change + " +[ + a, + b +] # ( + 1, + 2 +) +" + '((1) + (8 . font-lock-variable-name-face) (9) + (15 . font-lock-variable-name-face) (16)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-2 () + (python-tests-assert-faces-after-change + " +[ + *a +] # 5, 6 +" + '((1) + (9 . font-lock-variable-name-face) (10)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-3 () + (python-tests-assert-faces-after-change + "a\\ + ,\\ + b\\ + ,\\ + c\\ + #\\ + 1\\ + ,\\ + 2\\ + ,\\ + 3" + '((1 . font-lock-variable-name-face) (2) + (15 . font-lock-variable-name-face) (16) + (29 . font-lock-variable-name-face) (30)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-4 () + (python-tests-assert-faces-after-change + "a\\ + :\\ + int\\ + #\\ + 5" + '((1 . font-lock-variable-name-face) (2) + (15 . font-lock-builtin-face) (18)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-5 () + (python-tests-assert-faces-after-change + "(\\ + a\\ +)\\ + #\\ + 5\\ + ;\\ + (\\ + b\\ + )\\ + #\\ + 6" + '((1) + (8 . font-lock-variable-name-face) (9) + (46 . font-lock-variable-name-face) (47)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-6 () + (python-tests-assert-faces-after-change + "( + a +)\\ + #\\ + 5\\ + ;\\ + ( + b + )\\ + #\\ + 6" + '((1) + (7 . font-lock-variable-name-face) (8) + (43 . font-lock-variable-name-face) (44)) + "#" "=")) + (ert-deftest python-font-lock-escape-sequence-string-newline () (python-tests-assert-faces "'\\n' commit 31e32212670f5774a6dbc0debac8854fa01d8f92 Author: Lars Ingebrigtsen Date: Wed Aug 17 13:09:21 2022 +0200 Revert "Add Python blocks support for hideshow" This reverts commit af4cfb519415ed3c1d6d036aac908e4f9ee383eb. This led to test failures. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index afcfe1af53..44df3186b2 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1504,10 +1504,6 @@ marks the next defun after the ones already marked." The name of the defun should be grouped so it can be retrieved via `match-string'.") -(defvar python-nav-beginning-of-block-regexp - (python-rx line-start (* space) block-start) - "Regexp matching block start.") - (defun python-nav--beginning-of-defun (&optional arg) "Internal implementation of `python-nav-beginning-of-defun'. With positive ARG search backwards, else search forwards." @@ -4891,36 +4887,9 @@ Interactively, prompt for symbol." (defun python-hideshow-forward-sexp-function (_arg) "Python specific `forward-sexp' function for `hs-minor-mode'. Argument ARG is ignored." - (python-nav-end-of-block)) - -(defun python-hideshow-find-next-block (regexp maxp comments) - "Python specific `hs-find-next-block' function for `hs-minor-mode'. -Call `python-nav-forward-block' to find next block and check if -block-start ends within MAXP. If COMMENTS is not nil, comments -are also searched. REGEXP is passed to `looking-at' to set -`match-data'." - (let* ((next-block - (save-excursion - (or (and - (python-info-looking-at-beginning-of-block) - (re-search-forward (python-rx block-start) maxp t)) - (and (python-nav-forward-block) - (< (point) maxp) - (re-search-forward (python-rx block-start) maxp t)) - (1+ maxp)))) - (next-comment - (or (when comments - (save-excursion - (cl-loop while (re-search-forward "#" maxp t) - if (python-syntax-context 'comment) - return (point)))) - (1+ maxp))) - (next-block-or-comment (min next-block next-comment))) - (when (<= next-block-or-comment maxp) - (goto-char next-block-or-comment) - (save-excursion - (beginning-of-line) - (looking-at regexp))))) + (python-nav-end-of-defun) + (unless (python-info-current-line-empty-p) + (backward-char))) ;;; Imenu @@ -5417,19 +5386,6 @@ instead of the current physical line." (beginning-of-line 1) (looking-at python-nav-beginning-of-defun-regexp)))) -(defun python-info-looking-at-beginning-of-block () - "Check if point is at the beginning of block." - (let* ((line-beg-pos (line-beginning-position)) - (line-content-start (+ line-beg-pos (current-indentation))) - (block-beg-pos (save-excursion - (python-nav-beginning-of-block)))) - (and block-beg-pos - (= block-beg-pos line-content-start) - (<= (point) line-content-start) - (save-excursion - (beginning-of-line) - (looking-at python-nav-beginning-of-block-regexp))))) - (defun python-info-current-line-comment-p () "Return non-nil if current line is a comment line." (char-equal @@ -5879,17 +5835,14 @@ REPORT-FN is Flymake's callback function." (add-to-list 'hs-special-modes-alist - `(python-mode - ,python-nav-beginning-of-block-regexp + '(python-mode + "\\s-*\\_<\\(?:def\\|class\\)\\_>" ;; Use the empty string as end regexp so it doesn't default to ;; "\\s)". This way parens at end of defun are properly hidden. "" "#" python-hideshow-forward-sexp-function - nil - python-nav-beginning-of-block - python-hideshow-find-next-block - python-info-looking-at-beginning-of-block)) + nil)) (setq-local outline-regexp (python-rx (* space) block-start)) (setq-local outline-heading-end-regexp ":[^\n]*\n") diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 608ce548e7..9e8fa7f552 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -5598,39 +5598,6 @@ def \\ (should (not (python-info-looking-at-beginning-of-defun))) (should (not (python-info-looking-at-beginning-of-defun nil t))))) -(ert-deftest python-info-looking-at-beginning-of-block-1 () - (python-tests-with-temp-buffer - " -def f(): - if True: - pass - l = [x * 2 - for x in range(5) - if x < 3] -# if False: -\"\"\" -if 0: -\"\"\" -" - (python-tests-look-at "def f():") - (should (python-info-looking-at-beginning-of-block)) - (forward-char) - (should (not (python-info-looking-at-beginning-of-block))) - (python-tests-look-at "if True:") - (should (python-info-looking-at-beginning-of-block)) - (forward-char) - (should (not (python-info-looking-at-beginning-of-block))) - (beginning-of-line) - (should (python-info-looking-at-beginning-of-block)) - (python-tests-look-at "for x") - (should (not (python-info-looking-at-beginning-of-block))) - (python-tests-look-at "if x < 3") - (should (not (python-info-looking-at-beginning-of-block))) - (python-tests-look-at "if False:") - (should (not (python-info-looking-at-beginning-of-block))) - (python-tests-look-at "if 0:") - (should (not (python-info-looking-at-beginning-of-block))))) - (ert-deftest python-info-current-line-comment-p-1 () (python-tests-with-temp-buffer " @@ -6084,11 +6051,8 @@ class SomeClass: class SomeClass: def __init__(self, arg, kwarg=1): - def filter(self, nums): - - def __str__(self): -")))) + def __str__(self):")))) (or enabled (hs-minor-mode -1))))) (ert-deftest python-hideshow-hide-levels-2 () @@ -6134,165 +6098,6 @@ class SomeClass: ")))) (or enabled (hs-minor-mode -1))))) -(ert-deftest python-hideshow-hide-levels-3 () - "Should hide all blocks." - (python-tests-with-temp-buffer - " -def f(): - if 0: - l = [i for i in range(5) - if i < 3] - abc = o.match(1, 2, 3) - -def g(): - pass -" - (hs-minor-mode 1) - (hs-hide-level 1) - (should - (string= - (python-tests-visible-string) - " -def f(): - -def g(): -")))) - -(ert-deftest python-hideshow-hide-levels-4 () - "Should hide 2nd level block." - (python-tests-with-temp-buffer - " -def f(): - if 0: - l = [i for i in range(5) - if i < 3] - abc = o.match(1, 2, 3) - -def g(): - pass -" - (hs-minor-mode 1) - (hs-hide-level 2) - (should - (string= - (python-tests-visible-string) - " -def f(): - if 0: - -def g(): - pass -")))) - -(ert-deftest python-hideshow-hide-all-1 () - "Should hide all blocks." - (python-tests-with-temp-buffer - "if 0: - - aaa - l = [i for i in range(5) - if i < 3] - ccc - abc = o.match(1, 2, 3) - ddd - -def f(): - pass -" - (hs-minor-mode 1) - (hs-hide-all) - (should - (string= - (python-tests-visible-string) - "if 0: - -def f(): -")))) - -(ert-deftest python-hideshow-hide-all-2 () - "Should hide comments." - (python-tests-with-temp-buffer - " -# Multi line -# comment - -\"\"\" -# Multi line -# string -\"\"\" -" - (hs-minor-mode 1) - (hs-hide-all) - (should - (string= - (python-tests-visible-string) - " -# Multi line - -\"\"\" -# Multi line -# string -\"\"\" -")))) - -(ert-deftest python-hideshow-hide-all-3 () - "Should not hide comments when `hs-hide-comments-when-hiding-all' is nil." - (python-tests-with-temp-buffer - " -# Multi line -# comment - -\"\"\" -# Multi line -# string -\"\"\" -" - (hs-minor-mode 1) - (let ((hs-hide-comments-when-hiding-all nil)) - (hs-hide-all)) - (should - (string= - (python-tests-visible-string) - " -# Multi line -# comment - -\"\"\" -# Multi line -# string -\"\"\" -")))) - -(ert-deftest python-hideshow-hide-block-1 () - "Should hide current block." - (python-tests-with-temp-buffer - " -if 0: - - aaa - l = [i for i in range(5) - if i < 3] - ccc - abc = o.match(1, 2, 3) - ddd - -def f(): - pass -" - (hs-minor-mode 1) - (python-tests-look-at "ddd") - (forward-line) - (hs-hide-block) - (should - (string= - (python-tests-visible-string) - " -if 0: - -def f(): - pass -")))) - (ert-deftest python-tests--python-nav-end-of-statement--infloop () "Checks that `python-nav-end-of-statement' doesn't infloop in a commit a631067fba54e873122d40106fec4dacd8eba8db Author: Stefan Kangas Date: Wed Aug 17 12:48:02 2022 +0200 Fix some recently introduced byte-compiler warnings * lisp/emulation/viper-util.el (viper-key-to-character): * lisp/vc/vc-svn.el (vc-svn-dir-extra-headers): Fix warnings. * lisp/net/eudc-export.el (eudc-batch-export-records-to-bbdb): Fix buglet. diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 25c55acf96..46dbd7f24d 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -1020,7 +1020,6 @@ Otherwise return the normal value." (string-to-char (symbol-name key))) ((and (listp key) (eq (car key) 'control) - (symbol-name (nth 1 key)) (= 1 (length (symbol-name (nth 1 key))))) (read (format "?\\C-%s" (symbol-name (nth 1 key))))) (t key))) diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index 3f7d9c0060..2f841336e0 100644 --- a/lisp/net/eudc-export.el +++ b/lisp/net/eudc-export.el @@ -210,7 +210,7 @@ LOCATION is used as the phone location for BBDB." (while (eudc-move-to-next-record) (and (overlays-at (point)) (setq record (overlay-get (car (overlays-at (point))) 'eudc-record)) - (1+ nbrec) + (setq nbrec (1+ nbrec)) (eudc-create-bbdb-record record t))) (message "%d records imported into BBDB" nbrec))) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 270877041a..08b53a7169 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -224,12 +224,10 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (let (process-file-side-effects) (vc-svn-command "*vc*" 0 nil "info")) (let ((repo - (save-excursion - (and (progn - (set-buffer "*vc*") - (goto-char (point-min)) - (re-search-forward "Repository Root: *\\(.*\\)" nil t)) - (match-string 1))))) + (with-current-buffer "*vc*" + (goto-char (point-min)) + (when (re-search-forward "Repository Root: *\\(.*\\)" nil t) + (match-string 1))))) (concat (cond (repo (concat commit af4cfb519415ed3c1d6d036aac908e4f9ee383eb Author: kobarity Date: Wed Aug 17 12:44:56 2022 +0200 Add Python blocks support for hideshow * lisp/progmodes/python.el (python-nav-beginning-of-block-regexp): New variable. (python-hideshow-forward-sexp-function): Change to call `python-nav-end-of-block'. (python-hideshow-find-next-block): New function to be used as FIND-NEXT-BLOCK-FUNC in `hs-special-modes-alist'. (python-info-looking-at-beginning-of-block): New function to be used as LOOKING-AT-BLOCK-START-P-FUNC in `hs-special-modes-alist'. (python-mode): Change settings of `hs-special-modes-alist'. * test/lisp/progmodes/python-tests.el (python-hideshow-hide-levels-1): Fix to keep empty lines. (python-info-looking-at-beginning-of-block-1) (python-hideshow-hide-levels-3, python-hideshow-hide-levels-4) (python-hideshow-hide-all-1, python-hideshow-hide-all-2) (python-hideshow-hide-all-3, python-hideshow-hide-block-1): New tests (bug#56635). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 44df3186b2..afcfe1af53 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1504,6 +1504,10 @@ marks the next defun after the ones already marked." The name of the defun should be grouped so it can be retrieved via `match-string'.") +(defvar python-nav-beginning-of-block-regexp + (python-rx line-start (* space) block-start) + "Regexp matching block start.") + (defun python-nav--beginning-of-defun (&optional arg) "Internal implementation of `python-nav-beginning-of-defun'. With positive ARG search backwards, else search forwards." @@ -4887,9 +4891,36 @@ Interactively, prompt for symbol." (defun python-hideshow-forward-sexp-function (_arg) "Python specific `forward-sexp' function for `hs-minor-mode'. Argument ARG is ignored." - (python-nav-end-of-defun) - (unless (python-info-current-line-empty-p) - (backward-char))) + (python-nav-end-of-block)) + +(defun python-hideshow-find-next-block (regexp maxp comments) + "Python specific `hs-find-next-block' function for `hs-minor-mode'. +Call `python-nav-forward-block' to find next block and check if +block-start ends within MAXP. If COMMENTS is not nil, comments +are also searched. REGEXP is passed to `looking-at' to set +`match-data'." + (let* ((next-block + (save-excursion + (or (and + (python-info-looking-at-beginning-of-block) + (re-search-forward (python-rx block-start) maxp t)) + (and (python-nav-forward-block) + (< (point) maxp) + (re-search-forward (python-rx block-start) maxp t)) + (1+ maxp)))) + (next-comment + (or (when comments + (save-excursion + (cl-loop while (re-search-forward "#" maxp t) + if (python-syntax-context 'comment) + return (point)))) + (1+ maxp))) + (next-block-or-comment (min next-block next-comment))) + (when (<= next-block-or-comment maxp) + (goto-char next-block-or-comment) + (save-excursion + (beginning-of-line) + (looking-at regexp))))) ;;; Imenu @@ -5386,6 +5417,19 @@ instead of the current physical line." (beginning-of-line 1) (looking-at python-nav-beginning-of-defun-regexp)))) +(defun python-info-looking-at-beginning-of-block () + "Check if point is at the beginning of block." + (let* ((line-beg-pos (line-beginning-position)) + (line-content-start (+ line-beg-pos (current-indentation))) + (block-beg-pos (save-excursion + (python-nav-beginning-of-block)))) + (and block-beg-pos + (= block-beg-pos line-content-start) + (<= (point) line-content-start) + (save-excursion + (beginning-of-line) + (looking-at python-nav-beginning-of-block-regexp))))) + (defun python-info-current-line-comment-p () "Return non-nil if current line is a comment line." (char-equal @@ -5835,14 +5879,17 @@ REPORT-FN is Flymake's callback function." (add-to-list 'hs-special-modes-alist - '(python-mode - "\\s-*\\_<\\(?:def\\|class\\)\\_>" + `(python-mode + ,python-nav-beginning-of-block-regexp ;; Use the empty string as end regexp so it doesn't default to ;; "\\s)". This way parens at end of defun are properly hidden. "" "#" python-hideshow-forward-sexp-function - nil)) + nil + python-nav-beginning-of-block + python-hideshow-find-next-block + python-info-looking-at-beginning-of-block)) (setq-local outline-regexp (python-rx (* space) block-start)) (setq-local outline-heading-end-regexp ":[^\n]*\n") diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 9e8fa7f552..608ce548e7 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -5598,6 +5598,39 @@ def \\ (should (not (python-info-looking-at-beginning-of-defun))) (should (not (python-info-looking-at-beginning-of-defun nil t))))) +(ert-deftest python-info-looking-at-beginning-of-block-1 () + (python-tests-with-temp-buffer + " +def f(): + if True: + pass + l = [x * 2 + for x in range(5) + if x < 3] +# if False: +\"\"\" +if 0: +\"\"\" +" + (python-tests-look-at "def f():") + (should (python-info-looking-at-beginning-of-block)) + (forward-char) + (should (not (python-info-looking-at-beginning-of-block))) + (python-tests-look-at "if True:") + (should (python-info-looking-at-beginning-of-block)) + (forward-char) + (should (not (python-info-looking-at-beginning-of-block))) + (beginning-of-line) + (should (python-info-looking-at-beginning-of-block)) + (python-tests-look-at "for x") + (should (not (python-info-looking-at-beginning-of-block))) + (python-tests-look-at "if x < 3") + (should (not (python-info-looking-at-beginning-of-block))) + (python-tests-look-at "if False:") + (should (not (python-info-looking-at-beginning-of-block))) + (python-tests-look-at "if 0:") + (should (not (python-info-looking-at-beginning-of-block))))) + (ert-deftest python-info-current-line-comment-p-1 () (python-tests-with-temp-buffer " @@ -6051,8 +6084,11 @@ class SomeClass: class SomeClass: def __init__(self, arg, kwarg=1): + def filter(self, nums): - def __str__(self):")))) + + def __str__(self): +")))) (or enabled (hs-minor-mode -1))))) (ert-deftest python-hideshow-hide-levels-2 () @@ -6098,6 +6134,165 @@ class SomeClass: ")))) (or enabled (hs-minor-mode -1))))) +(ert-deftest python-hideshow-hide-levels-3 () + "Should hide all blocks." + (python-tests-with-temp-buffer + " +def f(): + if 0: + l = [i for i in range(5) + if i < 3] + abc = o.match(1, 2, 3) + +def g(): + pass +" + (hs-minor-mode 1) + (hs-hide-level 1) + (should + (string= + (python-tests-visible-string) + " +def f(): + +def g(): +")))) + +(ert-deftest python-hideshow-hide-levels-4 () + "Should hide 2nd level block." + (python-tests-with-temp-buffer + " +def f(): + if 0: + l = [i for i in range(5) + if i < 3] + abc = o.match(1, 2, 3) + +def g(): + pass +" + (hs-minor-mode 1) + (hs-hide-level 2) + (should + (string= + (python-tests-visible-string) + " +def f(): + if 0: + +def g(): + pass +")))) + +(ert-deftest python-hideshow-hide-all-1 () + "Should hide all blocks." + (python-tests-with-temp-buffer + "if 0: + + aaa + l = [i for i in range(5) + if i < 3] + ccc + abc = o.match(1, 2, 3) + ddd + +def f(): + pass +" + (hs-minor-mode 1) + (hs-hide-all) + (should + (string= + (python-tests-visible-string) + "if 0: + +def f(): +")))) + +(ert-deftest python-hideshow-hide-all-2 () + "Should hide comments." + (python-tests-with-temp-buffer + " +# Multi line +# comment + +\"\"\" +# Multi line +# string +\"\"\" +" + (hs-minor-mode 1) + (hs-hide-all) + (should + (string= + (python-tests-visible-string) + " +# Multi line + +\"\"\" +# Multi line +# string +\"\"\" +")))) + +(ert-deftest python-hideshow-hide-all-3 () + "Should not hide comments when `hs-hide-comments-when-hiding-all' is nil." + (python-tests-with-temp-buffer + " +# Multi line +# comment + +\"\"\" +# Multi line +# string +\"\"\" +" + (hs-minor-mode 1) + (let ((hs-hide-comments-when-hiding-all nil)) + (hs-hide-all)) + (should + (string= + (python-tests-visible-string) + " +# Multi line +# comment + +\"\"\" +# Multi line +# string +\"\"\" +")))) + +(ert-deftest python-hideshow-hide-block-1 () + "Should hide current block." + (python-tests-with-temp-buffer + " +if 0: + + aaa + l = [i for i in range(5) + if i < 3] + ccc + abc = o.match(1, 2, 3) + ddd + +def f(): + pass +" + (hs-minor-mode 1) + (python-tests-look-at "ddd") + (forward-line) + (hs-hide-block) + (should + (string= + (python-tests-visible-string) + " +if 0: + +def f(): + pass +")))) + (ert-deftest python-tests--python-nav-end-of-statement--infloop () "Checks that `python-nav-end-of-statement' doesn't infloop in a