commit f12fbed4c13998d4838633bfa89124685a79dae2 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Sat Feb 22 23:53:52 2025 -0700 Revert “Pacify GCC in pgtkselect malloc alignment” Problem reported by the wurfkreuz (Bug#76414). * src/pgtkselect.c: Revert my commit ff65cc9944dc0b37986d512ee8b9817c6913db36 dated Sun Jan 26 22:15:49 2025 -0800 for now. I may come up with a better commit later. diff --git a/src/pgtkselect.c b/src/pgtkselect.c index 7e6c457d15b..c05594d7366 100644 --- a/src/pgtkselect.c +++ b/src/pgtkselect.c @@ -50,7 +50,7 @@ static Lisp_Object pgtk_get_window_property_as_lisp_data (struct pgtk_display_in GdkWindow *, GdkAtom, Lisp_Object, GdkAtom, bool); static Lisp_Object selection_data_to_lisp_data (struct pgtk_display_info *, - void const *, + const unsigned char *, ptrdiff_t, GdkAtom, int); static void lisp_data_to_selection_data (struct pgtk_display_info *, Lisp_Object, struct selection_data *); @@ -148,7 +148,7 @@ pgtk_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, guint32 timestamp = gtk_get_current_event_time (); GdkAtom selection_atom = symbol_to_gdk_atom (selection_name); Lisp_Object targets; - ptrdiff_t ntargets; + ptrdiff_t i, ntargets; GtkTargetEntry *gtargets; if (timestamp == GDK_CURRENT_TIME) @@ -207,7 +207,7 @@ pgtk_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, gtargets = xzalloc (sizeof *gtargets * ASIZE (targets)); ntargets = 0; - for (ptrdiff_t i = 0; i < ASIZE (targets); i++) + for (i = 0; i < ASIZE (targets); ++i) { if (SYMBOLP (AREF (targets, i))) gtargets[ntargets++].target @@ -1072,17 +1072,38 @@ pgtk_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_typ /* Subroutines of pgtk_get_window_property_as_lisp_data */ +static ptrdiff_t +pgtk_size_for_format (gint format) +{ + switch (format) + { + case 8: + return sizeof (unsigned char); + case 16: + return sizeof (unsigned short); + case 32: + return sizeof (unsigned long); + + default: + emacs_abort (); + } +} + /* Use xfree, not g_free, to free the data obtained with this function. */ static void -pgtk_get_window_property (GdkWindow *window, void **data_ret, +pgtk_get_window_property (GdkWindow *window, unsigned char **data_ret, ptrdiff_t *bytes_ret, GdkAtom *actual_type_ret, - int *actual_format_ret) + int *actual_format_ret, unsigned long *actual_size_ret) { gint length, actual_format; unsigned char *data; + ptrdiff_t element_size; void *xdata; GdkAtom actual_type; + unsigned long i; + unsigned int *idata; + unsigned long *ldata; data = NULL; @@ -1096,39 +1117,63 @@ pgtk_get_window_property (GdkWindow *window, void **data_ret, *actual_type_ret = GDK_NONE; *bytes_ret = 0; *actual_format_ret = 8; + *actual_size_ret = 0; return; } - if (! (actual_type == GDK_SELECTION_TYPE_ATOM - || actual_type == gdk_atom_intern_static_string ("ATOM_PAIR"))) - actual_type = GDK_NONE; + if (actual_type == GDK_SELECTION_TYPE_ATOM + || actual_type == gdk_atom_intern_static_string ("ATOM_PAIR")) + { + /* GDK should not allow anything else. */ + eassert (actual_format == 32); + + length = length / sizeof (GdkAtom); + xdata = xmalloc (sizeof (GdkAtom) * length + 1); + memcpy (xdata, data, 1 + length * sizeof (GdkAtom)); + + g_free (data); - if (ULONG_WIDTH > 32 && actual_format == 32) + *data_ret = xdata; + *actual_type_ret = actual_type; + *bytes_ret = length * sizeof (GdkAtom); + *actual_format_ret = 32; + *actual_size_ret = length; + + return; + } + + element_size = pgtk_size_for_format (actual_format); + length = length / element_size; + + /* Add an extra byte on the end. GDK guarantees that it is + NULL. */ + xdata = xmalloc (1 + element_size * length); + memcpy (xdata, data, 1 + element_size * length); + + if (actual_format == 32 && LONG_WIDTH > 32) { - unsigned long int *ldata = (unsigned long int *) data; - gint n = length / sizeof *ldata; - unsigned int *idata; - length = n * sizeof *idata; - idata = xdata = xmalloc (length); - for (gint i = 0; i < n; i++) + ldata = (typeof (ldata)) data; + idata = xdata; + + for (i = 0; i < length; ++i) idata[i] = ldata[i]; + + /* There is always enough space in idata. */ + idata[length] = 0; + *bytes_ret = sizeof *idata * length; } else - { - /* Add an extra byte on the end. GDK guarantees that it is - NULL. */ - xdata = xmalloc (length + 1); - memcpy (xdata, data, length + 1); - } - - *bytes_ret = length; + /* I think GDK itself prevents element_size from exceeding the + length at which this computation fails. */ + *bytes_ret = element_size * length; /* Now free the original `data' allocated by GDK. */ g_free (data); *data_ret = xdata; *actual_type_ret = GDK_NONE; + *actual_size_ret = length; *actual_format_ret = actual_format; *actual_type_ret = actual_type; } @@ -1141,13 +1186,15 @@ pgtk_get_window_property_as_lisp_data (struct pgtk_display_info *dpyinfo, { GdkAtom actual_type; int actual_format; - void *data; + unsigned long actual_size; + unsigned char *data = 0; ptrdiff_t bytes = 0; Lisp_Object val; GdkDisplay *display = dpyinfo->display; pgtk_get_window_property (window, &data, &bytes, - &actual_type, &actual_format); + &actual_type, &actual_format, + &actual_size); if (!data) { @@ -1214,7 +1261,7 @@ pgtk_get_window_property_as_lisp_data (struct pgtk_display_info *dpyinfo, static Lisp_Object selection_data_to_lisp_data (struct pgtk_display_info *dpyinfo, - void const *data, + const unsigned char *data, ptrdiff_t size, GdkAtom type, int format) { if (type == gdk_atom_intern_static_string ("NULL")) @@ -1224,7 +1271,7 @@ selection_data_to_lisp_data (struct pgtk_display_info *dpyinfo, { Lisp_Object str, lispy_type; - str = make_unibyte_string (data, size); + str = make_unibyte_string ((char *) data, size); /* Indicate that this string is from foreign selection by a text property `foreign-selection' so that the caller of x-get-selection-internal (usually x-get-selection) can know @@ -1247,7 +1294,8 @@ selection_data_to_lisp_data (struct pgtk_display_info *dpyinfo, /* Treat ATOM_PAIR type similar to list of atoms. */ || type == gdk_atom_intern_static_string ("ATOM_PAIR"))) { - GdkAtom const *idata = data; + ptrdiff_t i; + GdkAtom *idata = (GdkAtom *) data; if (size == sizeof (GdkAtom)) return gdk_atom_to_symbol (idata[0]); @@ -1255,7 +1303,7 @@ selection_data_to_lisp_data (struct pgtk_display_info *dpyinfo, { Lisp_Object v = make_nil_vector (size / sizeof (GdkAtom)); - for (ptrdiff_t i = 0; i < size / sizeof (GdkAtom); i++) + for (i = 0; i < size / sizeof (GdkAtom); i++) ASET (v, i, gdk_atom_to_symbol (idata[i])); return v; } @@ -1287,11 +1335,12 @@ selection_data_to_lisp_data (struct pgtk_display_info *dpyinfo, */ else if (format == 16) { + ptrdiff_t i; Lisp_Object v = make_uninit_vector (size / 2); if (type == GDK_SELECTION_TYPE_INTEGER) { - for (ptrdiff_t i = 0; i < size / 2; i++) + for (i = 0; i < size / 2; i++) { short j = ((short *) data) [i]; ASET (v, i, make_fixnum (j)); @@ -1299,7 +1348,7 @@ selection_data_to_lisp_data (struct pgtk_display_info *dpyinfo, } else { - for (ptrdiff_t i = 0; i < size / 2; i++) + for (i = 0; i < size / 2; i++) { unsigned short j = ((unsigned short *) data) [i]; ASET (v, i, make_fixnum (j)); @@ -1309,11 +1358,12 @@ selection_data_to_lisp_data (struct pgtk_display_info *dpyinfo, } else { + ptrdiff_t i; Lisp_Object v = make_nil_vector (size / sizeof (gint)); if (type == GDK_SELECTION_TYPE_INTEGER) { - for (ptrdiff_t i = 0; i < size / sizeof (gint); i++) + for (i = 0; i < size / sizeof (gint); i++) { int j = ((gint *) data) [i]; ASET (v, i, INT_TO_INTEGER (j)); @@ -1321,7 +1371,7 @@ selection_data_to_lisp_data (struct pgtk_display_info *dpyinfo, } else { - for (ptrdiff_t i = 0; i < size / sizeof (gint); i++) + for (i = 0; i < size / sizeof (gint); i++) { unsigned int j = ((unsigned int *) data) [i]; ASET (v, i, INT_TO_INTEGER (j)); @@ -1428,6 +1478,7 @@ lisp_data_to_selection_data (struct pgtk_display_info *dpyinfo, a set of 16 or 32 bit INTEGERs; or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...] */ + ptrdiff_t i; ptrdiff_t size = ASIZE (obj); if (SYMBOLP (AREF (obj, 0))) @@ -1436,7 +1487,7 @@ lisp_data_to_selection_data (struct pgtk_display_info *dpyinfo, void *data; GdkAtom *x_atoms; if (NILP (type)) type = QATOM; - for (ptrdiff_t i = 0; i < size; i++) + for (i = 0; i < size; i++) if (!SYMBOLP (AREF (obj, i))) signal_error ("All elements of selection vector must have same type", obj); @@ -1444,7 +1495,7 @@ lisp_data_to_selection_data (struct pgtk_display_info *dpyinfo, x_atoms = data; cs->format = 32; cs->size = size; - for (ptrdiff_t i = 0; i < size; i++) + for (i = 0; i < size; i++) x_atoms[i] = symbol_to_gdk_atom (AREF (obj, i)); } else @@ -1456,7 +1507,7 @@ lisp_data_to_selection_data (struct pgtk_display_info *dpyinfo, unsigned long *x_atoms; short *shorts; if (NILP (type)) type = QINTEGER; - for (ptrdiff_t i = 0; i < size; i++) + for (i = 0; i < size; i++) { if (! RANGED_FIXNUMP (SHRT_MIN, AREF (obj, i), SHRT_MAX)) { @@ -1473,7 +1524,7 @@ lisp_data_to_selection_data (struct pgtk_display_info *dpyinfo, shorts = data; cs->format = format; cs->size = size; - for (ptrdiff_t i = 0; i < size; i++) + for (i = 0; i < size; i++) { if (format == 32) x_atoms[i] = cons_to_gdk_long (AREF (obj, i)); @@ -1509,11 +1560,13 @@ clean_local_selection_data (Lisp_Object obj) } if (VECTORP (obj)) { + ptrdiff_t i; ptrdiff_t size = ASIZE (obj); + Lisp_Object copy; if (size == 1) return clean_local_selection_data (AREF (obj, 0)); - Lisp_Object copy = make_nil_vector (size); - for (ptrdiff_t i = 0; i < size; i++) + copy = make_nil_vector (size); + for (i = 0; i < size; i++) ASET (copy, i, clean_local_selection_data (AREF (obj, i))); return copy; } commit 3a1195894e55db5c48c4a337bff5f6e58ce356f5 Author: Eli Zaretskii Date: Sun Feb 23 07:51:44 2025 +0200 ; * lisp/emacs-lisp/cond-star.el (cond*): Fix whitespace. diff --git a/lisp/emacs-lisp/cond-star.el b/lisp/emacs-lisp/cond-star.el index c955e14f548..18a1c344860 100644 --- a/lisp/emacs-lisp/cond-star.el +++ b/lisp/emacs-lisp/cond-star.el @@ -53,7 +53,7 @@ or `(pcase* PATTERN DATUM)', `(bind* BINDINGS...)' means to bind BINDINGS (as if they were in `let*') for the body of the clause, and all subsequent clauses, since the `bind*' clause is always a non-exit clause. As a condition, it counts as true -and runs the body of the clause if the first binding's value is non-nil. +and runs the body of the clause if the first binding's value is non-nil. `(match* PATTERN DATUM)' means to match DATUM against the pattern PATTERN For its patterns, see `match*'. commit 8334a9bd73f01a714ba352a49b1f040264ed4eac Merge: 8b0043ffd60 9c1d13c89a9 Author: Eli Zaretskii Date: Sun Feb 23 00:48:15 2025 -0500 Merge from origin/emacs-30 9c1d13c89a9 ; * admin/authors.el (authors-aliases): Add Vladimir Niki... 443df12eddc ; * INSTALL.REPO: Minor copyedits. 76b938fc1d2 ; Don't fail image tests if jpeg is supported via imagema... f8ff9592be9 ; Skip autorevert test when notify support is missing 230ecb1e273 ; Skip shr-test/zoom-image test if png or libxml support ... cc51bd56987 ; Skip image type test if support is missing commit 8b0043ffd609344f714ba962f82624128e662011 Author: Michael Heerdegen Date: Wed Feb 2 01:08:43 2022 +0100 Fix diary not displaying some entries in european style * lisp/calendar/calendar.el (diary-european-date-forms): Correctly recognize times using a dot as separator. (Bug#53702) diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index d0eb6ced3d0..08ecd586ec1 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -813,8 +813,8 @@ but `diary-date-forms' (which see)." (defcustom diary-european-date-forms '((day "/" month "[^/0-9]") (day "/" month "/" year "[^0-9]") - (backup day " *" monthname "\\W+\\<\\([^*0-9]\\|\\([0-9]+[:aApP]\\)\\)") - (day " *" monthname " *" year "[^0-9:aApP]") + (backup day " *" monthname "\\W+\\<\\([^*0-9]\\|\\([0-9]+[:.aApP]\\)\\)") + (day " *" monthname " *" year "[^0-9:.aApP]") (dayname "\\W")) "List of pseudo-patterns describing the European style of dates. The defaults are: DAY/MONTH; DAY/MONTH/YEAR; DAY MONTHNAME; @@ -829,7 +829,8 @@ DAY MONTHNAME YEAR; DAYNAME. Normally you should not customize this, but (repeat (list :inline t :format "%v" (symbol :tag "Keyword") (choice symbol regexp))))) - :group 'diary) + :group 'diary + :version "31.1") (defvar diary-font-lock-keywords) commit dfce17103c8f91db887b490418b9bafb0f52aacb Author: Stefan Kangas Date: Sun Feb 23 04:31:53 2025 +0100 ; Delete out-of-date comment in float-sup.el * lisp/emacs-lisp/float-sup.el: Delete out-of-date comment. diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el index bb820a2d82b..7f8a4a78163 100644 --- a/lisp/emacs-lisp/float-sup.el +++ b/lisp/emacs-lisp/float-sup.el @@ -25,7 +25,6 @@ ;;; Code: -;; Provide an easy hook to tell if we are running with floats or not. ;; Define pi and e via math-lib calls (much less prone to killer typos). (defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...).") (with-suppressed-warnings ((lexical pi)) commit 96e066be3d252efe44a8321be313a67def14ea4e Author: Stefan Kangas Date: Sun Feb 23 04:04:24 2025 +0100 Mark kermit.el as obsolete While Kermit is still developed, this Emacs support library is essentially unchanged since it was added to Emacs, which seems to have been in 1988. It is also based on the old pre-Emacs 20 shell mode, so it's not clear if it even works, and much less if it is relevant with Kermit from this century. There is also this modern alternative, from 1994, which seems far more complete: https://www.kermitproject.org/archive.html#emacs The bug tracker has stayed silent, so if anyone is still using it, they will have to report a bug and ask us to unobsolete it. * lisp/obsolete/kermit.el: Add Obsolete-since header. Add link to alternative library at kermitproject.org. diff --git a/etc/NEWS b/etc/NEWS index 8ff318b5004..4d9e94113ac 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1279,6 +1279,11 @@ Major-mode authors can customize the variables 'yank-media-autoselect-function' and/or 'yank-media-preferred-types' to change the selection rules. +** Miscellaneous + +--- +*** kermit.el is now obsolete. + * New Modes and Packages in Emacs 31.1 diff --git a/lisp/obsolete/kermit.el b/lisp/obsolete/kermit.el index 5a3d4efb22b..0413c57b9aa 100644 --- a/lisp/obsolete/kermit.el +++ b/lisp/obsolete/kermit.el @@ -6,6 +6,7 @@ ;; Maintainer: emacs-devel@gnu.org ;; Created: 15 Feb 1988 ;; Keywords: comm +;; Obsolete-since: 31.1 ;; This file is part of GNU Emacs. @@ -24,6 +25,15 @@ ;;; Commentary: +;; This library is obsolete. +;; +;; If you are looking for Kermit support in Emacs, you might want to +;; take a look here instead: +;; +;; https://www.kermitproject.org/archive.html#emacs + +;; --- + ;; I'm not sure, but I think somebody asked about running kermit under shell ;; mode a while ago. Anyway, here is some code that I find useful. The result ;; is that I can log onto machines with primitive operating systems (VMS and commit 29a7f63b5f374ba9cfd6f3e6c314e415bcd5936d Author: Stefan Kangas Date: Sun Feb 23 04:03:37 2025 +0100 Move kermit.el to obsolete/kermit.el * lisp/kermit.el: Move from here... * lisp/obsolete/kermit.el: ...to here. diff --git a/lisp/kermit.el b/lisp/obsolete/kermit.el similarity index 100% rename from lisp/kermit.el rename to lisp/obsolete/kermit.el commit 4abeb75a51634641185f80a747f9d8b3debcedd2 Author: Eli Zaretskii Date: Sun Feb 23 07:23:33 2025 +0200 ; Fix documentation of recent changes * etc/NEWS: * doc/lispref/numbers.texi (Arithmetic Operations): Fix wording and markup. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 29105959ecd..c38aa7cd62d 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -683,17 +683,17 @@ This function returns @var{number-or-marker} minus 1. @defmac incf place &optional delta This macro increments the number stored in @var{place} by one, or -by @var{delta} if specified. The incremented value is returned. +by @var{delta} if specified. It returns the incremented value. -@var{place} can be a symbol or a generalized variable, @xref{Generalized -Variables}. For example, @code{(incf i)} is equivalent to -@code{(setq i (1+ i))}, and @code{(incf (car x) 2)} is equivalent to -@code{(setcar x (+ (car x) 2))}. +@var{place} can be a symbol or a generalized variable, +@pxref{Generalized Variables}. For example, @w{@samp{(incf i)}} is +equivalent to @w{@samp{(setq i (1+ i))}}, and @w{@samp{(incf (car x) +2)}} is equivalent to @w{@samp{(setcar x (+ (car x) 2))}}. @end defmac @defmac decf place &optional delta This macro decrements the number stored in @var{place} by one, or -by @var{delta} if specified. The decremented value is returned. +by @var{delta} if specified. It returns the decremented value. @end defmac @defun + &rest numbers-or-markers diff --git a/etc/NEWS b/etc/NEWS index 0c54fc2c4a9..8ff318b5004 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1363,7 +1363,7 @@ change it globally with: (set-default-toplevel-value 'lexical-binding t) +++ -*** New functions 'incf' and 'decf'. +*** New macros 'incf' and 'decf'. They increment or decrement the value stored in a variable (a symbol), or in a generalized variable. commit 03bc51349f19899812652a8335f5055f561494e2 Author: Stefan Kangas Date: Sun Feb 23 03:43:25 2025 +0100 Prefer ert-with-temp-directory in tests * test/lisp/dired-aux-tests.el (dired-test-bug30624): * test/lisp/emacs-lisp/track-changes-tests.el (track-changes-tests--random): * test/src/buffer-tests.el (test-buffer-chars-modified-ticks): * test/src/fileio-tests.el (fileio-tests--symlink-failure) (fileio-tests--insert-file-interrupt) (fileio-tests--circular-after-insert-file-functions): Prefer ert-with-temp-directory to using make-temp-file directly. diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index d2abc6db55d..7d4f8562277 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -89,25 +89,25 @@ (should-error (dired-rename-file from to-mv nil))))) (ert-deftest dired-test-bug30624 () - "test for https://debbugs.gnu.org/30624 ." - (cl-letf* ((target-dir (make-temp-file "target" 'dir)) - ((symbol-function 'dired-mark-read-file-name) - (lambda (&rest _) target-dir)) - (inhibit-message t)) - ;; Delete target-dir: `dired-do-create-files' must recreate it. - (delete-directory target-dir) - (let ((file1 (make-temp-file "bug30624_file1")) - (file2 (make-temp-file "bug30624_file2")) - (dired-create-destination-dirs 'always) - (buf (dired temporary-file-directory))) - (unwind-protect - (progn - (dired-revert) - (dired-mark-files-regexp "bug30624_file") - (should (dired-do-create-files 'copy 'dired-copy-file "Copy" nil))) - (delete-directory target-dir 'recursive) - (mapc #'delete-file `(,file1 ,file2)) - (kill-buffer buf))))) + "Test for ." + (ert-with-temp-directory target-dir + (ert-with-temp-file file1 + :suffix "bug30624_file1" + (ert-with-temp-file _file2 + :suffix "bug30624_file2" + (cl-letf* (((symbol-function 'dired-mark-read-file-name) + (lambda (&rest _) target-dir)) + (inhibit-message t)) + ;; Delete target-dir: `dired-do-create-files' must recreate it. + (delete-directory target-dir) + (let ((dired-create-destination-dirs 'always) + (buf (dired (file-name-directory file1)))) + (unwind-protect + (progn + (dired-revert) + (dired-mark-files-regexp "bug30624_file") + (should (dired-do-create-files 'copy 'dired-copy-file "Copy" nil))) + (kill-buffer buf)))))))) (defun dired-test--check-highlighting (command positions) (let ((start 1)) diff --git a/test/lisp/emacs-lisp/track-changes-tests.el b/test/lisp/emacs-lisp/track-changes-tests.el index 6499deb78d6..4f08c539360 100644 --- a/test/lisp/emacs-lisp/track-changes-tests.el +++ b/test/lisp/emacs-lisp/track-changes-tests.el @@ -24,6 +24,7 @@ (require 'track-changes) (require 'cl-lib) (require 'ert) +(require 'ert-x) (defun track-changes-tests--random-word () (let ((chars ())) @@ -52,104 +53,104 @@ (random track-changes-tests--random-seed) (dotimes (_ 100) (insert (track-changes-tests--random-word) "\n")) - (let* ((buf1 (generate-new-buffer " *tc1*")) - (buf2 (generate-new-buffer " *tc2*")) - (char-counts (make-vector 2 0)) - (sync-counts (make-vector 2 0)) - (print-escape-newlines t) - (file (make-temp-file "tc")) - (id1 (track-changes-register #'ignore)) - (id3 (track-changes-register #'ignore :nobefore t)) - (sync - (lambda (id buf n) - (track-changes-tests--message "!! SYNC %d !!" n) - (track-changes-fetch - id (lambda (beg end before) - (when (eq n 1) - (track-changes-fetch - id3 (lambda (beg3 end3 before3) - (should (eq beg3 beg)) - (should (eq end3 end)) - (should (eq before3 - (if (symbolp before) - before (length before))))))) - (incf (aref sync-counts (1- n))) - (incf (aref char-counts (1- n)) (- end beg)) - (let ((after (buffer-substring beg end))) - (track-changes-tests--message - "Sync:\n %S\n=> %S\nat %d .. %d" - before after beg end) - (with-current-buffer buf - (if (eq before 'error) - (erase-buffer) - (should (equal before - (buffer-substring - beg (+ beg (length before))))) - (delete-region beg (+ beg (length before)))) - (goto-char beg) - (insert after))) - (should (equal (buffer-string) - (with-current-buffer buf - (buffer-string)))))))) - (id2 (track-changes-register - (lambda (id2 &optional distance) - (when distance - (track-changes-tests--message "Disjoint distance: %d" - distance) - (funcall sync id2 buf2 2))) - :disjoint t))) - (write-region (point-min) (point-max) file) - (insert-into-buffer buf1) - (insert-into-buffer buf2) - (should (equal (buffer-hash) (buffer-hash buf1))) - (should (equal (buffer-hash) (buffer-hash buf2))) - (message "seeding with: %S" track-changes-tests--random-seed) - (dotimes (_ 1000) - (pcase (random 15) - (0 - (track-changes-tests--message "Manual sync1") - (funcall sync id1 buf1 1)) - (1 - (track-changes-tests--message "Manual sync2") - (funcall sync id2 buf2 2)) - ((pred (< _ 5)) - (let* ((beg (+ (point-min) (random (1+ (buffer-size))))) - (end (min (+ beg (1+ (random 100))) (point-max)))) - (track-changes-tests--message "Fill %d .. %d" beg end) - (fill-region-as-paragraph beg end))) - ((pred (< _ 8)) - (let* ((beg (+ (point-min) (random (1+ (buffer-size))))) - (end (min (+ beg (1+ (random 12))) (point-max)))) - (track-changes-tests--message "Delete %S at %d .. %d" - (buffer-substring beg end) beg end) - (delete-region beg end))) - ((and 8 (guard (= (random 50) 0))) - (track-changes-tests--message "Silent insertion") - (let ((inhibit-modification-hooks t)) - (insert "a"))) - ((and 8 (guard (= (random 10) 0))) - (track-changes-tests--message "Revert") - (insert-file-contents file nil nil nil 'replace)) - ((and 8 (guard (= (random 3) 0))) - (let* ((beg (+ (point-min) (random (1+ (buffer-size))))) - (end (min (+ beg (1+ (random 12))) (point-max))) - (after (eq (random 2) 0))) - (track-changes-tests--message "Bogus %S %d .. %d" - (if after 'after 'before) beg end) - (if after - (run-hook-with-args 'after-change-functions - beg end (- end beg)) - (run-hook-with-args 'before-change-functions beg end)))) - (_ - (goto-char (+ (point-min) (random (1+ (buffer-size))))) - (let ((word (track-changes-tests--random-word))) - (track-changes-tests--message "insert %S at %d" word (point)) - (insert word "\n"))))) - (message "SCOREs: default: %d/%d=%d disjoint: %d/%d=%d" - (aref char-counts 0) (aref sync-counts 0) - (/ (aref char-counts 0) (aref sync-counts 0)) - (aref char-counts 1) (aref sync-counts 1) - (/ (aref char-counts 1) (aref sync-counts 1)))))) + (ert-with-temp-file file + (let* ((buf1 (generate-new-buffer " *tc1*")) + (buf2 (generate-new-buffer " *tc2*")) + (char-counts (make-vector 2 0)) + (sync-counts (make-vector 2 0)) + (print-escape-newlines t) + (id1 (track-changes-register #'ignore)) + (id3 (track-changes-register #'ignore :nobefore t)) + (sync + (lambda (id buf n) + (track-changes-tests--message "!! SYNC %d !!" n) + (track-changes-fetch + id (lambda (beg end before) + (when (eq n 1) + (track-changes-fetch + id3 (lambda (beg3 end3 before3) + (should (eq beg3 beg)) + (should (eq end3 end)) + (should (eq before3 + (if (symbolp before) + before (length before))))))) + (incf (aref sync-counts (1- n))) + (incf (aref char-counts (1- n)) (- end beg)) + (let ((after (buffer-substring beg end))) + (track-changes-tests--message + "Sync:\n %S\n=> %S\nat %d .. %d" + before after beg end) + (with-current-buffer buf + (if (eq before 'error) + (erase-buffer) + (should (equal before + (buffer-substring + beg (+ beg (length before))))) + (delete-region beg (+ beg (length before)))) + (goto-char beg) + (insert after))) + (should (equal (buffer-string) + (with-current-buffer buf + (buffer-string)))))))) + (id2 (track-changes-register + (lambda (id2 &optional distance) + (when distance + (track-changes-tests--message "Disjoint distance: %d" + distance) + (funcall sync id2 buf2 2))) + :disjoint t))) + (write-region (point-min) (point-max) file) + (insert-into-buffer buf1) + (insert-into-buffer buf2) + (should (equal (buffer-hash) (buffer-hash buf1))) + (should (equal (buffer-hash) (buffer-hash buf2))) + (message "seeding with: %S" track-changes-tests--random-seed) + (dotimes (_ 1000) + (pcase (random 15) + (0 + (track-changes-tests--message "Manual sync1") + (funcall sync id1 buf1 1)) + (1 + (track-changes-tests--message "Manual sync2") + (funcall sync id2 buf2 2)) + ((pred (< _ 5)) + (let* ((beg (+ (point-min) (random (1+ (buffer-size))))) + (end (min (+ beg (1+ (random 100))) (point-max)))) + (track-changes-tests--message "Fill %d .. %d" beg end) + (fill-region-as-paragraph beg end))) + ((pred (< _ 8)) + (let* ((beg (+ (point-min) (random (1+ (buffer-size))))) + (end (min (+ beg (1+ (random 12))) (point-max)))) + (track-changes-tests--message "Delete %S at %d .. %d" + (buffer-substring beg end) beg end) + (delete-region beg end))) + ((and 8 (guard (= (random 50) 0))) + (track-changes-tests--message "Silent insertion") + (let ((inhibit-modification-hooks t)) + (insert "a"))) + ((and 8 (guard (= (random 10) 0))) + (track-changes-tests--message "Revert") + (insert-file-contents file nil nil nil 'replace)) + ((and 8 (guard (= (random 3) 0))) + (let* ((beg (+ (point-min) (random (1+ (buffer-size))))) + (end (min (+ beg (1+ (random 12))) (point-max))) + (after (eq (random 2) 0))) + (track-changes-tests--message "Bogus %S %d .. %d" + (if after 'after 'before) beg end) + (if after + (run-hook-with-args 'after-change-functions + beg end (- end beg)) + (run-hook-with-args 'before-change-functions beg end)))) + (_ + (goto-char (+ (point-min) (random (1+ (buffer-size))))) + (let ((word (track-changes-tests--random-word))) + (track-changes-tests--message "insert %S at %d" word (point)) + (insert word "\n"))))) + (message "SCOREs: default: %d/%d=%d disjoint: %d/%d=%d" + (aref char-counts 0) (aref sync-counts 0) + (/ (aref char-counts 0) (aref sync-counts 0)) + (aref char-counts 1) (aref sync-counts 1) + (/ (aref char-counts 1) (aref sync-counts 1))))))) diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index b4b9e761986..0879b928565 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -8523,22 +8523,16 @@ Finally, kill the buffer and its temporary file." (ert-deftest test-buffer-chars-modified-ticks () "Test `buffer-chars-modified-tick'." (setq temporary-file-directory (file-truename temporary-file-directory)) - (let ((text "foobar") - f1 f2) - (unwind-protect - (progn - (setq f1 (make-temp-file "buf-modiff-tests") - f2 (make-temp-file "buf-modiff-tests")) - (with-current-buffer (find-file f1) - (should (= (buffer-chars-modified-tick) 1)) - (should (= (buffer-chars-modified-tick) (buffer-modified-tick))) - (write-region text nil f2 nil 'silent) - (insert-file-contents f2) - (should (= (buffer-chars-modified-tick) (buffer-modified-tick))) - (should (> (buffer-chars-modified-tick) 1)))) - (if f1 (delete-file f1)) - (if f2 (delete-file f2)) - ))) + (ert-with-temp-file f1 + (ert-with-temp-file f2 + (let ((text "foobar")) + (with-current-buffer (find-file f1) + (should (= (buffer-chars-modified-tick) 1)) + (should (= (buffer-chars-modified-tick) (buffer-modified-tick))) + (write-region text nil f2 nil 'silent) + (insert-file-contents f2) + (should (= (buffer-chars-modified-tick) (buffer-modified-tick))) + (should (> (buffer-chars-modified-tick) 1))))))) (ert-deftest test-labeled-narrowing () "Test `with-restriction' and `without-restriction'." diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index 65a21d5950c..c2938c4900e 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -20,6 +20,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (defun try-link (target link) (make-symbolic-link target link) @@ -30,19 +31,17 @@ failure)) (defun fileio-tests--symlink-failure () - (let* ((dir (make-temp-file "fileio" t)) - (link (expand-file-name "link" dir))) - (unwind-protect - (let (failure - (char 0)) - (while (and (not failure) (< char 127)) - (setq char (1+ char)) - (when (and (eq system-type 'cygwin) (eq char 92)) - (setq char (1+ char))) - (setq failure (try-link (string char) link))) - (or failure - (try-link "/:" link))) - (delete-directory dir t)))) + (ert-with-temp-directory dir + (let* ((link (expand-file-name "link" dir))) + (let (failure + (char 0)) + (while (and (not failure) (< char 127)) + (setq char (1+ char)) + (when (and (eq system-type 'cygwin) (eq char 92)) + (setq char (1+ char))) + (setq failure (try-link (string char) link))) + (or failure + (try-link "/:" link)))))) (ert-deftest fileio-tests--odd-symlink-chars () "Check that any non-NULL ASCII character can appear in a symlink. @@ -109,24 +108,20 @@ Also check that an encoding error can appear in a symlink." (should (equal (expand-file-name "~/bar") "x:/foo/bar"))))) (ert-deftest fileio-tests--insert-file-interrupt () - (let ((text "-*- coding: binary -*-\n\xc3\xc3help") - f) - (unwind-protect - (progn - (setq f (make-temp-file "ftifi")) - (write-region text nil f nil 'silent) - (with-temp-buffer - (catch 'toto - (let ((set-auto-coding-function (lambda (&rest _) (throw 'toto nil)))) - (insert-file-contents f))) - (goto-char (point-min)) - (unless (eobp) - (forward-line 1) - (let ((c1 (char-after))) - (forward-char 1) - (should (equal c1 (char-before))) - (should (equal c1 (char-after))))))) - (if f (delete-file f))))) + (ert-with-temp-file f + (let ((text "-*- coding: binary -*-\n\xc3\xc3help")) + (write-region text nil f nil 'silent) + (with-temp-buffer + (catch 'toto + (let ((set-auto-coding-function (lambda (&rest _) (throw 'toto nil)))) + (insert-file-contents f))) + (goto-char (point-min)) + (unless (eobp) + (forward-line 1) + (let ((c1 (char-after))) + (forward-char 1) + (should (equal c1 (char-before))) + (should (equal c1 (char-after))))))))) (ert-deftest fileio-tests--relative-default-directory () "Test `expand-file-name' when `default-directory' is relative." @@ -159,12 +154,12 @@ Also check that an encoding error can appear in a symlink." (ert-deftest fileio-tests--circular-after-insert-file-functions () "Test `after-insert-file-functions' as a circular list." - (let ((f (make-temp-file "fileio")) - (after-insert-file-functions (list 'identity))) - (setcdr after-insert-file-functions after-insert-file-functions) - (write-region "hello\n" nil f nil 'silent) - (should-error (insert-file-contents f) :type 'circular-list) - (delete-file f))) + (ert-with-temp-file f + :suffix "fileio" + (let ((after-insert-file-functions (list 'identity))) + (setcdr after-insert-file-functions after-insert-file-functions) + (write-region "hello\n" nil f nil 'silent) + (should-error (insert-file-contents f) :type 'circular-list)))) (ert-deftest fileio-tests/null-character () (should-error (file-exists-p "/foo\0bar") commit 5f1d52c43b5eafeb4938d99c275e78c9155f4142 Author: Thuna Date: Wed Feb 12 23:34:16 2025 +0100 Fix print-tests * test/src/print-tests.el (terpri): Erase the buffer *terpri-test* before individual runs. (Bug#72334) (print-circle): Allow circular references with number greater than 9. diff --git a/test/src/print-tests.el b/test/src/print-tests.el index ddee6d914a4..1a04cf73f30 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -130,6 +130,7 @@ otherwise, use a different charset." "abc\n"))) (let ((standard-output (with-current-buffer (get-buffer-create "*terpri-test*") + (erase-buffer) (insert "--------") (point-max-marker)))) (should (terpri nil t)) @@ -338,7 +339,7 @@ otherwise, use a different charset." (print-tests--deftest print-circle () (let ((x '(#1=(a . #1#) #1#))) (let ((print-circle nil)) - (should (string-match "\\`((a . #[0-9]) (a . #[0-9]))\\'" + (should (string-match "\\`((a . #[0-9]+) (a . #[0-9]+))\\'" (print-tests--prin1-to-string x)))) (let ((print-circle t)) (should (equal "(#1=(a . #1#) #1#)" (print-tests--prin1-to-string x)))))) commit f549cedaa2721bfc463fe714c00016aed21f7b5c Author: Mauro Aranda Date: Sat Feb 15 09:26:46 2025 -0300 Fix comparison of current values for the key-sequence :type * lisp/cus-edit.el (custom-variable-modified-p): Round-trip the option value before comparing it against the widget's value. This mostly fixes comparison against the obsolete key-sequence widget, but could fix other corner cases, when the widget accepts different types as values. (Bug#76156) * test/lisp/cus-edit-tests.el (cus-edit-test-bug76156) (cus-edit-test-bug76156-2): New test options. (cus-edit-test-unedited-option): New test. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 9addb078d87..5ce940bd0e5 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -3054,11 +3054,18 @@ To check for other states, call `custom-variable-state'." (let* ((form (widget-get widget :custom-form)) (symbol (widget-get widget :value)) (get (or (get symbol 'custom-get) 'default-value)) - (value (if (default-boundp symbol) - (condition-case nil - (funcall get symbol) - (error (throw 'get-error t))) - (symbol-value symbol))) + (value-widget (car (widget-get widget :children))) + ;; Round-trip the value, for the sake of widgets that accept + ;; values of different types (e.g., the obsolete key-sequence widget + ;; which takes either strings or vectors. (Bug#76156) + (value + (widget-apply value-widget :value-to-external + (widget-apply value-widget :value-to-internal + (if (default-boundp symbol) + (condition-case nil + (funcall get symbol) + (error (throw 'get-error t))) + (symbol-value symbol))))) (orig-value (widget-value (car (widget-get widget :children))))) (not (equal (if (memq form '(lisp mismatch)) ;; Mimic `custom-variable-value-create'. diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el index 8c7697ac635..1662a7ee32e 100644 --- a/test/lisp/cus-edit-tests.el +++ b/test/lisp/cus-edit-tests.el @@ -134,5 +134,23 @@ ;; No empty key/value pairs should show up. (should-not (search-forward "key" nil t))) +(defcustom cus-edit-test-bug76156 "\C-c " + "Key-sequence option that might show up as EDITED even though it's not." + :type 'key-sequence) + +(defcustom cus-edit-test-bug76156-2 [(control ?z)] + "Key-sequence option that might show up as EDITED even though it's not." + :type 'key-sequence) + +(ert-deftest cus-edit-test-unedited-option () + "Test that customizing unedited options doesn't show up as EDITED." + (dolist (option '(cus-edit-test-bug76156 + cus-edit-test-bug76156-2 + cus-edit-test-foo1)) + (customize-option option) + (let ((widget (car custom-options))) + (should (eq (widget-get widget :custom-state) 'standard))) + (kill-buffer))) + (provide 'cus-edit-tests) ;;; cus-edit-tests.el ends here commit 2044f6d9592cdec3a916c0d3c0a8a079c479db61 Author: Jostein Kjønigsen Date: Fri Feb 21 13:59:26 2025 +0100 Improve fontification of docker-files Add support for fontifying the following grammar-elements: - image-declarations (image-name, image-tag & image alias) - strings in more general terms - string-expansion statements - treat path-values as strings - identifiers names for ENV and ARG statements - argument values for ENV and ARG statements * lisp/progmodes/dockerfile-ts-mode.el (dockerfile-ts-mode) (dockerfile-ts-mode--font-lock-settings): Improve fontification. (Bug#76481) diff --git a/lisp/progmodes/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el index 1594c93451b..016bb2f7272 100644 --- a/lisp/progmodes/dockerfile-ts-mode.el +++ b/lisp/progmodes/dockerfile-ts-mode.el @@ -97,7 +97,9 @@ continuation to the previous entry." :language 'dockerfile :feature 'image-spec - '((image_spec) @font-lock-constant-face) + '((image_name) @font-lock-function-name-face + (image_tag) @font-lock-function-name-face + (image_alias) @font-lock-function-name-face) :language 'dockerfile :feature 'keyword @@ -113,7 +115,29 @@ continuation to the previous entry." :language 'dockerfile :feature 'string - '((double_quoted_string) @font-lock-string-face) + '((single_quoted_string) @font-lock-string-face + (double_quoted_string) @font-lock-string-face + (json_string) @font-lock-string-face + (path) @font-lock-string-face + (arg_instruction + default: (unquoted_string) @font-lock-string-face) + (env_pair + value: (unquoted_string) @font-lock-string-face)) + + :language 'dockerfile + :feature 'string-expansion + :override t + '((expansion + (["$" "{" "}"] @font-lock-variable-name-face)) + (expansion + (variable) @font-lock-variable-name-face)) + + :language 'dockerfile + :feature 'identifiers + '((arg_instruction + name: (unquoted_string) @font-lock-variable-name-face) + (env_pair + name: (unquoted_string) @font-lock-variable-name-face)) :language 'dockerfile :feature 'error @@ -164,7 +188,7 @@ Return nil if there is no name or if NODE is not a stage node." dockerfile-ts-mode--font-lock-settings) (setq-local treesit-font-lock-feature-list '((comment) - (keyword string) + (keyword string string-expansion identifiers) (image-spec number) (bracket delimiter error operator))) commit ae37a1cc3d93d3703b43c5ab2d10f1f3e146cf90 Author: Stefan Kangas Date: Sun Feb 23 00:13:21 2025 +0100 Prefer incf to cl-incf in emacs-lisp/*.el * lisp/emacs-lisp/backtrace.el (backtrace--print-func-and-args): * lisp/emacs-lisp/bindat.el (bindat--type): * lisp/emacs-lisp/bytecomp.el (byte-recompile-directory): * lisp/emacs-lisp/chart.el (chart-file-count): * lisp/emacs-lisp/cl-extra.el (cl-parse-integer, cl--print-table): * lisp/emacs-lisp/cl-generic.el (cl--defmethod-doc-pos): * lisp/emacs-lisp/cl-indent.el (common-lisp-loop-part-indentation) (common-lisp-indent-function-1, lisp-indent-defmethod): * lisp/emacs-lisp/cl-lib.el (cl--set-substring): * lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause): * lisp/emacs-lisp/cl-preloaded.el (cl-struct-define): * lisp/emacs-lisp/cl-print.el (cl-print--cons-tail) (cl-print--vector-contents, cl-print--struct-contents) (cl-print--string-props): * lisp/emacs-lisp/cl-seq.el (cl-substitute): * lisp/emacs-lisp/comp-cstr.el (comp--range-union) (comp--range-intersection): * lisp/emacs-lisp/comp.el (comp-vec-append, comp--gen-counter) (comp--op-case, comp--limplify-lap-inst, comp--limplify-block) (comp--limplify-function, comp--maybe-add-vmvar, comp--fwprop*): * lisp/emacs-lisp/edebug.el (edebug--called-interactively-skip): * lisp/emacs-lisp/eldoc.el (eldoc--invoke-strategy): * lisp/emacs-lisp/elp.el (elp--make-wrapper): * lisp/emacs-lisp/ert-x.el (ert-kill-all-test-buffers): * lisp/emacs-lisp/ert.el (ert--stats-set-test-and-result) (ert-write-junit-test-summary-report): * lisp/emacs-lisp/memory-report.el (memory-report--symbol-plist) (memory-report--object-size-1): * lisp/emacs-lisp/oclosure.el (oclosure--index-table) (oclosure--define-functions): * lisp/emacs-lisp/package.el (package-menu--perform-transaction): * lisp/emacs-lisp/smie.el (smie-set-prec2tab, smie-prec2->grammar) (smie-config--guess, smie-config--guess-1): * lisp/emacs-lisp/syntax.el (syntax-propertize-rules) (syntax-ppss--update-stats): * lisp/emacs-lisp/track-changes.el (track-changes--after): Prefer incf to cl-incf. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index aec6f420708..b395a13b0dd 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -750,7 +750,7 @@ Format it according to VIEW." (let ((fun-and-args (cons fun args))) (insert (backtrace--print-to-string fun-and-args))) ;; Skip the open-paren. - (cl-incf fun-beg))) + (incf fun-beg))) (when fun-file (make-text-button fun-beg (or fun-end diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index c70a7474cdc..c40cc0d53c8 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -682,7 +682,7 @@ is the name of a variable that will hold the value we need to pack.") (cl-defmethod bindat--type (op (_ (eql 'byte))) (bindat--pcase op ('unpack `(bindat--unpack-u8)) - (`(length . ,_) `(cl-incf bindat-idx 1)) + (`(length . ,_) `(incf bindat-idx 1)) (`(pack . ,args) `(bindat--pack-u8 . ,args)))) (cl-defmethod bindat--type (op (_ (eql 'uint)) n &optional le) @@ -690,7 +690,7 @@ is the name of a variable that will hold the value we need to pack.") (bindat--pcase op ('unpack `(if ,le (bindat--unpack-uintr ,n) (bindat--unpack-uint ,n))) - (`(length . ,_) `(cl-incf bindat-idx (/ ,n 8))) + (`(length . ,_) `(incf bindat-idx (/ ,n 8))) (`(pack . ,args) `(if ,le (bindat--pack-uintr ,n . ,args) (bindat--pack-uint ,n . ,args)))))) @@ -698,14 +698,14 @@ is the name of a variable that will hold the value we need to pack.") (cl-defmethod bindat--type (op (_ (eql 'str)) len) (bindat--pcase op ('unpack `(bindat--unpack-str ,len)) - (`(length . ,_) `(cl-incf bindat-idx ,len)) + (`(length . ,_) `(incf bindat-idx ,len)) (`(pack . ,args) `(bindat--pack-str ,len . ,args)))) (cl-defmethod bindat--type (op (_ (eql 'strz)) &optional len) (bindat--pcase op ('unpack `(bindat--unpack-strz ,len)) (`(length ,val) - `(cl-incf bindat-idx ,(cond + `(incf bindat-idx ,(cond ;; Optimizations if len is a literal number or nil. ((null len) `(1+ (length ,val))) ((numberp len) len) @@ -716,11 +716,11 @@ is the name of a variable that will hold the value we need to pack.") (cl-defmethod bindat--type (op (_ (eql 'bits)) len) (bindat--pcase op ('unpack `(bindat--unpack-bits ,len)) - (`(length . ,_) `(cl-incf bindat-idx ,len)) + (`(length . ,_) `(incf bindat-idx ,len)) (`(pack . ,args) `(bindat--pack-bits ,len . ,args)))) (cl-defmethod bindat--type (_op (_ (eql 'fill)) len) - `(progn (cl-incf bindat-idx ,len) nil)) + `(progn (incf bindat-idx ,len) nil)) (cl-defmethod bindat--type (_op (_ (eql 'align)) len) `(progn (cl-callf bindat--align bindat-idx ,len) nil)) @@ -747,7 +747,7 @@ is the name of a variable that will hold the value we need to pack.") (let `#'(lambda (,val) (setq bindat-idx (+ bindat-idx ,len))) fun) (guard (not (macroexp--fgrep `((,val)) len)))) ;; Optimize the case where the size of each element is constant. - `(cl-incf bindat-idx (* ,count ,len))) + `(incf bindat-idx (* ,count ,len))) ;; FIXME: It's tempting to use `(mapc (lambda (,val) ,exp) ,val)' ;; which would be more efficient when `val' is a list, ;; but that's only right if length of `val' is indeed `count'. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 88e45ddb868..66407774007 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2051,7 +2051,7 @@ also be compiled." (not (member source (dir-locals--all-files directory))) ;; File is requested to be ignored (not (string-match-p ignore-files-regexp source))) - (progn (cl-incf + (progn (incf (pcase (byte-recompile-file source force arg) ('no-byte-compile skip-count) ('t file-count) diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 2a01501f99e..09ce2e763f6 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -633,7 +633,7 @@ argument to `chart-sort' to sort the lists if desired." (m (member s extlst))) (unless (null s) (if m - (cl-incf (car (nthcdr (- (length extlst) (length m)) cntlst))) + (incf (car (nthcdr (- (length extlst) (length m)) cntlst))) (setq extlst (cons s extlst) cntlst (cons 1 cntlst)))))) ;; Let's create the chart! diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index ab06682cf93..584945dae59 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -441,8 +441,8 @@ as an integer unless JUNK-ALLOWED is non-nil." (setq start (1+ start))))) (skip-whitespace) (let ((sign (cl-case (and (< start end) (aref string start)) - (?+ (cl-incf start) +1) - (?- (cl-incf start) -1) + (?+ (incf start) +1) + (?- (incf start) -1) (t +1))) digit sum) (while (and (< start end) @@ -908,7 +908,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" `(space :align-to ,(+ col col-space))) "%s") formats) - (cl-incf col (+ col-space (aref cols i)))) + (incf col (+ col-space (aref cols i)))) (let ((format (mapconcat #'identity (nreverse formats)))) (insert (apply #'format format (mapcar (lambda (str) (propertize str 'face 'italic)) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 6a81b55bccf..9a7fe26eaf3 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -509,7 +509,7 @@ Presumes point is at the end of the `cl-defmethod' symbol." (let ((n 2)) (while (and (ignore-errors (forward-sexp 1) t) (not (eq (char-before) ?\)))) - (cl-incf n)) + (incf n)) n))) ;;;###autoload diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el index 0695edc3d12..5ea7015adf0 100644 --- a/lisp/emacs-lisp/cl-indent.el +++ b/lisp/emacs-lisp/cl-indent.el @@ -179,13 +179,13 @@ the standard Lisp indent package." (when (and (eq lisp-indent-backquote-substitution-mode 'corrected)) (save-excursion (goto-char (elt state 1)) - (cl-incf loop-indentation - (cond ((eq (char-before) ?,) -1) - ((and (eq (char-before) ?@) - (progn (backward-char) - (eq (char-before) ?,))) - -2) - (t 0))))) + (incf loop-indentation + (cond ((eq (char-before) ?,) -1) + ((and (eq (char-before) ?@) + (progn (backward-char) + (eq (char-before) ?,))) + -2) + (t 0))))) (goto-char indent-point) (beginning-of-line) @@ -400,9 +400,9 @@ instead." ;; ",(...)" or ",@(...)" (when (eq lisp-indent-backquote-substitution-mode 'corrected) - (cl-incf sexp-column -1) + (incf sexp-column -1) (when (eq (char-after (1- containing-sexp)) ?\@) - (cl-incf sexp-column -1))) + (incf sexp-column -1))) (cond (lisp-indent-backquote-substitution-mode (setf tentative-calculated normal-indent) (setq depth lisp-indent-maximum-backtracking) @@ -706,7 +706,7 @@ optional\\|rest\\|key\\|allow-other-keys\\|aux\\|whole\\|body\\|environment\ (forward-sexp 2) (skip-chars-forward " \t\n") (while (looking-at "\\sw\\|\\s_") - (cl-incf nqual) + (incf nqual) (forward-sexp) (skip-chars-forward " \t\n")) (> nqual 0))) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 42460fc2c9f..2bab451dd0c 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -162,9 +162,9 @@ to an element already in the list stored in PLACE. val)) (defun cl--set-substring (str start end val) - (if end (if (< end 0) (cl-incf end (length str))) + (if end (if (< end 0) (incf end (length str))) (setq end (length str))) - (if (< start 0) (cl-incf start (length str))) + (if (< start 0) (incf start (length str))) (concat (and (> start 0) (substring str 0 start)) val (and (< end (length str)) (substring str end)))) @@ -456,7 +456,7 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp ;;With optional argument N, returns Nth-to-last link (default 1)." ;; (if n ;; (let ((m 0) (p x)) -;; (while (consp p) (cl-incf m) (pop p)) +;; (while (consp p) (incf m) (pop p)) ;; (if (<= n 0) p ;; (if (< n m) (nthcdr (- m n) x) x))) ;; (while (consp (cdr x)) (pop x)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 0682a162422..1578603cedd 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1598,12 +1598,12 @@ For more details, see Info node `(cl)Loop Facility'. ((memq word '(sum summing)) (let ((what (pop cl--loop-args)) (var (cl--loop-handle-accum 0))) - (push `(progn (cl-incf ,var ,what) t) cl--loop-body))) + (push `(progn (incf ,var ,what) t) cl--loop-body))) ((memq word '(count counting)) (let ((what (pop cl--loop-args)) (var (cl--loop-handle-accum 0))) - (push `(progn (if ,what (cl-incf ,var)) t) cl--loop-body))) + (push `(progn (if ,what (incf ,var)) t) cl--loop-body))) ((memq word '(minimize minimizing maximize maximizing)) (push `(progn ,(macroexp-let2 macroexp-copyable-p temp diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 0399b179125..7017fcd5b83 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -161,7 +161,7 @@ (car slot) (nth 1 slot) type props))) (puthash (car slot) (+ i offset) index-table) - (cl-incf i)) + (incf i)) v)) (class (cl--struct-new-class name docstring diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 427f32862b2..62cda07ac73 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -100,7 +100,7 @@ Print the contents hidden by the ellipsis to STREAM." (cl-print-object (pop object) stream) (cl-print-insert-ellipsis object t stream) (setq object nil)) - (cl-incf count)) + (incf count)) (when object (princ " . " stream) (cl-print-object object stream)))) @@ -123,7 +123,7 @@ Print the contents hidden by the ellipsis to STREAM." (while (< i limit) (unless (= i start) (princ " " stream)) (cl-print-object (aref object i) stream) - (cl-incf i)) + (incf i)) (when (< limit len) (princ " " stream) (cl-print-insert-ellipsis object limit stream)))) @@ -298,7 +298,7 @@ into a button whose action shows the function's disassembly.") (princ (cl--slot-descriptor-name slot) stream) (princ " " stream) (cl-print-object (aref object (1+ i)) stream)) - (cl-incf i)) + (incf i)) (when (< limit len) (princ " " stream) (cl-print-insert-ellipsis object limit stream)))) @@ -369,7 +369,7 @@ primitives such as `prin1'.") (princ start-pos stream) (princ " " stream) (princ end-pos stream) (princ " " stream) (cl-print-object props stream) - (cl-incf interval-count)) + (incf interval-count)) (setq start-pos end-pos end-pos (next-property-change start-pos object len)))) (when (< start-pos len) diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index e9c1e531656..6e51b895b46 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -439,7 +439,7 @@ to avoid corrupting the original SEQ. (setq cl-seq (copy-sequence cl-seq)) (unless cl-from-end (setf (elt cl-seq cl-i) cl-new) - (cl-incf cl-i) + (incf cl-i) (decf cl-count)) (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count :start cl-i cl-keys)))))) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 3d46bca30ac..dfbef785ee6 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -448,7 +448,7 @@ Return them as multiple value." do (when (zerop nest) (setf low i)) - (cl-incf nest) + (incf nest) else do (when (= nest 1) @@ -477,7 +477,7 @@ Return them as multiple value." (cl-return '())) if (eq x 'l) do - (cl-incf nest) + (incf nest) (when (= nest n-ranges) (setf low i)) else diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2baf4ec4b74..e7ccbbf12c7 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -334,7 +334,7 @@ Useful to hook into pass checkers.") "Append ELT into VEC. Returns ELT." (puthash (comp-vec-end vec) elt (comp-vec-data vec)) - (cl-incf (comp-vec-end vec)) + (incf (comp-vec-end vec)) elt) (defsubst comp-vec-prepend (vec elt) @@ -492,7 +492,7 @@ non local exit (ends with an `unreachable' insn).")) "Return a sequential number generator." (let ((n -1)) (lambda () - (cl-incf n)))) + (incf n)))) (cl-defstruct (comp-func (:copier nil)) "LIMPLE representation of a function." @@ -1302,7 +1302,7 @@ and the annotation emission." ;; ,(concat "LAP op " op-name))) ;; Emit the stack adjustment if present. ,(when (and sp-delta (not (eq 0 sp-delta))) - `(cl-incf (comp--sp) ,sp-delta)) + `(incf (comp--sp) ,sp-delta)) ,@(comp--body-eff body op-name sp-delta)) else collect `(',op (signal 'native-ice @@ -1336,7 +1336,7 @@ and the annotation emission." (make--comp-mvar :constant arg) (comp--slot+1)))) (byte-call - (cl-incf (comp--sp) (- arg)) + (incf (comp--sp) (- arg)) (comp--emit-set-call (comp--callref 'funcall (1+ arg) (comp--sp)))) (byte-unbind (comp--emit (comp--call 'helper_unbind_n @@ -1491,19 +1491,19 @@ and the annotation emission." (byte-numberp auto) (byte-integerp auto) (byte-listN - (cl-incf (comp--sp) (- 1 arg)) + (incf (comp--sp) (- 1 arg)) (comp--emit-set-call (comp--callref 'list arg (comp--sp)))) (byte-concatN - (cl-incf (comp--sp) (- 1 arg)) + (incf (comp--sp) (- 1 arg)) (comp--emit-set-call (comp--callref 'concat arg (comp--sp)))) (byte-insertN - (cl-incf (comp--sp) (- 1 arg)) + (incf (comp--sp) (- 1 arg)) (comp--emit-set-call (comp--callref 'insert arg (comp--sp)))) (byte-stack-set (comp--copy-slot (1+ (comp--sp)) (- (comp--sp) arg -1))) (byte-stack-set2 (cl-assert nil)) ;; TODO (byte-discardN - (cl-incf (comp--sp) (- arg))) + (incf (comp--sp) (- arg))) (byte-switch ;; Assume to follow the emission of a setimm. ;; This is checked into comp--emit-switch. @@ -1513,7 +1513,7 @@ and the annotation emission." (byte-constant (comp--emit-setimm arg)) (byte-discardN-preserve-tos - (cl-incf (comp--sp) (- arg)) + (incf (comp--sp) (- arg)) (comp--copy-slot (+ arg (comp--sp))))))) (defun comp--emit-narg-prologue (minarg nonrest rest) @@ -1722,7 +1722,7 @@ into the C code forwarding the compilation unit." for inst = (car inst-cell) for next-inst = (car-safe (cdr inst-cell)) do (comp--limplify-lap-inst inst) - (cl-incf (comp-limplify-pc comp-pass)) + (incf (comp-limplify-pc comp-pass)) when (comp--lap-fall-through-p inst) do (pcase next-inst (`(TAG ,_label . ,label-sp) @@ -1755,7 +1755,7 @@ into the C code forwarding the compilation unit." (let ((args (comp-func-l-args func))) (if (comp-args-p args) (cl-loop for i below (comp-args-max args) - do (cl-incf (comp--sp)) + do (incf (comp--sp)) (comp--emit `(set-par-to-local ,(comp--slot) ,i))) (comp--emit-narg-prologue (comp-args-base-min args) (comp-nargs-nonrest args) @@ -1901,7 +1901,7 @@ Return OP otherwise." (if-let* ((match (eql (comp-mvar-slot op) (comp-mvar-slot cmp-res))) (new-mvar (make--comp-mvar :slot - (- (cl-incf (comp-func-vframe-size comp-func)))))) + (- (incf (comp-func-vframe-size comp-func)))))) (progn (push `(assume ,new-mvar ,op) (cdr insns-seq)) new-mvar) @@ -2768,7 +2768,7 @@ Return t if something was changed." (comp--copy-insn insn)) do (comp--fwprop-insn insn) - (cl-incf i) + (incf i) when (and (null modified) (not (equal insn orig-insn))) do (setf modified t)) when (> i comp--fwprop-max-insns-scan) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 1d66012e03b..3ecc287da14 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -4594,8 +4594,8 @@ With prefix argument, make it a temporary breakpoint." (let ((s 1)) (while (memq (nth 1 (backtrace-frame i 'called-interactively-p)) '(edebug-enter edebug-default-enter)) - (cl-incf s) - (cl-incf i)) + (incf s) + (incf i)) s))) ;; Finally, hook edebug into the rest of Emacs. diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index f1ce52d196b..3e701076ef3 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -903,7 +903,7 @@ the docstrings eventually produced, using interactive)) (make-callback (method origin) - (let ((pos (prog1 howmany (cl-incf howmany)))) + (let ((pos (prog1 howmany (incf howmany)))) (cl-ecase method (:enthusiast (lambda (string &rest plist) @@ -920,7 +920,7 @@ the docstrings eventually produced, using nil #'display-doc)) t)) (:patient - (cl-incf want) + (incf want) (lambda (string &rest plist) (register-doc pos string plist origin) (when (zerop (decf want)) (display-doc)) diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index bb99bef55cc..784baf55c7b 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -395,11 +395,11 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." ;; we are recording times (let (enter-time) ;; increment the call-counter - (cl-incf (aref info 0)) + (incf (aref info 0)) (setq enter-time (current-time) result (apply func args)) ;; calculate total time in function - (cl-incf (aref info 1) (elp-elapsed-time enter-time nil)) + (incf (aref info 1) (elp-elapsed-time enter-time nil)) )) ;; turn off recording if this is the master function (if (and elp-master diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 0dacec130a0..ee86ef2dad8 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -140,7 +140,7 @@ BODY." (maphash (lambda (buffer _dummy) (when (or (not (buffer-live-p buffer)) (kill-buffer buffer)) - (cl-incf count))) + (incf count))) ert--test-buffers) (message "%s out of %s test buffers killed" count (hash-table-count ert--test-buffers))) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 28be8666f28..178a29d073b 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1159,21 +1159,21 @@ Also changes the counters in STATS to match." (aref results pos)) (cl-etypecase (aref results pos) (ert-test-passed - (cl-incf (ert--stats-passed-expected stats) d)) + (incf (ert--stats-passed-expected stats) d)) (ert-test-failed - (cl-incf (ert--stats-failed-expected stats) d)) + (incf (ert--stats-failed-expected stats) d)) (ert-test-skipped - (cl-incf (ert--stats-skipped stats) d)) + (incf (ert--stats-skipped stats) d)) (null) (ert-test-aborted-with-non-local-exit) (ert-test-quit)) (cl-etypecase (aref results pos) (ert-test-passed - (cl-incf (ert--stats-passed-unexpected stats) d)) + (incf (ert--stats-passed-unexpected stats) d)) (ert-test-failed - (cl-incf (ert--stats-failed-unexpected stats) d)) + (incf (ert--stats-failed-unexpected stats) d)) (ert-test-skipped - (cl-incf (ert--stats-skipped stats) d)) + (incf (ert--stats-skipped stats) d)) (null) (ert-test-aborted-with-non-local-exit) (ert-test-quit))))) @@ -1684,8 +1684,8 @@ test packages depend on each other, it might be helpful.") (insert " \n" " \n" " \n") - (cl-incf errors 1) - (cl-incf id 1))) + (incf errors 1) + (incf id 1))) (insert-file-contents-literally test-report) (when (looking-at-p @@ -1693,15 +1693,15 @@ test packages depend on each other, it might be helpful.") (delete-region (point) (line-beginning-position 2))) (when (looking-at "") - (cl-incf tests (string-to-number (match-string 1))) - (cl-incf errors (string-to-number (match-string 2))) - (cl-incf failures (string-to-number (match-string 3))) - (cl-incf skipped (string-to-number (match-string 4))) - (cl-incf time (string-to-number (match-string 5))) + (incf tests (string-to-number (match-string 1))) + (incf errors (string-to-number (match-string 2))) + (incf failures (string-to-number (match-string 3))) + (incf skipped (string-to-number (match-string 4))) + (incf time (string-to-number (match-string 5))) (delete-region (point) (line-beginning-position 2))) (when (looking-at " ") diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index 5b9a590c7de..8ca7c0e5f0a 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -168,7 +168,7 @@ by counted more than once." (total 0)) (mapatoms (lambda (symbol) - (cl-incf total (memory-report--object-size + (incf total (memory-report--object-size counted (symbol-plist symbol)))) obarray) (list @@ -217,16 +217,16 @@ by counted more than once." (let ((total 0) (size (memory-report--size 'cons))) (while value - (cl-incf total size) + (incf total size) (setf (gethash value counted) t) (when (car value) - (cl-incf total (memory-report--object-size counted (car value)))) + (incf total (memory-report--object-size counted (car value)))) (let ((next (cdr value))) (setq value (when next (if (consp next) (unless (gethash next counted) (cdr value)) - (cl-incf total (memory-report--object-size + (incf total (memory-report--object-size counted next)) nil))))) total)) @@ -235,7 +235,7 @@ by counted more than once." (let ((total (+ (memory-report--size 'vector) (* (memory-report--size 'object) (length value))))) (cl-loop for elem across value - do (cl-incf total (memory-report--object-size counted elem))) + do (incf total (memory-report--object-size counted elem))) total)) (cl-defmethod memory-report--object-size-1 (counted (value hash-table)) @@ -243,8 +243,8 @@ by counted more than once." (* (memory-report--size 'object) (hash-table-size value))))) (maphash (lambda (key elem) - (cl-incf total (memory-report--object-size counted key)) - (cl-incf total (memory-report--object-size counted elem))) + (incf total (memory-report--object-size counted key)) + (incf total (memory-report--object-size counted elem))) value) total)) diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index 0be0a307115..b0b8aa0ce8e 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -125,7 +125,7 @@ (it (make-hash-table :test #'eq))) (dolist (desc slotdescs) (let* ((slot (cl--slot-descriptor-name desc))) - (cl-incf i) + (incf i) (when (gethash slot it) (error "Duplicate slot name: %S" slot)) (setf (gethash slot it) i))) @@ -305,7 +305,7 @@ list of slot properties. The currently known properties are the following: ;; Always use a double hyphen: if users wants to ;; make it public, they can do so with an alias. (aname (intern (format "%S--%S" name slot)))) - (cl-incf i) + (incf i) (if (not mutable) `(defalias ',aname ;; We use `oclosure--copy' instead of diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 2a1045b18ed..78bd846c951 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3982,7 +3982,7 @@ Return nil if there were no errors; non-nil otherwise." (package-menu--transaction-status)) (dolist (pkg install-list) (setq package-menu--transaction-status - (format status-format (cl-incf i))) + (format status-format (incf i))) (force-mode-line-update) (redisplay 'force) ;; Don't mark as selected, `package-menu-execute' already diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index e0c2d567b47..111d413cc42 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -176,7 +176,7 @@ ;; don't hide real conflicts. (puthash key (gethash key override) table) (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y)) - (cl-incf smie-warning-count)) + (incf smie-warning-count)) (puthash key val table)))) (defun smie-precs->prec2 (precs) @@ -585,13 +585,13 @@ PREC2 is a table as returned by `smie-precs->prec2' or (unless (caar cst) (setcar (car cst) i) ;; (smie-check-grammar table prec2 'step1) - (cl-incf i)) + (incf i)) (setq csts (delq cst csts)))) (unless progress (error "Can't resolve the precedence cycle: %s" (smie-debug--describe-cycle table (smie-debug--prec2-cycle csts))))) - (cl-incf i 10)) + (incf i 10)) ;; Propagate equality constraints back to their sources. (dolist (eq (nreverse eqs)) (when (null (cadr eq)) @@ -602,7 +602,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or ;; So set it here rather than below since doing it below ;; makes it more difficult to obey the equality constraints. (setcar (cdr eq) i) - (cl-incf i)) + (incf i)) (cl-assert (or (null (caar eq)) (eq (caar eq) (cadr eq)))) (setcar (car eq) (cadr eq)) ;; (smie-check-grammar table prec2 'step2) @@ -612,10 +612,10 @@ PREC2 is a table as returned by `smie-precs->prec2' or (dolist (x table) (unless (nth 1 x) (setf (nth 1 x) i) - (cl-incf i)) ;See other (cl-incf i) above. + (incf i)) ;See other (incf i) above. (unless (nth 2 x) (setf (nth 2 x) i) - (cl-incf i)))) ;See other (cl-incf i) above. + (incf i)))) ;See other (incf i) above. ;; Mark closers and openers. (dolist (x (gethash :smie-open/close-alist prec2)) (let* ((token (car x)) @@ -2157,7 +2157,7 @@ position corresponding to each rule." (trace (mapcar #'cdr (cdr itrace))) (cur (current-indentation))) (when (numberp nindent) ;Skip `noindent' and friends. - (cl-incf (gethash (cons (- cur nindent) trace) otraces 0))))) + (incf (gethash (cons (- cur nindent) trace) otraces 0))))) (forward-line 1))) (progress-reporter-done pr) @@ -2193,14 +2193,14 @@ position corresponding to each rule." (let ((data (list 0 nil nil))) (puthash sig data sigs) data)))) - (cl-incf (nth 0 sig-data) count) + (incf (nth 0 sig-data) count) (push (cons count otrace) (nth 2 sig-data)) (let ((sig-off-data (or (assq offset (nth 1 sig-data)) (let ((off-data (cons offset 0))) (push off-data (nth 1 sig-data)) off-data)))) - (cl-incf (cdr sig-off-data) count)))))))) + (incf (cdr sig-off-data) count)))))))) otraces) ;; Finally, guess the indentation rules. @@ -2241,7 +2241,7 @@ position corresponding to each rule." off-data)))) (cl-assert (>= (cdr ooff-data) count)) (decf (cdr ooff-data) count) - (cl-incf (cdr noff-data) count)))))))))) + (incf (cdr noff-data) count)))))))))) rules)) (defun smie-config-guess () diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 6d28adb37b9..99a64d701cf 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -276,7 +276,7 @@ all RULES in total." ;; If there's more than 1 rule, and the rule want to apply ;; highlight to match 0, create an extra group to be able to ;; tell when *this* match 0 has succeeded. - (cl-incf offset) + (incf offset) (setq re (concat "\\(" re "\\)"))) (setq re (syntax-propertize--shift-groups-and-backrefs re offset)) (let ((code '()) @@ -356,7 +356,7 @@ all RULES in total." code)))) (push (cons condition (nreverse code)) branches)) - (cl-incf offset (regexp-opt-depth orig-re)) + (incf offset (regexp-opt-depth orig-re)) re)) rules "\\|"))) @@ -586,8 +586,8 @@ The rest is only useful if you're interested in tweaking the algorithm.") syntax-ppss-stats)) (defun syntax-ppss--update-stats (i old new) (let ((pair (aref syntax-ppss-stats i))) - (cl-incf (car pair)) - (cl-incf (cdr pair) (- new old)))) + (incf (car pair)) + (incf (cdr pair) (- new old)))) (defun syntax-ppss--data () (if (eq (point-min) 1) diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el index 125314fa814..1ac7feb3b77 100644 --- a/lisp/emacs-lisp/track-changes.el +++ b/lisp/emacs-lisp/track-changes.el @@ -594,14 +594,14 @@ Details logged to `track-changes--error-log'") (track-changes--trace) (cl-assert track-changes--state) (let ((offset (- (- end beg) len))) - (cl-incf track-changes--buffer-size offset) + (incf track-changes--buffer-size offset) (if (and (eq track-changes--before-clean 'unset) (not track-changes--before-no)) ;; This can be a sign that a `before-change-functions' went missing, ;; or that we called `track-changes--clean-state' between ;; a `before-change-functions' and `after-change-functions'. (track-changes--before beg end) - (cl-incf track-changes--before-end offset)) + (incf track-changes--before-end offset)) (setq track-changes--before-clean nil) (if (not (or track-changes--before-no (save-restriction commit 042dc5929b706b5fbc0ea8ada6014661d44a1b53 Author: Stefan Kangas Date: Sat Feb 22 19:14:51 2025 +0100 Prefer incf to cl-incf in tests * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-reify-function): * test/lisp/emacs-lisp/cl-extra-tests.el (cl-getf): * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-loop-for-as-arith-order-side-effects) (cl-macs-loop-for-as-equals-then, cl-macs-loop-do, cl-macs-loop-finally) (cl-macs-loop-in-ref, cl-macs-loop-being-elements-of-ref) (cl-macs-test--symbol-macrolet, cl-the): * test/lisp/emacs-lisp/cl-seq-tests.el (cl-lib-test-remove) (cl-lib-test-remove-if-not): * test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el (edebug-test-code-range): * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-deduplicate): * test/lisp/emacs-lisp/generator-tests.el (cps-while-incf): (cps-test-iter-cleanup-once-only): * test/lisp/emacs-lisp/hierarchy-tests.el (hierarchy-labelfn-button-if-does-not-button-unless-condition) (hierarchy-labelfn-button-if-does-button-when-condition): * test/lisp/emacs-lisp/let-alist-tests.el (let-alist-evaluate-once): * test/lisp/emacs-lisp/lisp-mode-tests.el (indent-sexp, lisp-indent-region): * test/lisp/emacs-lisp/map-tests.el (test-map-elt-gv) (test-setf-map-with-function): * test/lisp/emacs-lisp/multisession-tests.el (multi-test-sqlite-simple) (multi-test-sqlite-busy, multi-test-files-simple) (multi-test-files-busy): * test/lisp/emacs-lisp/oclosure-tests.el (oclosure-test, oclosure-test-mutate): * test/lisp/emacs-lisp/track-changes-tests.el (track-changes-tests--random): * test/lisp/files-tests.el (files-tests--with-buffer-offer-save): * test/lisp/net/shr-tests.el (shr-test/zoom-image): * test/lisp/replace-tests.el (replace-tests-with-undo): * test/src/buffer-tests.el (test-overlay-randomly): * test/src/data-tests.el (test-bool-vector-bv-from-hex-string): * test/src/fns-tests.el (fns-tests-sort): * test/src/json-tests.el (json-insert/signal, json-insert/throw): * test/src/minibuf-tests.el (minibuf-tests--strings-to-symbol-alist) (minibuf-tests--strings-to-string-alist) (minibuf-tests--strings-to-string-hashtable) (minibuf-tests--strings-to-symbol-hashtable): * test/src/process-tests.el (make-process/file-handler/found): Prefer incf to cl-incf. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index d5f76fd0230..8b0c1dad4c0 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1812,7 +1812,7 @@ compiled correctly." (cl-letf ((lexical-binding t) ((symbol-function 'counter) nil)) (let ((x 0)) - (defun counter () (cl-incf x)) + (defun counter () (incf x)) (should (equal (counter) 1)) (should (equal (counter) 2)) ;; byte compiling should not cause counter to always return the diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el index c524f77f2bb..41753194c1b 100644 --- a/test/lisp/emacs-lisp/cl-extra-tests.el +++ b/test/lisp/emacs-lisp/cl-extra-tests.el @@ -104,23 +104,23 @@ (should (eq (cl-getf plist 'x) 1)) (should-not (cl-getf plist 'y :none)) (should (eq (cl-getf plist 'z :none) :none)) - (should (eq (cl-incf (cl-getf plist 'x 10) 2) 3)) + (should (eq (incf (cl-getf plist 'x 10) 2) 3)) (should (equal plist '(x 3 y nil))) - (should-error (cl-incf (cl-getf plist 'y 10) 4) :type 'wrong-type-argument) + (should-error (incf (cl-getf plist 'y 10) 4) :type 'wrong-type-argument) (should (equal plist '(x 3 y nil))) - (should (eq (cl-incf (cl-getf plist 'z 10) 5) 15)) + (should (eq (incf (cl-getf plist 'z 10) 5) 15)) (should (equal plist '(z 15 x 3 y nil)))) (let ((plist '(x 1 y))) (should (eq (cl-getf plist 'x) 1)) (should (eq (cl-getf plist 'y :none) :none)) (should (eq (cl-getf plist 'z :none) :none)) - (should (eq (cl-incf (cl-getf plist 'x 10) 2) 3)) + (should (eq (incf (cl-getf plist 'x 10) 2) 3)) (should (equal plist '(x 3 y))) - (should (eq (cl-incf (cl-getf plist 'y 10) 4) 14)) + (should (eq (incf (cl-getf plist 'y 10) 4) 14)) (should (equal plist '(y 14 x 3 y)))) (let ((plist '(x 1 y . 2))) (should (eq (cl-getf plist 'x) 1)) - (should (eq (cl-incf (cl-getf plist 'x 10) 2) 3)) + (should (eq (incf (cl-getf plist 'x 10) 2) 3)) (should (equal plist '(x 3 y . 2))) (should-error (cl-getf plist 'y :none) :type 'wrong-type-argument) (should-error (cl-getf plist 'z :none) :type 'wrong-type-argument))) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index bca5a12e398..a3118c9b556 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -92,22 +92,22 @@ "Test side effects generated by different arithmetic phrase order." :expected-result :failed (should - (equal (let ((x 1)) (cl-loop for i from x to 10 by (cl-incf x) collect i)) + (equal (let ((x 1)) (cl-loop for i from x to 10 by (incf x) collect i)) '(1 3 5 7 9))) (should - (equal (let ((x 1)) (cl-loop for i from x by (cl-incf x) to 10 collect i)) + (equal (let ((x 1)) (cl-loop for i from x by (incf x) to 10 collect i)) '(1 3 5 7 9))) (should - (equal (let ((x 1)) (cl-loop for i to 10 from x by (cl-incf x) collect i)) + (equal (let ((x 1)) (cl-loop for i to 10 from x by (incf x) collect i)) '(1 3 5 7 9))) (should - (equal (let ((x 1)) (cl-loop for i to 10 by (cl-incf x) from x collect i)) + (equal (let ((x 1)) (cl-loop for i to 10 by (incf x) from x collect i)) '(2 4 6 8 10))) (should - (equal (let ((x 1)) (cl-loop for i by (cl-incf x) from x to 10 collect i)) + (equal (let ((x 1)) (cl-loop for i by (incf x) from x to 10 collect i)) '(2 4 6 8 10))) (should - (equal (let ((x 1)) (cl-loop for i by (cl-incf x) to 10 from x collect i)) + (equal (let ((x 1)) (cl-loop for i by (incf x) to 10 from x collect i)) '(2 4 6 8 10)))) (ert-deftest cl-macs-loop-for-as-arith-invalid () @@ -154,7 +154,7 @@ (should (equal (cl-loop for x below 3 for y = (+ 10 x) nconc (list x y)) '(0 10 1 11 2 12))) (should (equal (cl-loop with start = 5 - for x = start then (cl-incf start) + for x = start then (incf start) repeat 5 collect x) '(5 6 7 8 9)))) @@ -324,7 +324,7 @@ collection clause." '(3 10 2 10 1 10))) (should (equal (cl-loop with res = 0 for i from 1 to 10 - doing (cl-incf res i) + doing (incf res i) finally (cl-return res)) 55)) (should (equal (cl-loop for i from 10 @@ -412,7 +412,7 @@ collection clause." (ert-deftest cl-macs-loop-finally () (should (eql (cl-loop for i from 10 finally - (cl-incf i 10) + (incf i 10) (cl-return i) while (< i 20)) 30))) @@ -421,7 +421,7 @@ collection clause." (ert-deftest cl-macs-loop-in-ref () (should (equal (cl-loop with my-list = (list 1 2 3 4 5) for x in-ref my-list - do (cl-incf x) + do (incf x) finally return my-list) '(2 3 4 5 6)))) @@ -443,7 +443,7 @@ collection clause." (ert-deftest cl-macs-loop-being-elements-of-ref () (should (equal (let ((var (list 1 2 3 4 5))) (cl-loop for x being the elements of-ref var - do (cl-incf x) + do (incf x) finally return var)) '(2 3 4 5 6)))) @@ -576,7 +576,7 @@ collection clause." (let ((cl (car l))) (cl-symbol-macrolet ((p (gv-synthetic-place cl (lambda (v) `(setcar l ,v))))) - (cl-incf p))) + (incf p))) l) '(1))) ;; Make sure `gv-synthetic-place' isn't macro-expanded before @@ -981,7 +981,7 @@ See Bug#57915." (should (eql (cl-the integer 42) 42)) (should-error (cl-the integer "abc")) (let ((side-effect 0)) - (should (= (cl-the integer (cl-incf side-effect)) 1)) + (should (= (cl-the integer (incf side-effect)) 1)) (should (= side-effect 1)))) (ert-deftest cl-lib-test-typep () diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el index 3e05ff639d7..6d9cec6f76c 100644 --- a/test/lisp/emacs-lisp/cl-seq-tests.el +++ b/test/lisp/emacs-lisp/cl-seq-tests.el @@ -109,13 +109,13 @@ Additionally register an `ert-info' to help identify test failures." (should (eql x (nth key-index list))) (prog1 (list key-index x) - (cl-incf key-index))) + (incf key-index))) :test (lambda (a b) (should (eql a 'foo)) (should (equal b (list test-index (nth test-index list)))) - (cl-incf test-index) + (incf test-index) (member test-index '(2 3)))))) (should (equal key-index 4)) (should (equal test-index 4)) @@ -160,7 +160,7 @@ Additionally register an `ert-info' to help identify test failures." (i 0)) (let ((result (cl-remove-if-not (lambda (x) (should (eql x (nth i list))) - (cl-incf i) + (incf i) (member i '(2 3))) list))) (should (equal i 4)) diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index 9f5b459c0e4..24981bb63cf 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -43,7 +43,7 @@ (result nil)) (while !lt!(< index num)!test! (push index result)!loop! - (cl-incf index))!end-loop! + (incf index))!end-loop! (nreverse result))) (defun edebug-test-code-choices (input) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index e56a89c7a72..02eadd34c8d 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -329,7 +329,7 @@ evaluate to \"symbol\", \"symbol-1\", \"symbol-2\", etc." (progn (push (cons ,g-name 0) ,names-and-numbers) ,g-name) - (cl-incf (cdr ,g-duplicate)) + (incf (cdr ,g-duplicate)) (format "%s-%s" ,g-name (cdr ,g-duplicate)))))) (defun edebug-tests-setup-code-file (tmpfile) diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el index 773619d8f03..01d2f978909 100644 --- a/test/lisp/emacs-lisp/generator-tests.el +++ b/test/lisp/emacs-lisp/generator-tests.el @@ -113,7 +113,7 @@ identical output." (cps-testcase cps-while-incf (let* ((i 0) (j 10)) (while (< i 10) - (cl-incf i) + (incf i) (setf j (+ j (* i 10)))) j)) @@ -273,7 +273,7 @@ identical output." (iter-yield 1) (error "Test") (iter-yield 2)) - (cl-incf nr-unwound)))))) + (incf nr-unwound)))))) (should (equal (iter-next iter) 1)) (should-error (iter-next iter)) (should (equal nr-unwound 1)))) diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el index 3333f4014e6..947a3854233 100644 --- a/test/lisp/emacs-lisp/hierarchy-tests.el +++ b/test/lisp/emacs-lisp/hierarchy-tests.el @@ -499,7 +499,7 @@ (let ((labelfn-base (lambda (_item _indent) (insert "foo"))) (spy-count 0) (condition (lambda (_item _indent) nil))) - (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count))))) + (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (incf spy-count))))) (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil) (should (equal spy-count 0))))) @@ -507,7 +507,7 @@ (let ((labelfn-base (lambda (_item _indent) (insert "foo"))) (spy-count 0) (condition (lambda (_item _indent) t))) - (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count))))) + (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (incf spy-count))))) (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil) (should (equal spy-count 1))))) diff --git a/test/lisp/emacs-lisp/let-alist-tests.el b/test/lisp/emacs-lisp/let-alist-tests.el index 1d04e91ab10..988b05b488c 100644 --- a/test/lisp/emacs-lisp/let-alist-tests.el +++ b/test/lisp/emacs-lisp/let-alist-tests.el @@ -69,9 +69,9 @@ (should (equal (let-alist (list - (cons 'test-two (cl-incf let-alist--test-counter)) - (cons 'test-three (cl-incf let-alist--test-counter))) - (list .test-one .test-two .test-two .test-three .cl-incf)) + (cons 'test-two (incf let-alist--test-counter)) + (cons 'test-three (incf let-alist--test-counter))) + (list .test-one .test-two .test-two .test-three .incf)) '(nil 1 1 2 nil))))) (ert-deftest let-alist-remove-dot () diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index 676d4f2ab4a..083030c73a6 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -71,7 +71,7 @@ noindent\" 3 (while (not (eobp)) (unless (looking-at "noindent\\|^[[:blank:]]*$") (insert (make-string n ?\s))) - (cl-incf n) + (incf n) (forward-line)))) (indent-sexp) (should (equal (buffer-string) correct)))))) @@ -194,7 +194,7 @@ a(A) --> (while (not (eobp)) (unless (looking-at "noindent\\|^[[:blank:]]*$") (insert (make-string n ?\s))) - (cl-incf n) + (incf n) (forward-line)))) (indent-region (point-min) (point-max)) (should (equal (buffer-string) correct))))) diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index fe4438b51ad..ce0f2b08275 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -121,49 +121,49 @@ Evaluate BODY for each created map." (let ((sort (lambda (map) (sort (map-pairs map) #'car-less-than-car)))) (with-empty-maps-do map ;; Empty map, without default. - (should-error (cl-incf (map-elt map 1)) :type 'wrong-type-argument) + (should-error (incf (map-elt map 1)) :type 'wrong-type-argument) (with-suppressed-warnings ((callargs map-elt)) - (should-error (cl-incf (map-elt map 1.0 nil #'=)) + (should-error (incf (map-elt map 1.0 nil #'=)) :type 'wrong-type-argument)) (should (map-empty-p map)) ;; Empty map, with default. (if (vectorp map) (progn - (should-error (cl-incf (map-elt map 1 3)) :type 'args-out-of-range) + (should-error (incf (map-elt map 1 3)) :type 'args-out-of-range) (with-suppressed-warnings ((callargs map-elt)) - (should-error (cl-incf (map-elt map 1 3 #'=)) + (should-error (incf (map-elt map 1 3 #'=)) :type 'args-out-of-range)) (should (map-empty-p map))) - (should (= (cl-incf (map-elt map 1 3) 10) 13)) + (should (= (incf (map-elt map 1 3) 10) 13)) (with-suppressed-warnings ((callargs map-elt)) - (should (= (cl-incf (map-elt map 2.0 5 #'=) 12) 17))) + (should (= (incf (map-elt map 2.0 5 #'=) 12) 17))) (should (equal (funcall sort map) '((1 . 13) (2.0 . 17)))))) (with-maps-do map ;; Nonempty map, without predicate. - (should (= (cl-incf (map-elt map 1 3) 10) 14)) + (should (= (incf (map-elt map 1 3) 10) 14)) (should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 5)))) ;; Nonempty map, with predicate. (with-suppressed-warnings ((callargs map-elt)) (pcase-exhaustive map ((pred consp) - (should (= (cl-incf (map-elt map 2.0 6 #'=) 12) 17)) + (should (= (incf (map-elt map 2.0 6 #'=) 12) 17)) (should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 17)))) - (should (= (cl-incf (map-elt map 0 7 #'=) 13) 16)) + (should (= (incf (map-elt map 0 7 #'=) 13) 16)) (should (equal (funcall sort map) '((0 . 16) (1 . 14) (2 . 17))))) ((pred vectorp) - (should-error (cl-incf (map-elt map 2.0 6 #'=)) + (should-error (incf (map-elt map 2.0 6 #'=)) :type 'wrong-type-argument) (should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 5)))) - (should (= (cl-incf (map-elt map 2 6 #'=) 12) 17)) + (should (= (incf (map-elt map 2 6 #'=) 12) 17)) (should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 17)))) - (should (= (cl-incf (map-elt map 0 7 #'=) 13) 16)) + (should (= (incf (map-elt map 0 7 #'=) 13) 16)) (should (equal (funcall sort map) '((0 . 16) (1 . 14) (2 . 17))))) ((pred hash-table-p) - (should (= (cl-incf (map-elt map 2.0 6 #'=) 12) 18)) + (should (= (incf (map-elt map 2.0 6 #'=) 12) 18)) (should (member (funcall sort map) '(((0 . 3) (1 . 14) (2 . 5) (2.0 . 18)) ((0 . 3) (1 . 14) (2.0 . 18) (2 . 5))))) - (should (= (cl-incf (map-elt map 0 7 #'=) 13) 16)) + (should (= (incf (map-elt map 0 7 #'=) 13) 16)) (should (member (funcall sort map) '(((0 . 16) (1 . 14) (2 . 5) (2.0 . 18)) ((0 . 16) (1 . 14) (2.0 . 18) (2 . 5))))))))))) @@ -718,7 +718,7 @@ See bug#58531#25 and bug#58563." (map nil)) (setf (map-elt map 'foo) (funcall (lambda () - (cl-incf num)))) + (incf num)))) (should (equal map '((foo . 1)))) ;; Check that the function is only called once. (should (= num 1)))) diff --git a/test/lisp/emacs-lisp/multisession-tests.el b/test/lisp/emacs-lisp/multisession-tests.el index 4c5da5eed5d..d2e39f662e9 100644 --- a/test/lisp/emacs-lisp/multisession-tests.el +++ b/test/lisp/emacs-lisp/multisession-tests.el @@ -41,7 +41,7 @@ "" :synchronized t) (should (= (multisession-value multisession--foo) 0)) - (cl-incf (multisession-value multisession--foo)) + (incf (multisession-value multisession--foo)) (should (= (multisession-value multisession--foo) 1)) (call-process (concat invocation-directory invocation-name) @@ -56,7 +56,7 @@ (define-multisession-variable multisession--foo 0 "" :synchronized t) - (cl-incf (multisession-value multisession--foo)))))) + (incf (multisession-value multisession--foo)))))) (should (= (multisession-value multisession--foo) 2))) (sqlite-close multisession--db) (setq multisession--db nil))))) @@ -75,7 +75,7 @@ "" :synchronized t) (should (= (multisession-value multisession--bar) 0)) - (cl-incf (multisession-value multisession--bar)) + (incf (multisession-value multisession--bar)) (should (= (multisession-value multisession--bar) 1)) (setq proc (start-process @@ -92,11 +92,11 @@ (define-multisession-variable multisession--bar 0 "" :synchronized t) (dotimes (i 100) - (cl-incf (multisession-value multisession--bar)))))))) + (incf (multisession-value multisession--bar)))))))) (while (process-live-p proc) (ignore-error sqlite-locked-error (message "multisession--bar %s" (multisession-value multisession--bar)) - ;;(cl-incf (multisession-value multisession--bar)) + ;;(incf (multisession-value multisession--bar)) ) (sleep-for 0.1)) (message "multisession--bar ends up as %s" (multisession-value multisession--bar)) @@ -114,7 +114,7 @@ "" :synchronized t) (should (= (multisession-value multisession--sfoo) 0)) - (cl-incf (multisession-value multisession--sfoo)) + (incf (multisession-value multisession--sfoo)) (should (= (multisession-value multisession--sfoo) 1)) ;; On Windows and Haiku, we don't have sub-second resolution, so ;; let some time pass to make the "later" logic work. @@ -133,7 +133,7 @@ (define-multisession-variable multisession--sfoo 0 "" :synchronized t) - (cl-incf (multisession-value multisession--sfoo)))))) + (incf (multisession-value multisession--sfoo)))))) (should (= (multisession-value multisession--sfoo) 2))))) (ert-deftest multi-test-files-busy () @@ -148,7 +148,7 @@ "" :synchronized t) (should (= (multisession-value multisession--sbar) 0)) - (cl-incf (multisession-value multisession--sbar)) + (incf (multisession-value multisession--sbar)) (should (= (multisession-value multisession--sbar) 1)) (setq proc (start-process @@ -165,10 +165,10 @@ (define-multisession-variable multisession--sbar 0 "" :synchronized t) (dotimes (i 100) - (cl-incf (multisession-value multisession--sbar)))))))) + (incf (multisession-value multisession--sbar)))))))) (while (process-live-p proc) (message "multisession--sbar %s" (multisession-value multisession--sbar)) - ;;(cl-incf (multisession-value multisession--sbar)) + ;;(incf (multisession-value multisession--sbar)) (sleep-for 0.1)) (message "multisession--sbar ends up as %s" (multisession-value multisession--sbar)) (should (< (multisession-value multisession--sbar) 200))))) diff --git a/test/lisp/emacs-lisp/oclosure-tests.el b/test/lisp/emacs-lisp/oclosure-tests.el index 38eec091ed0..beebe68b3f4 100644 --- a/test/lisp/emacs-lisp/oclosure-tests.el +++ b/test/lisp/emacs-lisp/oclosure-tests.el @@ -45,7 +45,7 @@ (ocl1 (oclosure-lambda (oclosure-test (fst 1) (snd 2) (name "hi")) () (list fst snd i))) - (ocl2 (oclosure-lambda (oclosure-test (name (cl-incf i)) (fst (cl-incf i))) + (ocl2 (oclosure-lambda (oclosure-test (name (incf i)) (fst (incf i))) () (list fst snd 152 i)))) (should (equal (list (oclosure-test--fst ocl1) @@ -142,7 +142,7 @@ (should (equal (oclosure-test-mut--mut f) 3)) (should (equal (funcall f 5) 8)) (should (equal (funcall f2 5) 58)) - (cl-incf (oclosure-test-mut--mut f) 7) + (incf (oclosure-test-mut--mut f) 7) (should (equal (oclosure-test-mut--mut f) 10)) (should (equal (funcall f 5) 15)) (should (equal (funcall f2 15) 68)))) diff --git a/test/lisp/emacs-lisp/track-changes-tests.el b/test/lisp/emacs-lisp/track-changes-tests.el index ef276af53e7..6499deb78d6 100644 --- a/test/lisp/emacs-lisp/track-changes-tests.el +++ b/test/lisp/emacs-lisp/track-changes-tests.el @@ -73,8 +73,8 @@ (should (eq before3 (if (symbolp before) before (length before))))))) - (cl-incf (aref sync-counts (1- n))) - (cl-incf (aref char-counts (1- n)) (- end beg)) + (incf (aref sync-counts (1- n))) + (incf (aref char-counts (1- n)) (- end beg)) (let ((after (buffer-substring beg end))) (track-changes-tests--message "Sync:\n %S\n=> %S\nat %d .. %d" diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 7f06c37a408..0e4f649d3d1 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -2023,7 +2023,7 @@ CALLERS-DIR specifies the value to let-bind (((symbol-function 'read-key) ;; Increase counter and answer 'n' when prompted ;; to save a buffer. - (lambda (&rest _) (cl-incf nb-saved-buffers) ?n)) + (lambda (&rest _) (incf nb-saved-buffers) ?n)) ;; Do not kill Emacs. ((symbol-function 'kill-emacs) #'ignore) (save-some-buffers-default-predicate callers-dir)) diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el index 46e19485a09..4c2fdf0cc70 100644 --- a/test/lisp/net/shr-tests.el +++ b/test/lisp/net/shr-tests.el @@ -154,7 +154,7 @@ settings, then once more for each (OPTION . VALUE) pair.") (put-image-calls 0) (shr-put-image-function (lambda (&rest args) - (cl-incf put-image-calls) + (incf put-image-calls) (apply #'shr-put-image args))) (shr-width 80) (shr-use-fonts nil) diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 60ea3fc1b2b..51f7ddb25f0 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -541,7 +541,7 @@ Return the last evalled form in BODY." ;; bind `read-string' as well. (cl-letf (((symbol-function 'read-event) (lambda (&rest _args) - (cl-incf ,count) + (incf ,count) (pcase ,count ; Build the clauses from CHAR-NUMS ,@(append (delq nil diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 4d608fa9d24..b4b9e761986 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -1753,7 +1753,7 @@ quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt, explicabo. ")) (while (< iteration-count iteration-target) - (cl-incf iteration-count) + (incf iteration-count) ;; Toggle GROWING if we've reached a size boundary. The idea ;; is to initially steadily increase the overlay count, then @@ -1780,7 +1780,7 @@ dicta sunt, explicabo. ")) (ov (make-overlay begin end nil (= 0 (random 2)) (= 0 (random 2))))) (aset overlays overlay-count ov) - (cl-incf overlay-count))) + (incf overlay-count))) ((and (not create-overlay) (> overlay-count 0)) ;; Possibly delete a random overlay. diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 44c786ac579..260bdb281bb 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -185,7 +185,7 @@ this is exactly representable and is greater than (dolist (n (nreverse nibbles)) (dotimes (_ 4) (aset bv i (oddp n)) - (cl-incf i) + (incf i) (setf n (ash n -1))))) bv)) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index eebc92bfd41..3d6cd5de8fe 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -345,7 +345,7 @@ (counter 0) (my-counter (lambda () (if (< counter 500) - (cl-incf counter) + (incf counter) (setq counter 0) (garbage-collect)))) (rand 1) diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 941caae9431..94b6cfcffca 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -357,7 +357,7 @@ Test with both unibyte and multibyte strings." (let ((calls 0)) (add-hook 'after-change-functions (lambda (_begin _end _length) - (cl-incf calls) + (incf calls) (signal 'json-tests--error '("Error in `after-change-functions'"))) :local) @@ -371,7 +371,7 @@ Test with both unibyte and multibyte strings." (let ((calls 0)) (add-hook 'after-change-functions (lambda (_begin _end _length) - (cl-incf calls) + (incf calls) (throw 'test-tag 'throw-value)) :local) (should diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index ec8f7123234..2f932eacc4a 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -29,10 +29,10 @@ (mapcar #'intern list)) (defun minibuf-tests--strings-to-symbol-alist (list) (let ((num 0)) - (mapcar (lambda (str) (cons (intern str) (cl-incf num))) list))) + (mapcar (lambda (str) (cons (intern str) (incf num))) list))) (defun minibuf-tests--strings-to-string-alist (list) (let ((num 0)) - (mapcar (lambda (str) (cons str (cl-incf num))) list))) + (mapcar (lambda (str) (cons str (incf num))) list))) (defun minibuf-tests--strings-to-obarray (list) (let ((ob (obarray-make 7))) (mapc (lambda (str) (intern str ob)) list) @@ -40,12 +40,12 @@ (defun minibuf-tests--strings-to-string-hashtable (list) (let ((ht (make-hash-table :test #'equal)) (num 0)) - (mapc (lambda (str) (puthash str (cl-incf num) ht)) list) + (mapc (lambda (str) (puthash str (incf num) ht)) list) ht)) (defun minibuf-tests--strings-to-symbol-hashtable (list) (let ((ht (make-hash-table :test #'equal)) (num 0)) - (mapc (lambda (str) (puthash (intern str) (cl-incf num) ht)) list) + (mapc (lambda (str) (puthash (intern str) (incf num) ht)) list) ht)) ;;; Functions that produce a predicate (for *-completion functions) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 21972b86aa0..7634cec2207 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -352,7 +352,7 @@ works as expected if a file name handler is found." (should (equal args '(make-process :name "name" :command ("/some/binary") :file-handler t))) - (cl-incf file-handler-calls) + (incf file-handler-calls) 'fake-process)) (let ((file-name-handler-alist (list (cons (rx bos "test-handler:") #'file-handler))) commit 9d7d4db7eb3398e754872f4c82d3d2071ae10fb2 Author: Stefan Kangas Date: Sat Feb 22 19:06:11 2025 +0100 Prefer decf to cl-decf * lisp/auth-source-pass.el (auth-source-pass--find-match-many): * lisp/calendar/time-date.el (decoded-time-add) (decoded-time--alter-month, decoded-time--alter-day): * lisp/dired.el (dired--move-to-next-line): * lisp/dom.el (dom-pp): * lisp/emacs-lisp/cl-macs.el (cl--transform-lambda): * lisp/emacs-lisp/cl-print.el (cl-print-to-string-with-limit): * lisp/emacs-lisp/cl-seq.el (cl-fill, cl-replace, cl-substitute): * lisp/emacs-lisp/comp-cstr.el (comp--range-union) (comp--range-intersection): * lisp/emacs-lisp/comp.el (comp-vec-prepend, comp--emit-narg-prologue): * lisp/emacs-lisp/edebug.el (edebug--strip-instrumentation): * lisp/emacs-lisp/eldoc.el (eldoc--invoke-strategy): * lisp/emacs-lisp/pp.el (pp--format-definition): * lisp/emacs-lisp/smie.el (smie-config--guess-1): * lisp/eshell/esh-io.el (eshell-close-handle, eshell-set-output-handle): * lisp/gnus/gnus-async.el (gnus-async-prefetch-article): * lisp/gnus/gnus-group.el (gnus-group-mark-group) (gnus-group-yank-group): * lisp/gnus/gnus-salt.el (gnus-tree-forward-line): * lisp/gnus/gnus-score.el (gnus-decay-scores): * lisp/gnus/gnus-srvr.el (gnus-browse-toggle-subscription-at-point): * lisp/gnus/gnus-sum.el (gnus-build-sparse-threads, gnus-parent-headers) (gnus-update-marks, gnus-summary-work-articles) (gnus-summary-refer-parent-article, gnus-summary-next-thread) (gnus-read-header, gnus-summary-insert-new-articles): * lisp/gnus/gnus-topic.el (gnus-topic-forward-topic): * lisp/gnus/gnus.el (gnus-short-group-name): * lisp/gnus/message.el (message-remove-first-header) (message-shorten-references, message-insert-screenshot): * lisp/gnus/mm-url.el (mm-url-insert): * lisp/gnus/nnselect.el (nnselect-push-info): * lisp/ibuffer.el (ibuffer-backward-line, ibuffer-forward-line) (ibuffer-map-lines): * lisp/icomplete.el (icomplete--render-vertical): * lisp/image/image-dired-external.el (image-dired-create-thumb-1): * lisp/image/image-dired.el (image-dired-delete-char): * lisp/mail/ietf-drums-date.el (ietf-drums-date--tokenize-string): * lisp/mh-e/mh-utils.el (mh-sub-folders-parse): * lisp/minibuffer.el (minibuffer-completion-help): * lisp/mpc.el (mpc-cmd-move, mpc-songpointer-refresh-hairy): * lisp/net/eww.el (eww-process-text-input): * lisp/net/pop3.el (pop3-wait-for-messages, pop3-uidl-stat) (pop3-uidl-dele): * lisp/net/shr-color.el (shr-color-hue-to-rgb): * lisp/play/5x5.el (5x5-up, 5x5-left): * lisp/play/decipher.el (decipher-read-alphabet, decipher--digram-total) (decipher-analyze-buffer): * lisp/play/hanoi.el (hanoi-insert-ring, hanoi-move-ring): * lisp/profiler.el (profiler-format-number) (profiler-calltree-build-unified): * lisp/progmodes/antlr-mode.el (antlr-next-rule, antlr-indent-line): * lisp/progmodes/c-ts-common.el (c-ts-common-statement-offset): * lisp/progmodes/ebrowse.el (ebrowse-cyclic-display-next/previous-member-list): * lisp/progmodes/hideif.el (hif-backward-comment): * lisp/progmodes/js.el (js-beginning-of-defun, js-end-of-defun) (js-ts--syntax-propertize): * lisp/progmodes/typescript-ts-mode.el (tsx-ts--syntax-propertize-captures): * lisp/rect.el (rectangle--*-char): * lisp/term.el (term-emulate-terminal): * lisp/textmodes/reftex-cite.el (reftex-do-citation): * lisp/textmodes/reftex-index.el (reftex-index-next-phrase): * lisp/textmodes/reftex-parse.el (reftex-init-section-numbers): * lisp/textmodes/reftex-sel.el (reftex-select-unmark): * lisp/textmodes/reftex.el (reftex-silence-toc-markers): * lisp/treesit.el (treesit-navigate-thing): * lisp/vc/diff-mode.el (diff-sanity-check-context-hunk-half, (diff-sanity-check-hunk): * lisp/vc/pcvs-util.el (cvs-first): * lisp/vc/smerge-mode.el (smerge-get-current): * lisp/vc/vc-hg.el (vc-hg--glob-to-pcre): * test/lisp/net/socks-tests.el (socks-tests-perform-hello-world-http-request): * test/src/buffer-tests.el (test-overlay-randomly): Prefer decf to cl-defc in all code where we can. diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index c23ef59f8e4..e68a3e9129e 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -314,13 +314,13 @@ HOSTS can be a string or a list of strings." ,@(and secret (not (eq secret t)) (list :secret secret))) (if (setq suffixedp (plist-get m :suffix)) suffixed out)) (unless suffixedp - (when (or (zerop (cl-decf max)) + (when (or (zerop (decf max)) (null (setq entries (delete e entries)))) (throw 'done out))))) (setq suffixed (nreverse suffixed)) (while suffixed (push (pop suffixed) out) - (when (zerop (cl-decf max)) + (when (zerop (decf max)) (throw 'done out)))))))))) (defun auth-source-pass--disambiguate (host &optional user port) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 1c8b27cf19e..959c4f17571 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -561,7 +561,7 @@ changes in daylight saving time are not taken into account." (days (abs days))) (while (> days 0) (decoded-time--alter-day time increase) - (cl-decf days)))) + (decf days)))) ;; Do the time part, which is pretty simple (except for leap ;; seconds, I guess). @@ -585,10 +585,10 @@ changes in daylight saving time are not taken into account." (when (> (decoded-time-month time) 12) (setf (decoded-time-month time) 1) (cl-incf (decoded-time-year time)))) - (cl-decf (decoded-time-month time)) + (decf (decoded-time-month time)) (when (zerop (decoded-time-month time)) (setf (decoded-time-month time) 12) - (cl-decf (decoded-time-year time))))) + (decf (decoded-time-year time))))) (defun decoded-time--alter-day (time increase) "Increase or decrease the day in TIME by 1." @@ -600,7 +600,7 @@ changes in daylight saving time are not taken into account." (decoded-time-month time))) (setf (decoded-time-day time) 1) (decoded-time--alter-month time t))) - (cl-decf (decoded-time-day time)) + (decf (decoded-time-day time)) (when (zerop (decoded-time-day time)) (decoded-time--alter-month time nil) (setf (decoded-time-day time) diff --git a/lisp/dired.el b/lisp/dired.el index e3c686270ac..90a70b057ec 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2947,7 +2947,7 @@ is controlled by `dired-movement-style'." (unless (dired-between-files) ;; Has moved to a non-empty line. This movement does ;; make sense. - (cl-decf arg moving-down)) + (decf arg moving-down)) (setq old-position (point))))) (defun dired-previous-line (arg) diff --git a/lisp/dom.el b/lisp/dom.el index 4d904c92de9..5de9cdb1302 100644 --- a/lisp/dom.el +++ b/lisp/dom.el @@ -234,7 +234,7 @@ white-space." (insert "(") (dolist (elem attr) (insert (format "(%S . %S)" (car elem) (cdr elem))) - (if (zerop (cl-decf times)) + (if (zerop (decf times)) (insert ")") (insert "\n" (make-string column ?\s)))))) (let* ((children (if remove-empty @@ -254,7 +254,7 @@ white-space." (string-match "\\`[\n\r\t  ]*\\'" child))) (insert (format "%S" child))) (dom-pp child remove-empty)) - (if (zerop (cl-decf times)) + (if (zerop (decf times)) (insert ")") (insert "\n" (make-string (1+ column) ?\s)))))))) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 2712dae0d5e..0682a162422 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -336,7 +336,7 @@ FORM is of the form (ARGS . BODY)." (format "%S" (cons 'fn (cl--make-usage-args orig-args)))))))) (when (memq '&optional simple-args) - (cl-decf slen)) + (decf slen)) (setq header (cons (if (eq :documentation (car-safe (car header))) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 5af34361b92..427f32862b2 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -636,10 +636,10 @@ abbreviating it with ellipses to fit within a size limit." (throw 'done (buffer-string))) (let* ((ratio (/ result limit)) (delta-level (max 1 (min (- print-level 2) ratio)))) - (cl-decf print-level delta-level) - (cl-decf print-length (* delta-length delta-level)) + (decf print-level delta-level) + (decf print-length (* delta-length delta-level)) (when cl-print-string-length - (cl-decf cl-print-string-length + (decf cl-print-string-length (ceiling cl-print-string-length 4.0)))))))))) (provide 'cl-print) diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index 651de6c4d47..e9c1e531656 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -171,7 +171,7 @@ FUNCTION is also reversed. (if (listp cl-seq) (let ((p (nthcdr cl-start cl-seq)) (n (and cl-end (- cl-end cl-start)))) - (while (and p (or (null n) (>= (cl-decf n) 0))) + (while (and p (or (null n) (>= (decf n) 0))) (setcar p cl-item) (setq p (cdr p)))) (or cl-end (setq cl-end (length cl-seq))) @@ -206,7 +206,7 @@ SEQ1 is destructively modified, then returned. (min cl-n1 (- cl-end2 cl-start2))) ((and cl-n1 (null cl-end2)) cl-n1) ((and (null cl-n1) cl-end2) (- cl-end2 cl-start2))))) - (while (and cl-p1 cl-p2 (or (null cl-n) (>= (cl-decf cl-n) 0))) + (while (and cl-p1 cl-p2 (or (null cl-n) (>= (decf cl-n) 0))) (setcar cl-p1 (car cl-p2)) (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))) (setq cl-end2 (if (null cl-n1) @@ -440,7 +440,7 @@ to avoid corrupting the original SEQ. (unless cl-from-end (setf (elt cl-seq cl-i) cl-new) (cl-incf cl-i) - (cl-decf cl-count)) + (decf cl-count)) (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count :start cl-i cl-keys)))))) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 3d46cc8c6ae..3d46bca30ac 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -453,7 +453,7 @@ Return them as multiple value." do (when (= nest 1) (push `(,(comp-range-1+ low) . ,i) res)) - (cl-decf nest) + (decf nest) finally return (reverse res))) (defun comp--range-intersection (&rest ranges) @@ -485,7 +485,7 @@ Return them as multiple value." (when (= nest n-ranges) (push `(,low . ,i) res)) - (cl-decf nest) + (decf nest) finally return (reverse res))) (defun comp--range-negation (range) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 0da007afebb..2baf4ec4b74 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -341,7 +341,7 @@ Returns ELT." "Prepend ELT into VEC. Returns ELT." (puthash (1- (comp-vec-beg vec)) elt (comp-vec-data vec)) - (cl-decf (comp-vec-beg vec)) + (decf (comp-vec-beg vec)) elt) @@ -1543,7 +1543,7 @@ and the annotation emission." (comp--emit `(set-rest-args-to-local ,(comp--slot-n nonrest))) (setf (comp--sp) nonrest) (when (and (> nonrest 8) (null rest)) - (cl-decf (comp--sp)))) + (decf (comp--sp)))) (defun comp--limplify-finalize-function (func) "Reverse insns into all basic blocks of FUNC." diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 6fcce8d30e0..1d66012e03b 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -4255,7 +4255,7 @@ code location is known." (let ((new-frame (copy-edebug--frame frame)) (fun (edebug--frame-fun frame)) (args (edebug--frame-args frame))) - (cl-decf index) ;; FIXME: Not used? + (decf index) ;; FIXME: Not used? (pcase fun ('edebug-enter (setq skip-next-lambda t diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 81890268dd7..f1ce52d196b 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -923,7 +923,7 @@ the docstrings eventually produced, using (cl-incf want) (lambda (string &rest plist) (register-doc pos string plist origin) - (when (zerop (cl-decf want)) (display-doc)) + (when (zerop (decf want)) (display-doc)) t)) (:eager (lambda (string &rest plist) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 6df15b197c8..3e75807f757 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -592,7 +592,7 @@ the bounds of a region containing Lisp code to pretty-print." (pp--insert-lisp (car sexp))) (pop sexp)) (pop edebug) - (cl-decf indent)) + (decf indent)) (when (stringp (car sexp)) (insert "\n") (prin1 (pop sexp) (current-buffer))) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 98ed7eb5e29..e0c2d567b47 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -2240,7 +2240,7 @@ position corresponding to each rule." (push off-data (nth 1 sig-data)) off-data)))) (cl-assert (>= (cdr ooff-data) count)) - (cl-decf (cdr ooff-data) count) + (decf (cdr ooff-data) count) (cl-incf (cdr noff-data) count)))))))))) rules)) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index fb2af40a42b..c4f7ebf12e0 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -409,7 +409,7 @@ be a non-nil value on successful termination." (cl-assert (> (cdar handle) 0) "Attempted to close a handle with 0 references") (when (and (> (cdar handle) 0) - (= (cl-decf (cdar handle)) 0)) + (= (decf (cdar handle)) 0)) (dolist (target (caar handle)) (eshell-close-target target status)) (setcar (car handle) nil)))) @@ -428,7 +428,7 @@ current list of targets." (aset handles index (list (cons nil 1) nil)))) (defaultp (cadr handle))) (when defaultp - (cl-decf (cdar handle)) + (decf (cdar handle)) (setcar handle (cons nil 1))) (let ((current (caar handle)) (where (eshell-get-target target mode))) diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index 860e9bcee59..4410bed5c03 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -178,7 +178,7 @@ that was fetched." d) (while (and (setq d (pop data)) (if (numberp n) - (natnump (cl-decf n)) + (natnump (decf n)) n)) (unless (or (gnus-async-prefetched-article-entry group (setq article (gnus-data-number d))) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index e3fbbba02ec..d1536292521 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1830,7 +1830,7 @@ current line is also eligible as a target." (gnus-group-mark-update group unmark))) (unless no-advance (gnus-group-next-group 1)) - (cl-decf n)) + (decf n)) (gnus-group-position-point) n)) @@ -4012,7 +4012,7 @@ yanked) a list of yanked groups is returned." (interactive "p" gnus-group-mode) (setq arg (or arg 1)) (let (info group prev out) - (while (>= (cl-decf arg) 0) + (while (>= (decf arg) 0) (when (not (setq info (pop gnus-list-of-killed-groups))) (error "No more newsgroups to yank")) (push (setq group (nth 1 info)) out) diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 6514d8d4174..f6f62de3b37 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -715,7 +715,7 @@ it in the environment specified by BINDINGS." (insert (make-string len ? ))))) (defsubst gnus-tree-forward-line (n) - (while (>= (cl-decf n) 0) + (while (>= (decf n) 0) (unless (zerop (forward-line 1)) (end-of-line) (insert "\n"))) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 0551ca2676d..4f6c12a81ba 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -3179,7 +3179,7 @@ The decay variables are `gnus-score-decay-constant' and (setq score (or (nth 1 kill) gnus-score-interactive-default-score) n times) - (while (natnump (cl-decf n)) + (while (natnump (decf n)) (setq score (funcall gnus-decay-score-function score))) (setcdr kill (cons score (cdr (cdr kill))))))))) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index fb96a1ab61f..92a0e949bb7 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -940,7 +940,7 @@ how new groups will be entered into the group buffer." (not (eobp)) (gnus-browse-toggle-subscription) (zerop (gnus-browse-next-group ward))) - (cl-decf arg)) + (decf arg)) (gnus-group-position-point) (when (/= 0 arg) (gnus-message 7 "No more newsgroups")) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index c909d9cfd5c..ed9948525f4 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -4479,7 +4479,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (push gnus-reffed-article-number gnus-newsgroup-sparse) (push (cons gnus-reffed-article-number gnus-sparse-mark) gnus-newsgroup-reads) - (cl-decf gnus-reffed-article-number))) + (decf gnus-reffed-article-number))) (gnus-message 7 "Making sparse threads...done"))) (defun gnus-build-old-threads () @@ -4737,7 +4737,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (setq parent (gnus-parent-id references))) (car (gnus-id-to-thread parent)) nil)) - (cl-decf generation)) + (decf generation)) (and (not (eq headers in-headers)) headers))) @@ -6152,7 +6152,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (let ((i 5)) (while (and (> i 2) (not (nth i info))) - (when (nthcdr (cl-decf i) info) + (when (nthcdr (decf i) info) (setcdr (nthcdr i info) nil))))))) (defun gnus-set-mode-line (where) @@ -6560,7 +6560,7 @@ current article will be taken into consideration." (if backward (gnus-summary-find-prev nil article) (gnus-summary-find-next nil article))) - (cl-decf n))) + (decf n))) (nreverse articles))) ((and (and transient-mark-mode mark-active) (mark)) (message "region active") @@ -8967,7 +8967,7 @@ The difference between N and the number of articles fetched is returned." (gnus-message 1 "No references in article %d" (gnus-summary-article-number)) (setq error t)) - (cl-decf n)) + (decf n)) (gnus-summary-position-point) n)) @@ -11898,7 +11898,7 @@ If SILENT, don't output messages." (n (abs n))) (while (and (> n 0) (gnus-summary-go-to-next-thread backward)) - (cl-decf n)) + (decf n)) (unless silent (gnus-summary-position-point)) (when (and (not silent) (/= 0 n)) @@ -12671,7 +12671,7 @@ If REVERSE, save parts that do not match TYPE." ;; article numbers for this article. (setf (mail-header-number header) gnus-reffed-article-number)) (with-current-buffer gnus-summary-buffer - (cl-decf gnus-reffed-article-number) + (decf gnus-reffed-article-number) (gnus-remove-header (mail-header-number header)) (push header gnus-newsgroup-headers) (setq gnus-current-headers header) @@ -13156,7 +13156,7 @@ If ALL is a number, fetch this number of articles." gnus-newsgroup-highest i) (while (> i old-high) (push i new) - (cl-decf i)) + (decf i)) (if (not new) (message "No gnus is bad news") (gnus-summary-insert-articles new) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index edd70d22351..f46ad458057 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -310,7 +310,7 @@ If RECURSIVE is t, return groups in its subtopics too." (while (and (not (zerop num)) (setq topic (funcall way topic))) (when (gnus-topic-goto-topic topic) - (cl-decf num))) + (decf num))) (unless (zerop num) (goto-char (point-max))) num)) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 756e28ebda5..37db8a96fa1 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -3787,7 +3787,7 @@ just the host name." gsep ".")) (setq levels (- glen levels)) (dolist (g glist) - (push (if (>= (cl-decf levels) 0) + (push (if (>= (decf levels) 0) (if (zerop (length g)) "" (substring g 0 1)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 46c3550418f..67c92ef9978 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2673,7 +2673,7 @@ Return the number of headers removed." (cl-incf count))) (while (> count 1) (message-remove-header header nil t) - (cl-decf count)))) + (decf count)))) (defun message-narrow-to-headers () "Narrow the buffer to the head of the message." @@ -6591,7 +6591,7 @@ they are." (when (> count maxcount) (let ((surplus (- count maxcount))) (message-shorten-1 refs cut surplus) - (cl-decf count surplus))) + (decf count surplus))) ;; When sending via news, make sure the total folded length will ;; be less than 998 characters. This is to cater to broken INN @@ -8929,7 +8929,7 @@ used to take the screenshot." (unless (executable-find (car message-screenshot-command)) (error "Can't find %s to take the screenshot" (car message-screenshot-command))) - (cl-decf delay) + (decf delay) (unless (zerop delay) (dotimes (i delay) (message "Sleeping %d second%s..." diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 3972ec002ee..9ac0f91f33e 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -310,7 +310,7 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META." (done nil) (first t) result) - (while (and (not (zerop (cl-decf times))) + (while (and (not (zerop (decf times))) (not done)) (with-timeout (mm-url-timeout) (unless first diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index 19d3936777f..eb9fd47dc0d 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -1029,7 +1029,7 @@ article came from is also searched." (let ((i 5)) (while (and (> i 2) (not (nth i group-info))) - (when (nthcdr (cl-decf i) group-info) + (when (nthcdr (decf i) group-info) (setcdr (nthcdr i group-info) nil)))) ;; update read and unread diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 4aac9be37cc..bba8d554215 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -940,7 +940,7 @@ width and the longest string in LIST." (when (get-text-property (point) 'ibuffer-title) (forward-line 1) (setq arg 1)) - (cl-decf arg))) + (decf arg))) (defun ibuffer-forward-line (&optional arg skip-group-names) "Move forward ARG lines, wrapping around the list if necessary." @@ -955,7 +955,7 @@ width and the longest string in LIST." (and skip-group-names (get-text-property (point) 'ibuffer-filter-group-name))) (when (> arg 0) - (cl-decf arg)) + (decf arg)) (ibuffer-skip-properties (append '(ibuffer-title) (when skip-group-names '(ibuffer-filter-group-name))) @@ -968,7 +968,7 @@ width and the longest string in LIST." (or (eobp) (get-text-property (point) 'ibuffer-summary))) (goto-char (point-min))) - (cl-decf arg) + (decf arg) (ibuffer-skip-properties (append '(ibuffer-title) (when skip-group-names '(ibuffer-filter-group-name))) @@ -1926,7 +1926,7 @@ the buffer object itself and the current mark symbol." (cl-incf ibuffer-map-lines-count) (when (< ibuffer-map-lines-total orig-target-line) - (cl-decf target-line-offset))) + (decf target-line-offset))) (t (cl-incf ibuffer-map-lines-count) (forward-line 1))))) diff --git a/lisp/icomplete.el b/lisp/icomplete.el index d1d1d4a9d81..c58bffbb36b 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -877,7 +877,7 @@ by `group-function''s second \"transformation\" protocol." for neighbor = nil if (and preds (> space-above 0)) do (push (setq neighbor (pop preds)) scroll-above) - (cl-decf space-above) + (decf space-above) else if (consp succs) collect (setq neighbor (pop succs)) into scroll-below-aux while neighbor diff --git a/lisp/image/image-dired-external.el b/lisp/image/image-dired-external.el index cec01ecef41..f09f676893d 100644 --- a/lisp/image/image-dired-external.el +++ b/lisp/image/image-dired-external.el @@ -424,7 +424,7 @@ on MS-Windows cannot have too many concurrent sub-processes.") (setf (process-sentinel process) (lambda (process status) ;; Trigger next in queue once a thumbnail has been created - (cl-decf image-dired-queue-active-jobs) + (decf image-dired-queue-active-jobs) (image-dired-thumb-queue-run) (when (= image-dired-queue-active-jobs 0) (image-dired-debug diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 8edc73d09b8..aff452b0f5c 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -1184,7 +1184,7 @@ With a negative prefix argument, prompt user for the delay." (interactive nil image-dired-thumbnail-mode) (let ((inhibit-read-only t)) (delete-char 1) - (cl-decf image-dired--number-of-thumbnails)) + (decf image-dired--number-of-thumbnails)) (let ((pos (point))) (image-dired--line-up-with-method) (goto-char pos) diff --git a/lisp/mail/ietf-drums-date.el b/lisp/mail/ietf-drums-date.el index c9be86eafd9..0f79e9353d3 100644 --- a/lisp/mail/ietf-drums-date.el +++ b/lisp/mail/ietf-drums-date.el @@ -88,7 +88,7 @@ treat them as whitespace (per RFC822)." ;; it to see if it might be a paren. (cl-incf index)) ((eq char ?\() (cl-incf nest)) - ((eq char ?\)) (cl-decf nest))))))) + ((eq char ?\)) (decf nest))))))) (skip-ignored) ;; Skip leading whitespace. (while (and (< index end) (not (and comment-eof diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index fc83f5618b9..1c6bc6833f0 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -578,7 +578,7 @@ This function is a testable helper of `mh-sub-folders-actual'." (line-beginning-position) t))) (when (integerp has-pos) (while (equal (char-after has-pos) ? ) - (cl-decf has-pos)) + (decf has-pos)) (cl-incf has-pos) (while (equal (char-after start-pos) ? ) (cl-incf start-pos)) @@ -603,7 +603,7 @@ This function is a testable helper of `mh-sub-folders-actual'." (let ((folder-name-len (length (format "%s/" (substring folder 1))))) (when (equal "+/" folder) ;; folder "+/" includes a trailing slash - (cl-decf folder-name-len)) + (decf folder-name-len)) (setq results (mapcar (lambda (f) (cons (substring (car f) folder-name-len) (cdr f))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 19b78173792..0368e533dab 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2772,7 +2772,7 @@ The candidate will still be chosen by `choose-completion' unless (setq end (1+ end))) ;; Tried to use a marker to track buffer changes ;; but that clashed with another existing marker. - (cl-decf (nth 1 base-position) + (decf (nth 1 base-position) (- end start (length choice))) ;; FIXME: Use `md' to do quoting&terminator here. (completion--replace start (min end (point-max)) choice) diff --git a/lisp/mpc.el b/lisp/mpc.el index e639129d86a..9e63c76a323 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -869,7 +869,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (list "move" song-pos dest-pos)) (if (< song-pos dest-pos) ;; This move has shifted dest-pos by 1. - (cl-decf dest-pos)) + (decf dest-pos)) (cl-incf i))) ;; Sort them from last to first, so the renumbering ;; caused by the earlier deletions affect @@ -2357,7 +2357,7 @@ This is used so that they can be compared with `eq', which is needed for (if (null new-context) ;; There isn't more context: choose one arbitrarily ;; and keep looking for a better match elsewhere. - (cl-decf context-size) + (decf context-size) (setq context new-context) (setq score (mpc-songpointer-score context pos)) (save-excursion diff --git a/lisp/net/eww.el b/lisp/net/eww.el index fcd0c8d9090..caee50a712f 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1805,7 +1805,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (while (and (> length 0) (eq (char-after (1- (point))) ? )) (delete-region (1- (point)) (point)) - (cl-decf length)))) + (decf length)))) ((< length 0) ;; Add padding. (save-excursion diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el index cd5390f11a1..a4de429311c 100644 --- a/lisp/net/pop3.el +++ b/lisp/net/pop3.el @@ -245,7 +245,7 @@ Use streaming commands." (or (not total-size) (re-search-forward "^\\.\r?\n" nil t))) (re-search-forward "^-ERR " nil t)) - (cl-decf count) + (decf count) (setq start-point (point))) (unless (memq (process-status process) '(open run)) (error "pop3 process died")) @@ -363,7 +363,7 @@ Use streaming commands." (while (> i 0) (unless (member (nth (1- i) pop3-uidl) saved) (push i messages)) - (cl-decf i))) + (decf i))) (when messages (setq list (pop3-list process) size 0) @@ -395,7 +395,7 @@ Return non-nil if it is necessary to update the local UIDL file." (unless (member (setq uidl (nth i pop3-uidl)) (cdr saved)) (push ctime new) (push uidl new)) - (cl-decf i))) + (decf i))) (pop3-uidl (setq new (mapcan (lambda (elt) (list elt ctime)) pop3-uidl)))) (when new (setq mod t)) @@ -416,7 +416,7 @@ Return non-nil if it is necessary to update the local UIDL file." (push uidl new))) ;; Mails having been deleted in the server. (setq mod t)) - (cl-decf i 2)) + (decf i 2)) (cond (saved (setcdr saved new)) (srvr @@ -432,7 +432,7 @@ Return non-nil if it is necessary to update the local UIDL file." (while (> i 0) (when (member (nth (1- i) pop3-uidl) dele) (push i uidl)) - (cl-decf i)) + (decf i)) (when uidl (pop3-send-streaming-command process "DELE" uidl nil))) mod)) diff --git a/lisp/net/shr-color.el b/lisp/net/shr-color.el index 7cfe23fee04..3f7b6f6df8f 100644 --- a/lisp/net/shr-color.el +++ b/lisp/net/shr-color.el @@ -209,7 +209,7 @@ This will convert \"80 %\" to 204, \"100 %\" to 255 but \"123\" to \"123\"." (defun shr-color-hue-to-rgb (x y h) "Convert X Y H to RGB value." (when (< h 0) (cl-incf h)) - (when (> h 1) (cl-decf h)) + (when (> h 1) (decf h)) (cond ((< h (/ 6.0)) (+ x (* (- y x) h 6))) ((< h 0.5) y) ((< h (/ 2.0 3.0)) (+ x (* (- y x) (- (/ 2.0 3.0) h) 6))) diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index e7638ef0f59..31b398a4bc1 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -858,7 +858,7 @@ lest." "Move up." (interactive nil 5x5-mode) (unless (zerop 5x5-y-pos) - (cl-decf 5x5-y-pos) + (decf 5x5-y-pos) (5x5-position-cursor))) (defun 5x5-down () @@ -872,7 +872,7 @@ lest." "Move left." (interactive nil 5x5-mode) (unless (zerop 5x5-x-pos) - (cl-decf 5x5-x-pos) + (decf 5x5-x-pos) (5x5-position-cursor))) (defun 5x5-right () diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index ac001697ff2..6b5a8d570db 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -603,7 +603,7 @@ You should use this if you edit the ciphertext." (while (>= plain-char ?a) (backward-char) (push (cons plain-char (following-char)) decipher-alphabet) - (cl-decf plain-char))))) + (decf plain-char))))) ;;;=================================================================== ;;; Analyzing ciphertext: @@ -832,7 +832,7 @@ TOTAL is the total number of letters in the ciphertext." ;; We do not include spaces (word divisions) in this count. (let ((total 0) (i 26)) - (while (>= (cl-decf i) 0) + (while (>= (decf i) 0) (if (or (> (aref before-count i) 0) (> (aref after-count i) 0)) (cl-incf total))) @@ -849,7 +849,7 @@ Creates the statistics buffer if it doesn't exist." decipher--digram decipher--digram-list freq-list) (message "Scanning buffer...") (let ((i 26)) - (while (>= (cl-decf i) 0) + (while (>= (decf i) 0) (aset decipher--before i (make-vector 27 0)) (aset decipher--after i (make-vector 27 0)))) (if decipher-ignore-spaces @@ -857,7 +857,7 @@ Creates the statistics buffer if it doesn't exist." (decipher-loop-no-breaks #'decipher--analyze) ;; The first character of ciphertext was marked as following a space: (let ((i 26)) - (while (>= (cl-decf i) 0) + (while (>= (decf i) 0) (aset (aref decipher--after i) 26 0)))) (decipher-loop-with-breaks #'decipher--analyze)) (message "Processing results...") @@ -872,7 +872,7 @@ Creates the statistics buffer if it doesn't exist." ;; of times it occurs, and DIFFERENT is the number of different ;; letters it appears next to. (let ((i 26)) - (while (>= (cl-decf i) 0) + (while (>= (decf i) 0) (setq freq-list (cons (list (+ i ?A) (aref decipher--freqs i) diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index 8bc8d77108b..41e5de7c1f4 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -318,7 +318,7 @@ BITS must be of length nrings. Start at START-TIME." ;; put never-before-placed RING on POLE and update their cars. (defun hanoi-insert-ring (ring pole) - (cl-decf (car pole) baseward-step) + (decf (car pole) baseward-step) (let ((str (car ring)) (start (- (car pole) (* (/ (cdr ring) 2) fly-step)))) (setcar ring (car pole)) @@ -338,7 +338,7 @@ BITS must be of length nrings. Start at START-TIME." ;; do one pole-to-pole move and update the ring and pole pairs. (defun hanoi-move-ring (ring from to start-time) (cl-incf (car from) baseward-step) - (cl-decf (car to) baseward-step) + (decf (car to) baseward-step) (let* ;; We move flywards-steps steps up the pole to the fly row, ;; then fly fly-steps steps across the fly row, then go ;; baseward-steps steps down the new pole. diff --git a/lisp/profiler.el b/lisp/profiler.el index 115bd4f74cb..57bd56af593 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -65,7 +65,7 @@ collect ?, into s and do (setq i 3) collect c into s - do (cl-decf i) + do (decf i) finally return (apply #'string (if (eq (car s) ?,) (cdr s) s))) (profiler-ensure-string number))) @@ -336,7 +336,7 @@ Optional argument MODE means only check for the specified mode (cpu or mem)." (cl-assert (function-equal (aref backtrace max) (aref parent i))) (while (progn - (cl-decf imatch) (cl-decf match) + (decf imatch) (decf match) (when (> imatch 0) (function-equal (aref backtrace match) (aref parent imatch))))) @@ -373,7 +373,7 @@ Optional argument MODE means only check for the specified mode (cpu or mem)." (let ((j (1- max))) (while (> j i) (let ((f (aref parent j))) - (cl-decf j) + (decf j) (when f (let ((child (profiler-calltree-find node f))) (unless child diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index d889f283aaf..4f17dd77b2a 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -1198,9 +1198,9 @@ is non-nil, move to beginning of the rule." (antlr-skip-exception-part skip-comment))) (if (<= (point) pos) ; moved backward? (goto-char pos) ; rewind - (cl-decf arg)) ; already moved one defun forward + (decf arg)) ; already moved one defun forward (unless (zerop arg) - (while (>= (cl-decf arg) 0) + (while (>= (decf arg) 0) (antlr-search-forward ";")) (antlr-skip-exception-part skip-comment))))) @@ -2276,7 +2276,7 @@ to a lesser extent, `antlr-tab-offset-alist'." (unless (symbolp syntax) ; direct indentation ;;(antlr-invalidate-context-cache) (cl-incf indent (antlr-syntactic-context)) - (and (> indent 0) (looking-at antlr-indent-item-regexp) (cl-decf indent)) + (and (> indent 0) (looking-at antlr-indent-item-regexp) (decf indent)) (setq indent (* indent c-basic-offset))) ;; the usual major-mode indent stuff --------------------------------- (setq orig (- (point-max) orig)) diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 250e3879b57..6e36b64f02a 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -491,7 +491,7 @@ characters on the current line." ;; one level because the code below assumes NODE is a statement ;; _inside_ a {} block. (when (c-ts-common--node-is node 'block 'close-bracket) - (cl-decf level)) + (decf level)) ;; If point is on an empty line, NODE would be nil, but we pretend ;; there is a statement node. (when (null node) @@ -530,7 +530,7 @@ characters on the current line." (goto-char (treesit-node-start node)) (looking-back (rx bol (* whitespace)) (line-beginning-position))))) - (cl-decf level))) + (decf level))) ;; Go up the tree. (setq node (treesit-node-parent node))) (* level (symbol-value c-ts-common-indent-offset)))) diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 9805a2bf04a..70e1a1e5904 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -2214,7 +2214,7 @@ make one." ebrowse-member-list-accessors) (cl-first ebrowse-member-list-accessors))) ((minusp incr) - (or (and (>= (cl-decf index) 0) + (or (and (>= (decf index) 0) (nth index ebrowse-member-list-accessors)) (cl-first (last ebrowse-member-list-accessors)))))) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 49788daa269..0d5797bb303 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -875,7 +875,7 @@ Assuming we've just performed a `hif-token-regexp' lookup." (setq end (or end (point))) (while (and (> (1- end) 1) (hif-is-white (char-after (1- end)))) - (cl-decf end)) + (decf end)) (let ((p0 end) p cmt ce ws we ;; ce:comment start, ws:white start, we whilte end cmtlist) ;; pair of (start.end) of comments @@ -938,7 +938,7 @@ Assuming we've just performed a `hif-token-regexp' lookup." ;; Ignore leading whites ahead of comment (while (and (> (1- cmt) 1) (hif-is-white (char-after (1- cmt)))) - (cl-decf cmt)) + (decf cmt)) (goto-char cmt))) (defun hif-tokenize (start end) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index f2acf9f40d6..bb91eea93f2 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1031,7 +1031,7 @@ Return the pitem of the function we went to the beginning of." (setq found nil))) (while (> arg 0) - (cl-decf arg) + (decf arg) ;; If we're just past the end of a function, the user probably wants ;; to go to the beginning of *that* function (when (eq (char-before) ?}) @@ -1367,7 +1367,7 @@ LIMIT defaults to point." (js-end-of-defun))) (while (> arg 0) - (cl-decf arg) + (decf arg) ;; look for function backward. if we're inside it, go to that ;; function's end. otherwise, search for the next function's end and ;; go there @@ -4036,7 +4036,7 @@ See `treesit-thing-settings' for more information.") (ne (treesit-node-end node)) (syntax (pcase-exhaustive name ('regexp - (cl-decf ns) + (decf ns) (cl-incf ne) (string-to-syntax "\"/")) ('jsx diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 43390cc19d2..34d9e8636d1 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -679,7 +679,7 @@ at least 3 (which is the default value)." (pcase-exhaustive name ('regexp (let ((syntax (string-to-syntax "\"/"))) - (cl-decf ns) + (decf ns) (cl-incf ne) (put-text-property ns (1+ ns) 'syntax-table syntax) (put-text-property (1- ne) ne 'syntax-table syntax))) diff --git a/lisp/rect.el b/lisp/rect.el index bc419c341a0..be99a3398df 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -718,13 +718,13 @@ on. Only lasts until the region is next deactivated." ((and (< nextcol curcol) (< curcol col)) (let ((curdiff (- col curcol))) (if (<= curdiff n) - (progn (cl-decf n curdiff) (setq col curcol)) + (progn (decf n curdiff) (setq col curcol)) (setq col (- col n) n 0)))) ((< nextcol 0) (ding) (setq n 0 col 0)) ;Bumping into BOL! ((= nextcol curcol) (funcall cmd 1)) (t ;; (> nextcol curcol) (if (<= diff n) - (progn (cl-decf n diff) (setq col nextcol)) + (progn (decf n diff) (setq col nextcol)) (setq col (if (< col nextcol) (+ col n) (- col n)) n 0)))) (setq step (1+ step)))) ;; FIXME: This rectangle--col-pos's move-to-column is wasted! diff --git a/lisp/term.el b/lisp/term.el index 67de50ad04f..a0ab2fc14e5 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -3116,8 +3116,8 @@ See `term-prompt-regexp'." (substring decoded-substring (- partial))) (setq decoded-substring (substring decoded-substring 0 (- partial))) - (cl-decf str-length partial) - (cl-decf funny partial)))) + (decf str-length partial) + (decf funny partial)))) ;; Insert a string, check how many columns ;; we moved, then delete that many columns diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 7e4d4e9f22a..fe6751a13f6 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -744,7 +744,7 @@ While entering the regexp, completion on known citation keys is possible. (if (> arg 1) (progn (skip-chars-backward "}") - (cl-decf arg) + (decf arg) (reftex-do-citation arg)) (forward-char 1))) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index a7930bb3c8f..5d4b1f38236 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -1396,7 +1396,7 @@ Here are all local bindings. (interactive "p") (reftex-index-phrases-parse-header t) (while (> arg 0) - (cl-decf arg) + (decf arg) (end-of-line) (if (re-search-forward reftex-index-phrases-phrase-regexp12 nil t) (progn diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index 855e11e1e49..d66b0b9064e 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -1090,7 +1090,7 @@ When point is just after a { or [, limit string to matching parenthesis." (- (string-to-char number-string) ?A -1)) (aset reftex-section-numbers i (string-to-number number-string))) (pop numbers)) - (cl-decf i))) + (decf i))) (put 'reftex-section-numbers 'appendix appendix)) ;;;###autoload diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index c3b38ffd0a0..7286c214f7a 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -705,8 +705,8 @@ Cycle in reverse order if optional argument REVERSE is non-nil." (setq sep (nth 2 c)) (overlay-put (nth 1 c) 'before-string (if sep - (format "*%c%d* " sep (cl-decf cnt)) - (format "*%d* " (cl-decf cnt))))) + (format "*%c%d* " sep (decf cnt)) + (format "*%d* " (decf cnt))))) reftex-select-marked) (message "Entry no longer marked"))) diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 8088ab391f5..54085f7f9e3 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -1149,7 +1149,7 @@ This enforces rescanning the buffer on next use." (defun reftex-silence-toc-markers (list n) ;; Set all toc markers in the first N entries in list to nil - (while (and list (> (cl-decf n) -1)) + (while (and list (> (decf n) -1)) (and (eq (car (car list)) 'toc) (markerp (nth 4 (car list))) (set-marker (nth 4 (car list)) nil)) diff --git a/lisp/treesit.el b/lisp/treesit.el index fe0dc38f324..6b7f54a04e7 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -3376,7 +3376,7 @@ function is called recursively." ;; Normal case. (setq pos (funcall advance (or prev parent)))))) ;; A successful step! Decrement counter. - (cl-decf counter)))) + (decf counter)))) ;; Counter equal to 0 means we successfully stepped ARG steps. (if (eq counter 0) pos nil))) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 5906f8a0571..cbdb721e8fa 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1713,7 +1713,7 @@ Only works for unified diffs." (cond ((and (memq (char-after) '(?\s ?! ?+ ?-)) (memq (char-after (1+ (point))) '(?\s ?\t))) - (cl-decf count) t) + (decf count) t) ((or (zerop count) (= count lines)) nil) ((memq (char-after) '(?! ?+ ?-)) (if (not (and (eq (char-after (1+ (point))) ?\n) @@ -1765,7 +1765,7 @@ Only works for unified diffs." (forward-line) (while (pcase (char-after) - (?\s (cl-decf before) (cl-decf after) t) + (?\s (decf before) (decf after) t) (?- (cond ((and (looking-at diff-separator-re) @@ -1780,15 +1780,15 @@ Only works for unified diffs." ;; will not get confused. (save-excursion (insert "\n")) nil) (t - (cl-decf before) t))) - (?+ (cl-decf after) t) + (decf before) t))) + (?+ (decf after) t) (_ (cond ((and diff-valid-unified-empty-line ;; Not just (eolp) so we don't infloop at eob. (eq (char-after) ?\n) (> before 0) (> after 0)) - (cl-decf before) (cl-decf after) t) + (decf before) (decf after) t) ((and (zerop before) (zerop after)) nil) ((or (< before 0) (< after 0)) (error (if (or (zerop before) (zerop after)) diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el index a1d6214eaa1..dabf753dd82 100644 --- a/lisp/vc/pcvs-util.el +++ b/lisp/vc/pcvs-util.el @@ -46,7 +46,7 @@ (while (and l (> n 1)) (setcdr nl (list (pop l))) (setq nl (cdr nl)) - (cl-decf n)) + (decf n)) ret)))) (defun cvs-partition (p l) diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index f77b73c6170..d1b27f6763b 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -724,7 +724,7 @@ this keeps \"UUU\"." (while (or (not (match-end i)) (< (point) (match-beginning i)) (> (point) (match-end i))) - (cl-decf i)) + (decf i)) i)) (defun smerge-keep-current () diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 21292be09fb..afc31be8ef1 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -850,7 +850,7 @@ if we don't understand a construct, we signal (push "(?:" parts)) ((eq c ?\}) (push ?\) parts) - (cl-decf group)) + (decf group)) ((and (eq c ?,) (> group 0)) (push ?| parts)) ((eq c ?\\) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index bc9150f84fc..7531ff70846 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -181,7 +181,7 @@ Vectors must match verbatim. Strings are considered regex patterns.") (buf (url-http url cb '(nil))) (proc (get-buffer-process buf)) (attempts 10)) - (while (and (not done) (< 0 (cl-decf attempts))) + (while (and (not done) (< 0 (decf attempts))) (sleep-for 0.1)) (should done) (delete-process server) diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index e5369f5363d..4d608fa9d24 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -1790,7 +1790,7 @@ dicta sunt, explicabo. ")) (when (< index last-index) (aset overlays index (aref overlays last-index))) (aset overlays last-index nil) - (cl-decf overlay-count) + (decf overlay-count) (delete-overlay ov))))) ;; Modify the buffer on occasion, which exercises the commit 95fee880e45184f4820e9704b75887ef2d91bd01 Author: Stefan Kangas Date: Sat Feb 22 17:32:31 2025 +0100 New macros incf and decf * lisp/emacs-lisp/cl-lib.el (cl-incf, cl-decf): Move macros from here... * lisp/emacs-lisp/gv.el (incf, decf): ...to here. Make old names into aliases, documented as deprecated. * lisp/obsolete/cl.el: Don't alias incf and decf. * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-test-incf) (cl-lib-test-decf): Move tests from here... * test/lisp/emacs-lisp/gv-tests.el (gv-incf, gv-decf): ...to here. * doc/lispref/numbers.texi (Arithmetic Operations): * lisp/emacs-lisp/shortdoc.el (number): Document incf and decf. * doc/lispref/variables.texi (Multisession Variables): * doc/misc/cl.texi (Organization, Modify Macros, Modify Macros) (Modify Macros, Macro Bindings, For Clauses, Property Lists) (Structures, Efficiency Concerns, Obsolete Setf Customization): Delete cl-incf and cl-decf documentation, moving any relevant parts to lispref. Delete some parts that seem to primarily regard implementation details that do not warrant inclusion in lispref. Update all examples to use incf/decf. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 17fa1e05fee..29105959ecd 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -668,8 +668,8 @@ foo @result{} 4 @end example -If you want to increment the variable, you must use @code{setq}, -like this: +If you want to increment the variable, you must use @code{setq} (or +@code{incf}), like this: @example (setq foo (1+ foo)) @@ -681,6 +681,21 @@ like this: This function returns @var{number-or-marker} minus 1. @end defun +@defmac incf place &optional delta +This macro increments the number stored in @var{place} by one, or +by @var{delta} if specified. The incremented value is returned. + +@var{place} can be a symbol or a generalized variable, @xref{Generalized +Variables}. For example, @code{(incf i)} is equivalent to +@code{(setq i (1+ i))}, and @code{(incf (car x) 2)} is equivalent to +@code{(setcar x (+ (car x) 2))}. +@end defmac + +@defmac decf place &optional delta +This macro decrements the number stored in @var{place} by one, or +by @var{delta} if specified. The decremented value is returned. +@end defmac + @defun + &rest numbers-or-markers This function adds its arguments together. When given no arguments, @code{+} returns 0. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 998a74d067a..46027edb041 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -3130,7 +3130,7 @@ If the multisession variable is synchronized, setting it may update the value first. For instance: @lisp -(cl-incf (multisession-value foo-bar)) +(incf (multisession-value foo-bar)) @end lisp This first checks whether the value has changed in a different diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index f95900a085e..8fb308e64a5 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -168,9 +168,6 @@ and information about the package. This file is relatively compact. @item cl-extra.el This file contains the larger, more complex or unusual functions. -It is kept separate so that packages which only want to use Common -Lisp fundamentals like the @code{cl-incf} function won't need to pay -the overhead of loading the more advanced functions. @item cl-seq.el This file contains most of the advanced functions for operating @@ -197,8 +194,8 @@ this package prior to Emacs 24.3. Nowadays, it is replaced by but use different function names (in fact, @file{cl.el} mainly just defines aliases to the @file{cl-lib.el} definitions). Where @file{cl-lib.el} defines a function called, for example, -@code{cl-incf}, @file{cl.el} uses the same name but without the -@samp{cl-} prefix, e.g., @code{incf} in this example. There are a few +@code{cl-first}, @file{cl.el} uses the same name but without the +@samp{cl-} prefix, e.g., @code{first} in this example. There are a few exceptions to this. First, functions such as @code{cl-defun} where the unprefixed version was already used for a standard Emacs Lisp function. In such cases, the @file{cl.el} version adds a @samp{*} @@ -1028,7 +1025,7 @@ generalized variables. @menu * Setf Extensions:: Additional @code{setf} places. -* Modify Macros:: @code{cl-incf}, @code{cl-rotatef}, @code{cl-letf}, @code{cl-callf}, etc. +* Modify Macros:: @code{cl-rotatef}, @code{cl-letf}, @code{cl-callf}, etc. @end menu @node Setf Extensions @@ -1085,52 +1082,6 @@ Specifically, all subforms are evaluated from left to right, then all the assignments are done (in an undefined order). @end defmac -@defmac cl-incf place &optional x -This macro increments the number stored in @var{place} by one, or -by @var{x} if specified. The incremented value is returned. For -example, @code{(cl-incf i)} is equivalent to @code{(setq i (1+ i))}, and -@code{(cl-incf (car x) 2)} is equivalent to @code{(setcar x (+ (car x) 2))}. - -As with @code{setf}, care is taken to preserve the ``apparent'' order -of evaluation. For example, - -@example -(cl-incf (aref vec (cl-incf i))) -@end example - -@noindent -appears to increment @code{i} once, then increment the element of -@code{vec} addressed by @code{i}; this is indeed exactly what it -does, which means the above form is @emph{not} equivalent to the -``obvious'' expansion, - -@example -(setf (aref vec (cl-incf i)) - (1+ (aref vec (cl-incf i)))) ; wrong! -@end example - -@noindent -but rather to something more like - -@example -(let ((temp (cl-incf i))) - (setf (aref vec temp) (1+ (aref vec temp)))) -@end example - -@noindent -Again, all of this is taken care of automatically by @code{cl-incf} and -the other generalized-variable macros. - -As a more Emacs-specific example of @code{cl-incf}, the expression -@code{(cl-incf (point) @var{n})} is essentially equivalent to -@code{(forward-char @var{n})}. -@end defmac - -@defmac cl-decf place &optional x -This macro decrements the number stored in @var{place} by one, or -by @var{x} if specified. -@end defmac - @defmac cl-pushnew x place @t{&key :test :test-not :key} This macro inserts @var{x} at the front of the list stored in @var{place}, but only if @var{x} isn't present in the list already. @@ -1243,8 +1194,8 @@ It does the bindings in sequential rather than parallel order. This is the ``generic'' modify macro. It calls @var{function}, which should be an unquoted function name, macro name, or lambda. It passes @var{place} and @var{args} as arguments, and assigns the -result back to @var{place}. For example, @code{(cl-incf @var{place} -@var{n})} is the same as @code{(cl-callf + @var{place} @var{n})}. +result back to @var{place}. For example, @code{(incf @var{place} +@var{n})} could be implemented as @code{(cl-callf + @var{place} @var{n})}. Some more examples: @example @@ -1264,7 +1215,7 @@ equivalent to @code{(cl-callf2 cons @var{x} @var{place})}. @end defmac The @code{cl-callf} and @code{cl-callf2} macros serve as building -blocks for other macros like @code{cl-incf}, and @code{cl-pushnew}. +blocks for other macros like @code{cl-pushnew}. The @code{cl-letf} and @code{cl-letf*} macros are used in the processing of symbol macros; @pxref{Macro Bindings}. @@ -1401,7 +1352,7 @@ replaced by @var{expansion}. @example (setq bar '(5 . 9)) (cl-symbol-macrolet ((foo (car bar))) - (cl-incf foo)) + (incf foo)) bar @result{} (6 . 9) @end example @@ -1426,7 +1377,7 @@ expansion of another macro: body)))) (setq mylist '(1 2 3 4)) -(my-dolist (x mylist) (cl-incf x)) +(my-dolist (x mylist) (incf x)) mylist @result{} (2 3 4 5) @end example @@ -1440,14 +1391,14 @@ shown here expands to @example (cl-loop for G1234 on mylist do (cl-symbol-macrolet ((x (car G1234))) - (cl-incf x))) + (incf x))) @end example @noindent which in turn expands to @example -(cl-loop for G1234 on mylist do (cl-incf (car G1234))) +(cl-loop for G1234 on mylist do (incf (car G1234))) @end example @xref{Loop Facility}, for a description of the @code{cl-loop} macro. @@ -1999,7 +1950,7 @@ a @code{setf}-able ``reference'' onto the elements of the list rather than just a temporary variable. For example, @example -(cl-loop for x in-ref my-list do (cl-incf x)) +(cl-loop for x in-ref my-list do (incf x)) @end example @noindent @@ -2940,7 +2891,7 @@ The @code{get} and @code{cl-get} functions are also @code{setf}-able. The fact that @code{default} is ignored can sometimes be useful: @example -(cl-incf (cl-get 'foo 'usage-count 0)) +(incf (cl-get 'foo 'usage-count 0)) @end example Here, symbol @code{foo}'s @code{usage-count} property is incremented @@ -4051,7 +4002,7 @@ calling @code{(person-first-name @var{p})}, @code{(person-age slots by using @code{setf} on any of these place forms, for example: @example -(cl-incf (person-age birthday-boy)) +(incf (person-age birthday-boy)) @end example You can create a new @code{person} by calling @code{make-person}, @@ -4459,29 +4410,14 @@ user to modify @var{place}. Many of the advanced features of this package, such as @code{cl-defun}, @code{cl-loop}, etc., are implemented as Lisp macros. In byte-compiled code, these complex notations will be expanded into -equivalent Lisp code which is simple and efficient. For example, -the form - -@example -(cl-incf i n) -@end example - -@noindent -is expanded at compile-time to the Lisp form - -@example -(setq i (+ i n)) -@end example - -@noindent -which is the most efficient way of doing this operation -in Lisp. Thus, there is no performance penalty for using the more -readable @code{cl-incf} form in your compiled code. +equivalent Lisp code which is simple and efficient. Thus, there is no +performance penalty for using the more readable form in your compiled +code. @emph{Interpreted} code, on the other hand, must expand these macros every time they are executed. For this reason it is strongly recommended that code making heavy use of macros be compiled. -A loop using @code{cl-incf} a hundred times will execute considerably +A loop using @code{cl-first} a hundred times will execute considerably faster if compiled, and will also garbage-collect less because the macro expansion will not have to be generated, used, and thrown away a hundred times. @@ -4907,7 +4843,7 @@ call to @code{make-adder} itself. @example (defun make-counter () (lexical-let ((n 0)) - (cl-function (lambda (&optional (m 1)) (cl-incf n m))))) + (cl-function (lambda (&optional (m 1)) (incf n m))))) (setq count-1 (make-counter)) (funcall count-1 3) @result{} 3 @@ -5052,7 +4988,7 @@ In Emacs, these are obsolete, replaced by various features of @defmac define-modify-macro name arglist function [doc-string] This macro defines a ``read-modify-write'' macro similar to -@code{cl-incf} and @code{cl-decf}. You can replace this macro +@code{incf} and @code{decf}. You can replace this macro with @code{gv-letplace}. The macro @var{name} is defined to take a @var{place} argument @@ -5180,8 +5116,8 @@ For example, the simple form of @code{defsetf} is shorthand for The Lisp form that is returned can access the arguments from @var{arglist} and @var{store-var} in an unrestricted fashion; -macros like @code{cl-incf} that invoke this -setf-method will insert temporary variables as needed to make +macros that invoke this +setf-method should insert temporary variables as needed to make sure the apparent order of evaluation is preserved. Another standard example: @@ -5245,11 +5181,7 @@ temporary variables. In the setf-methods generated by @code{defsetf}, the second return value is simply the list of arguments in the place form, and the first return value is a list of a corresponding number of temporary variables generated -@c FIXME I don't think this is true anymore. -by @code{cl-gensym}. Macros like @code{cl-incf} that -use this setf-method will optimize away most temporaries that -turn out to be unnecessary, so there is little reason for the -setf-method itself to optimize. +by @code{cl-gensym}. @end defmac @node GNU Free Documentation License diff --git a/etc/NEWS b/etc/NEWS index a03ffe91ab9..0c54fc2c4a9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -491,12 +491,18 @@ Emacs 25.1), and gnudoit (obsolete since Emacs 25.1). ** CL-Lib +++ -*** Some cl-lib functions are now built-in. -The functions 'cl-plusp', 'cl-minusp', 'cl-oddp', and 'cl-evenp', have -been added to Emacs Lisp, and are thus now aliases for the built-in -functions 'plusp', 'minusp', 'oddp' and 'evenp'. The old names are -considered deprecated, and will be marked as obsolete in some future -release. +*** Some cl-lib functions and macros are now built-in. +These functions or macros have been added to Emacs Lisp, and the old +names are now aliases for the built-in equivalents: + - 'cl-incf' renamed to 'incf' + - 'cl-decf' renamed to 'decf' + - 'cl-oddp' renamed to 'oddp' + - 'cl-evenp' renamed to 'evenp' + - 'cl-plusp' renamed to 'plusp' + - 'cl-minusp' renamed to 'minusp' + +The old names are considered deprecated, and will be marked as obsolete +in some future release. +++ *** 'cl-labels' now also accepts '(FUNC EXP)' bindings, like 'cl-flet'. @@ -1356,6 +1362,11 @@ change it globally with: (set-default-toplevel-value 'lexical-binding t) ++++ +*** New functions 'incf' and 'decf'. +They increment or decrement the value stored in a variable (a symbol), +or in a generalized variable. + +++ ** New functions 'plusp' and 'minusp'. They return non-nil if a number is positive or negative, respectively, diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 2a952b57646..42460fc2c9f 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -105,29 +105,27 @@ a future Emacs interpreter will be able to use it.") ;; can safely be used in init files. ;;;###autoload -(defmacro cl-incf (place &optional x) +(defalias 'cl-incf #'incf "Increment PLACE by X (1 by default). PLACE may be a symbol, or any generalized variable allowed by `setf'. The return value is the incremented value of PLACE. If X is specified, it should be an expression that should -evaluate to a number." - (declare (debug (place &optional form))) - (if (symbolp place) - (list 'setq place (if x (list '+ place x) (list '1+ place))) - (list 'cl-callf '+ place (or x 1)))) +evaluate to a number. + +This macro is considered deprecated in favor of the built-in macro +`incf' that was added in Emacs 31.1.") -(defmacro cl-decf (place &optional x) +(defalias 'cl-decf #'decf "Decrement PLACE by X (1 by default). PLACE may be a symbol, or any generalized variable allowed by `setf'. The return value is the decremented value of PLACE. If X is specified, it should be an expression that should -evaluate to a number." - (declare (debug cl-incf)) - (if (symbolp place) - (list 'setq place (if x (list '- place x) (list '1- place))) - (list 'cl-callf '- place (or x 1)))) +evaluate to a number. + +This macro is considered deprecated in favor of the built-in macro +`decf' that was added in Emacs 31.1.") (defmacro cl-pushnew (x place &rest keys) "Add X to the list stored in PLACE unless X is already in the list. diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index dcbdf6942f7..d9ba786aa7d 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -315,17 +315,29 @@ The return value is the last VAL in the list. ;; `(if (member ,v ,getter) nil ;; ,(funcall setter `(cons ,v ,getter)))))) -;; (defmacro gv-inc! (place &optional val) -;; "Increment PLACE by VAL (default to 1)." -;; (declare (debug (gv-place &optional form))) -;; (gv-letplace (getter setter) place -;; (funcall setter `(+ ,getter ,(or val 1))))) +;;;###autoload +(defmacro incf (place &optional delta) + "Increment PLACE by DELTA (default to 1). -;; (defmacro gv-dec! (place &optional val) -;; "Decrement PLACE by VAL (default to 1)." -;; (declare (debug (gv-place &optional form))) -;; (gv-letplace (getter setter) place -;; (funcall setter `(- ,getter ,(or val 1))))) +The DELTA is first added to PLACE, and then stored in PLACE. +Return the incremented value of PLACE. + +See also `decf'." + (declare (debug (gv-place &optional form))) + (gv-letplace (getter setter) place + (funcall setter `(+ ,getter ,(or delta 1))))) + +;;;###autoload +(defmacro decf (place &optional delta) + "Decrement PLACE by DELTA (default to 1). + +The DELTA is first subtracted from PLACE, and then stored in PLACE. +Return the decremented value of PLACE. + +See also `incf'." + (declare (debug (gv-place &optional form))) + (gv-letplace (getter setter) place + (funcall setter `(- ,getter ,(or delta 1))))) ;; For Edebug, the idea is to let Edebug instrument gv-places just like it does ;; for normal expressions, and then give it a gv-expander to DTRT. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 23b9b582a9a..77a4ec4f21c 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1375,9 +1375,17 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (mod 10 6) :eval (mod 10.5 6)) (1+ - :eval (1+ 2)) + :eval (1+ 2) + :eval (let ((x 2)) (1+ x) x)) (1- - :eval (1- 4)) + :eval (1- 4) + :eval (let ((x 4)) (1- x) x)) + (incf + :eval (let ((x 2)) (incf x) x) + :eval (let ((x 2)) (incf x 2) x)) + (decf + :eval (let ((x 4)) (decf x) x) + :eval (let ((x 4)) (decf x 2)) x) "Predicates" (= :args (number &rest numbers) diff --git a/lisp/obsolete/cl.el b/lisp/obsolete/cl.el index 5baa155c592..5fbfbb7899e 100644 --- a/lisp/obsolete/cl.el +++ b/lisp/obsolete/cl.el @@ -282,8 +282,6 @@ values-list values pushnew - decf - incf )) (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun))) (intern (format "cl-%s" fun))))) diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 376566958a0..d7c38b73432 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -63,42 +63,6 @@ (should (equal (cl-multiple-value-list nil) nil)) (should (equal (cl-multiple-value-list (list 1 2 3)) '(1 2 3)))) -(defvar cl-lib-test--special 0) - -(ert-deftest cl-lib-test-incf () - (setq cl-lib-test--special 0) - (should (= (cl-incf cl-lib-test--special) 1)) - (should (= cl-lib-test--special 1)) - (should (= (cl-incf cl-lib-test--special 9) 10)) - (should (= cl-lib-test--special 10)) - (let ((var 0)) - (should (= (cl-incf var) 1)) - (should (= var 1)) - (should (= (cl-incf var 9) 10)) - (should (= var 10))) - (let ((alist)) - (should (= (cl-incf (alist-get 'a alist 0)) 1)) - (should (= (alist-get 'a alist 0) 1)) - (should (= (cl-incf (alist-get 'a alist 0) 9) 10)) - (should (= (alist-get 'a alist 0) 10)))) - -(ert-deftest cl-lib-test-decf () - (setq cl-lib-test--special 0) - (should (= (cl-decf cl-lib-test--special) -1)) - (should (= cl-lib-test--special -1)) - (should (= (cl-decf cl-lib-test--special 9) -10)) - (should (= cl-lib-test--special -10)) - (let ((var 1)) - (should (= (cl-decf var) 0)) - (should (= var 0)) - (should (= (cl-decf var 10) -10)) - (should (= var -10))) - (let ((alist)) - (should (= (cl-decf (alist-get 'a alist 0)) -1)) - (should (= (alist-get 'a alist 0) -1)) - (should (= (cl-decf (alist-get 'a alist 0) 9) -10)) - (should (= (alist-get 'a alist 0) -10)))) - (ert-deftest cl-digit-char-p () (should (eql 3 (cl-digit-char-p ?3))) (should (eql 10 (cl-digit-char-p ?a 11))) diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el index 5ea386e0b5d..892af4bfab1 100644 --- a/test/lisp/emacs-lisp/gv-tests.el +++ b/test/lisp/emacs-lisp/gv-tests.el @@ -163,6 +163,42 @@ its getter (Bug#41853)." (eval-buffer)))) (should (equal (get 'gv-setter-edebug 'gv-setter-edebug-prop) '(123)))) +(defvar gv-test--special 0) + +(ert-deftest gv-incf () + (setq gv-test--special 0) + (should (= (incf gv-test--special) 1)) + (should (= gv-test--special 1)) + (should (= (incf gv-test--special 9) 10)) + (should (= gv-test--special 10)) + (let ((var 0)) + (should (= (incf var) 1)) + (should (= var 1)) + (should (= (incf var 9) 10)) + (should (= var 10))) + (let ((alist)) + (should (= (incf (alist-get 'a alist 0)) 1)) + (should (= (alist-get 'a alist 0) 1)) + (should (= (incf (alist-get 'a alist 0) 9) 10)) + (should (= (alist-get 'a alist 0) 10)))) + +(ert-deftest gv-decf () + (setq gv-test--special 0) + (should (= (decf gv-test--special) -1)) + (should (= gv-test--special -1)) + (should (= (decf gv-test--special 9) -10)) + (should (= gv-test--special -10)) + (let ((var 1)) + (should (= (decf var) 0)) + (should (= var 0)) + (should (= (decf var 10) -10)) + (should (= var -10))) + (let ((alist)) + (should (= (decf (alist-get 'a alist 0)) -1)) + (should (= (alist-get 'a alist 0) -1)) + (should (= (decf (alist-get 'a alist 0) 9) -10)) + (should (= (alist-get 'a alist 0) -10)))) + (ert-deftest gv-plist-get () ;; Simple `setf' usage for `plist-get'. (let ((target (list :a "a" :b "b" :c "c"))) commit 44a1c4a9aea54d6542bcf0c231b080f0ed023229 Author: Mauro Aranda Date: Sat Feb 22 18:31:40 2025 -0300 Fix last commit to wid-edit.el * lisp/wid-edit.el (widget-editable-list-entry-create): Don't use save-excursion when indenting. Previously, it was needed because we inserted the :entry-format string, but we don't do that anymore. (Bug#53606) https://lists.gnu.org/archive/html/emacs-devel/2025-02/msg00958.html diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 2d6075c10a8..38d065a7d65 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -3071,10 +3071,9 @@ Save CHILD into the :last-deleted list, so it can be inserted later." (onext 0) (next 0) child delete insert) (widget-specify-insert - (save-excursion - (and (widget--should-indent-p) - (widget-get widget :indent) - (insert-char ?\s (widget-get widget :indent)))) + (and (widget--should-indent-p) + (widget-get widget :indent) + (insert-char ?\s (widget-get widget :indent))) ;; Parse % escapes in format. (while (string-match "%\\(.\\)" str next) (setq next (match-end 1)) commit c830caab2c5bd3d03673c26f053397042dc58ad3 Author: Stefan Monnier Date: Sat Feb 22 14:57:25 2025 -0500 (help--append-keystrokes-help): Fix bug#76341 * lisp/help.el (help--append-keystrokes-help): Silence the help message when there is no help key. diff --git a/lisp/help.el b/lisp/help.el index 91e036621f8..835e47fec43 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -2200,18 +2200,17 @@ The `temp-buffer-window-setup-hook' hook is called." (current-active-maps t))))) (catch 'res (dolist (val help-event-list) - (let ((key (vector (if (eql val 'help) - help-char - val)))) - (unless (seq-find (lambda (map) (and (keymapp map) (lookup-key map key))) - bindings) - (throw 'res - (concat - str - (substitute-command-keys - (format - " (\\`%s' for help)" - (key-description key)))))))) + (when (setq val (if (eql val 'help) help-char val)) + (let ((key (vector val))) + (unless (seq-find (lambda (map) (and (keymapp map) (lookup-key map key))) + bindings) + (throw 'res + (concat + str + (substitute-command-keys + (format + " (\\`%s' for help)" + (key-description key))))))))) str))) commit 1ffa0521131c20edbbcba84765870f01411d039e Author: Juri Linkov Date: Sat Feb 22 21:52:39 2025 +0200 * lisp/treesit.el (treesit-up-list, treesit-outline-level): Improve. Try to get the parent parser host node that contains the embedded parser and continue the search from it (bug#76398). diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 768d78229aa..788d98fdf20 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -3167,8 +3167,8 @@ It's required in both cases: whether you define @code{outline-regexp} or @code{outline-search-function}. @end defvar -If built with tree-sitter, Emacs can automatically use -Outline minor mode if the major mode sets the following variable. +If built with tree-sitter, Emacs can automatically use Outline +minor mode if the major mode sets one of the following variables. @defvar treesit-outline-predicate This variable instructs Emacs how to find lines with outline headings. @@ -3178,7 +3178,7 @@ It should be a predicate that matches the node on the heading line. @defvar treesit-aggregated-outline-predicate This variable allows major modes to configure outlines for multiple languages. Its value is an alist mapping language symbols to outline -headings of the form described above for the value of +headings as described above for the value of @code{treesit-outline-predicate}. If this variable is non-@code{nil}, it overrides diff --git a/lisp/treesit.el b/lisp/treesit.el index 98ecf37f2e1..fe0dc38f324 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2838,6 +2838,15 @@ ARG is described in the docstring of `up-list'." (treesit-node-end parent) (treesit-node-start parent)))) (setq parent (treesit-parent-until parent pred))) + + (when-let* ((_ (null parent)) + (parser (treesit-node-parser (treesit-node-at (point)))) + (_ (not (eq parser treesit-primary-parser))) + (guest-root-node (treesit-parser-root-node parser))) + ;; Continue from the host node that contains the guest parser. + (setq parent (treesit-thing-at + (- (treesit-node-start guest-root-node) 2) pred))) + (or (when (and default-pos (or (null parent) (if (> arg 0) @@ -3716,7 +3725,7 @@ For BOUND, MOVE, BACKWARD, LOOKING-AT, see the descriptions in "Return the depth of the current outline heading." (let* ((node (treesit-outline--at-point)) (level 1) - (parser (when treesit-aggregated-outline-predicate + (parser (when (and treesit-aggregated-outline-predicate node) (treesit-node-parser node))) (pred (if treesit-aggregated-outline-predicate (alist-get (treesit-language-at (point)) @@ -3724,13 +3733,12 @@ For BOUND, MOVE, BACKWARD, LOOKING-AT, see the descriptions in treesit-outline-predicate))) (while (setq node (treesit-parent-until node pred)) (setq level (1+ level))) - (when-let* ((_ parser) + (when-let* ((_ (and parser (not (eq parser treesit-primary-parser)))) + (guest-root-node (treesit-parser-root-node parser)) (host-lang (treesit-parser-language treesit-primary-parser)) - (_ (not (eq (treesit-language-at (point)) host-lang))) (host-pred (alist-get host-lang treesit-aggregated-outline-predicate))) - ;; Now need to break out of embedded confinement - ;; and get the host node that contains the guest ranges - (setq node (treesit-parser-root-node parser)) + ;; Continue from the host node that contains the guest parser. + (setq node (treesit-node-at (- (treesit-node-start guest-root-node) 2))) (while (setq node (treesit-parent-until node host-pred)) (setq level (1+ level)))) level)) commit ba8a1b902594189fb067c0ff5d761d19d3a2369c Author: Stefan Kangas Date: Sat Feb 22 18:22:12 2025 +0100 Delete self-evident explanation from cl.texi * doc/misc/cl.texi (Setf Extensions): Delete self-evident explanation. diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 0b45ae2e231..f95900a085e 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -1069,38 +1069,6 @@ A macro call, in which case the macro is expanded and @code{setf} is applied to the resulting form. @end itemize -@c FIXME should this be in lispref? It seems self-evident. -@c Contrast with the cl-incf example later on. -@c Here it really only serves as a contrast to wrong-order. -The @code{setf} macro takes care to evaluate all subforms in -the proper left-to-right order; for example, - -@example -(setf (aref vec (cl-incf i)) i) -@end example - -@noindent -looks like it will evaluate @code{(cl-incf i)} exactly once, before the -following access to @code{i}; the @code{setf} expander will insert -temporary variables as necessary to ensure that it does in fact work -this way no matter what setf-method is defined for @code{aref}. -(In this case, @code{aset} would be used and no such steps would -be necessary since @code{aset} takes its arguments in a convenient -order.) - -However, if the @var{place} form is a macro which explicitly -evaluates its arguments in an unusual order, this unusual order -will be preserved. Adapting an example from Steele, given - -@example -(defmacro wrong-order (x y) (list 'aref y x)) -@end example - -@noindent -the form @code{(setf (wrong-order @var{a} @var{b}) 17)} will -evaluate @var{b} first, then @var{a}, just as in an actual call -to @code{wrong-order}. - @node Modify Macros @subsection Modify Macros commit 4aae820a017faab47662d0fa82cb5e39d8728d8c Author: Stefan Kangas Date: Sat Feb 22 17:18:01 2025 +0100 ; Delete obsolete commented out parts from cl.texi * doc/misc/cl.texi (Modify Macros, Obsolete Setf Customization): Delete commented out documentation that is no longer true, and documentation of a function that was removed in Emacs 24.3. diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 4e757daab1e..0b45ae2e231 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -1257,26 +1257,13 @@ However, a @var{binding} specifier may be a one-element list @var{place})}. In other words, the @var{place} is not disturbed on entry to the body, and the only effect of the @code{cl-letf} is to restore the original value of @var{place} afterwards. -@c I suspect this may no longer be true; either way it's -@c implementation detail and so not essential to document. -@ignore -(The redundant access-and-store suggested by the @code{(@var{place} -@var{place})} example does not actually occur.) -@end ignore Note that in this case, and in fact almost every case, @var{place} must have a well-defined value outside the @code{cl-letf} body. There is essentially only one exception to this, which is @var{place} a plain variable with a specified @var{value} (such as @code{(a 17)} in the above example). -@c See https://debbugs.gnu.org/12758 -@c Some or all of this was true for cl.el, but not for cl-lib.el. -@ignore -The only exceptions are plain variables and calls to -@code{symbol-value} and @code{symbol-function}. If the symbol is not -bound on entry, it is simply made unbound by @code{makunbound} or -@code{fmakunbound} on exit. -@end ignore + @end defmac @defmac cl-letf* (bindings@dots{}) forms@dots{} @@ -5297,24 +5284,6 @@ turn out to be unnecessary, so there is little reason for the setf-method itself to optimize. @end defmac -@c Removed in Emacs 24.3, not possible to make a compatible replacement. -@ignore -@defun get-setf-method place &optional env -This function returns the setf-method for @var{place}, by -invoking the definition previously recorded by @code{defsetf} -or @code{define-setf-method}. The result is a list of five -values as described above. You can use this function to build -your own @code{cl-incf}-like modify macros. - -The argument @var{env} specifies the ``environment'' to be -passed on to @code{macroexpand} if @code{get-setf-method} should -need to expand a macro in @var{place}. It should come from -an @code{&environment} argument to the macro or setf-method -that called @code{get-setf-method}. -@end defun -@end ignore - - @node GNU Free Documentation License @appendix GNU Free Documentation License @include doclicense.texi commit 827a91dbf3a45d6c3c620545b5e620ce76e44bb2 Author: Eli Zaretskii Date: Sat Feb 22 18:04:04 2025 +0200 Make 'text-property-default-nonsticky' buffer-local when set * src/textprop.c (syms_of_textprop) : Make buffer-local when set. (Bug#76445) * etc/symbol-releases.eld: Add text-property-default-nonsticky. * etc/NEWS: * doc/lispref/text.texi (Sticky Properties): Document the change. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index bada8bd734b..90aa45e8501 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4135,10 +4135,10 @@ list, properties are rear-sticky @emph{unless} their names are in the list. @defvar text-property-default-nonsticky -This variable holds an alist which defines the default rear-stickiness -of various text properties. Each element has the form -@code{(@var{property} . @var{nonstickiness})}, and it defines the -stickiness of a particular text property, @var{property}. +This buffer-local variable holds an alist which defines the default +rear-stickiness of various text properties in the buffer. Each element +has the form @code{(@var{property} . @var{nonstickiness})}, and it +defines the stickiness of a particular text property, @var{property}. If @var{nonstickiness} is non-@code{nil}, this means that the property @var{property} is rear-nonsticky by default. Since all properties are diff --git a/etc/NEWS b/etc/NEWS index bd7c678b8da..a03ffe91ab9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1306,6 +1306,11 @@ An old alternative name (without the first 'e') has been removed. +++ ** 'read-directory-name' now accepts an optional PREDICATE argument. ++++ +** 'text-property-default-nonsticky' is now buffer-local. +This variable now becomes buffer-local when set. Use 'setq-default' in +(the unlikely) case you want to change the global value. + --- ** All the digit characters now have the 'digit' category. All the characters whose Unicode general-category is Nd now have the diff --git a/etc/symbol-releases.eld b/etc/symbol-releases.eld index 645ab77972d..41200581be5 100644 --- a/etc/symbol-releases.eld +++ b/etc/symbol-releases.eld @@ -44,6 +44,7 @@ ("22.1" fun version<) ("22.1" fun version<=) ("22.1" fun read-number) + ("21.1" var text-property-default-nonsticky) ;; Since much of early Emacs source history is lost, these versions are ;; conservative estimates: the actual version of first appearance may very diff --git a/src/textprop.c b/src/textprop.c index 30c26ce4809..8fdaafccede 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -2427,6 +2427,7 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and by default. */ Vtext_property_default_nonsticky = list2 (Fcons (Qsyntax_table, Qt), Fcons (Qdisplay, Qt)); + Fmake_variable_buffer_local (Qtext_property_default_nonsticky); interval_insert_behind_hooks = Qnil; interval_insert_in_front_hooks = Qnil; @@ -2444,6 +2445,7 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and DEFSYM (Qlocal_map, "local-map"); DEFSYM (Qfront_sticky, "front-sticky"); DEFSYM (Qrear_nonsticky, "rear-nonsticky"); + DEFSYM (Qtext_property_default_nonsticky, "text-property-default-nonsticky"); DEFSYM (Qmouse_face, "mouse-face"); DEFSYM (Qminibuffer_prompt, "minibuffer-prompt"); commit 8b6797fa01bf8c8c64bd1f72c1e2475bf2331ad9 Author: Stefan Kangas Date: Sat Feb 22 16:55:06 2025 +0100 Expand tests for cl-incf and cl-decf * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-test-incf) (cl-lib-test-decf): Expand tests. diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index ff19ec74a43..376566958a0 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -63,21 +63,41 @@ (should (equal (cl-multiple-value-list nil) nil)) (should (equal (cl-multiple-value-list (list 1 2 3)) '(1 2 3)))) +(defvar cl-lib-test--special 0) + (ert-deftest cl-lib-test-incf () + (setq cl-lib-test--special 0) + (should (= (cl-incf cl-lib-test--special) 1)) + (should (= cl-lib-test--special 1)) + (should (= (cl-incf cl-lib-test--special 9) 10)) + (should (= cl-lib-test--special 10)) (let ((var 0)) (should (= (cl-incf var) 1)) - (should (= var 1))) + (should (= var 1)) + (should (= (cl-incf var 9) 10)) + (should (= var 10))) (let ((alist)) (should (= (cl-incf (alist-get 'a alist 0)) 1)) - (should (= (alist-get 'a alist 0) 1)))) + (should (= (alist-get 'a alist 0) 1)) + (should (= (cl-incf (alist-get 'a alist 0) 9) 10)) + (should (= (alist-get 'a alist 0) 10)))) (ert-deftest cl-lib-test-decf () + (setq cl-lib-test--special 0) + (should (= (cl-decf cl-lib-test--special) -1)) + (should (= cl-lib-test--special -1)) + (should (= (cl-decf cl-lib-test--special 9) -10)) + (should (= cl-lib-test--special -10)) (let ((var 1)) (should (= (cl-decf var) 0)) - (should (= var 0))) + (should (= var 0)) + (should (= (cl-decf var 10) -10)) + (should (= var -10))) (let ((alist)) (should (= (cl-decf (alist-get 'a alist 0)) -1)) - (should (= (alist-get 'a alist 0) -1)))) + (should (= (alist-get 'a alist 0) -1)) + (should (= (cl-decf (alist-get 'a alist 0) 9) -10)) + (should (= (alist-get 'a alist 0) -10)))) (ert-deftest cl-digit-char-p () (should (eql 3 (cl-digit-char-p ?3))) commit ef8fdd269a244f94f970f51c909eff5de4702048 Merge: ce289162828 72d7f192261 Author: Eli Zaretskii Date: Sat Feb 22 17:52:15 2025 +0200 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 72d7f1922611e01d01fbe407a577ab95afb0ddd7 Author: Philip Kaludercic Date: Sat Feb 22 16:05:07 2025 +0100 Fix bug where VC packages were missing summaries * lisp/emacs-lisp/package-vc.el (package-vc--generate-description-file): Run the heuristic to determine the package summary if the current description is just the default package summary. (Bug#76065) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index a18841fb64d..7455bfba69e 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -271,7 +271,11 @@ asynchronously." (defun package-vc--generate-description-file (pkg-desc pkg-file) "Generate a package description file for PKG-DESC and write it to PKG-FILE." (let ((name (package-desc-name pkg-desc))) - ;; Infer the subject if missing. + (when (equal (package-desc-summary pkg-desc) package--default-summary) + ;; We unset the package description if it is just the default + ;; summary, so that the following heuristic can take effect. + (setf (package-desc-summary pkg-desc) nil)) + ;; Infer the package description if missing. (unless (package-desc-summary pkg-desc) (setf (package-desc-summary pkg-desc) (let ((main-file (package-vc--main-file pkg-desc))) commit 702cb123faf1bdbacf555188ae4997d6be3765fe Author: Stefan Kangas Date: Sun Jan 19 13:59:13 2025 +0100 ; Fix typos diff --git a/admin/codespell/codespell.exclude b/admin/codespell/codespell.exclude index edfcce0415a..471b489270c 100644 --- a/admin/codespell/codespell.exclude +++ b/admin/codespell/codespell.exclude @@ -1789,3 +1789,16 @@ ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\ (oarticle (make-symbol "gnus-setup-message-oarticle")) (,oarticle gnus-article-reply) (gnus-inews-add-send-actions ,winconf ,buffer ,oarticle ,config + Thur, Fri, Sat, Sun +[3]: Merget, Brinkmann, Aviram, Somorovsky, Mittmann, and + (ansi-color-cyan :short "ansi-cyan" :slug "anc" :foreground ,fg-term-cyan) + (ansi-color-bright-cyan :short "ansi-bright-cyan" :slug "ANc" :foreground ,fg-term-cyan-bright) + (search-forward "foo.correc") + "Your finger was not centred, try swiping your finger again" + (ofrom (marker-position (widget-get group :from))) + (should (= ofrom (widget-get group :from))) + (ofrom (marker-position (widget-get group :from))) + (should (= ofrom (widget-get group :from))) + (should (equal (cl-subseq "hello world" -5 -1) "worl")) + ("\\.te?xi\\'" . texinfo-mode) + ("\\.te?xt\\'" . text-mode) diff --git a/admin/tree-sitter/treesit-admin.el b/admin/tree-sitter/treesit-admin.el index 54ae969442c..86174ed2625 100644 --- a/admin/tree-sitter/treesit-admin.el +++ b/admin/tree-sitter/treesit-admin.el @@ -219,7 +219,7 @@ queries that has problems with latest grammar." (special-mode)))) (defun treesit-admin-verify-major-mode-queries () - "Varify font-lock queries in builtin major modes. + "Verify font-lock queries in builtin major modes. If the font-lock queries work fine with the latest grammar, insert some comments in the source file saying that the modes are known to work with @@ -296,7 +296,7 @@ instead. Return a plist of the form - (:version VERSION :head-version HEAD-VERSION :timstamp TIMESTAMP). + (:version VERSION :head-version HEAD-VERSION :timestamp TIMESTAMP). HEAD-VERSION is the version of the HEAD, VERSION is the latest compatible version. TIMESTAMP is the commit date of VERSION in UNIX @@ -371,14 +371,14 @@ VERSION and HEAD-VERSION in the plist are the same as in (defun treesit-admin--generate-compatibility-report (emacs-executables modes out-file) - "Generate a table for language compatibiity for MODES. + "Generate a table for language compatibility for MODES. Note that this only works for Emacs 31 and later, because before Emacs 31 we can't validate a compiled query (because there's a bug preventing us from eager compiling a compiled query that's already lazily compiled). -EMACS-EXECUTABLES is a list of Emacs executbles to check for." +EMACS-EXECUTABLES is a list of Emacs executables to check for." (let ((tables (mapcar (lambda (emacs) diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index aee68608bbf..4f267e7b2d7 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -589,7 +589,7 @@ images, and this image will be put on the clipboard. On capable platforms, Emacs can yank these objects with the @code{yank-media} command---but only in modes that have support for it. By default, it auto-selects the preferred media type available in the clipboard but -this can be overriden by giving the prefix argument to the command +this can be overridden by giving the prefix argument to the command (@pxref{Yanking Media,,, elisp, The Emacs Lisp Reference Manual}). @cindex clipboard manager diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index dc55b63c5da..ee1fcbbbd68 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -963,7 +963,7 @@ the format to use. @cindex @code{staticpro}, protection from GC If you directly define a file-scope C variable of type -@code{Lisp_Object}, you must protect it from garbage-collection by +@code{Lisp_Object}, you must protect it from garbage collection by calling @code{staticpro} in @code{syms_of_@var{filename}}, like this: @example diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 034c424105b..f12104ea267 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -171,7 +171,7 @@ the symbol name with first letter capitalized. For languages that has ``irregular'' names, @var{treesit-language-display-name-alist} maps language symbols to their display names. -If a major mode package uses a langauge with ``irregular'' name, they +If a major mode package uses a language with ``irregular'' name, they should add a mapping into @var{treesit-language-display-name-alist} on load. @end defun diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index d443fddd3f8..566da9dad3d 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -4188,7 +4188,7 @@ position of a later line. Instead, that anchor position is the latest line at the same level of nesting before the labeled line without a leading label or comment. If there is no such line, the latest line containing an enclosing opening brace or parenthesis, which doesn't -start with a label or comment, provides the anchor postion. In this +start with a label or comment, provides the anchor position. In this case extra syntactic element(s) with syntactic symbol @code{defun-block-intro}, @code{statement-block-intro}, or some other ``-intro'' symbol are inserted into the syntactic context to allow the diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 86ffba29744..ac6ae94f060 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -6239,7 +6239,7 @@ as above in your @file{~/.emacs}: @item I get an error @samp{unix_listener: path "/very/long/path/.cache/emacs/tramp.XXX" too long for Unix domain -socket} when connectiong via @option{ssh} to a remote host. +socket} when connecting via @option{ssh} to a remote host. @vindex small-temporary-file-directory By default, @value{tramp} uses the directory @file{~/.cache/emacs/} diff --git a/etc/NEWS b/etc/NEWS index 2121400b8ac..85071a668a1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -348,7 +348,7 @@ This input method has support for polytonic and archaic Greek characters. --- -*** New language-environment and input method for Tifinagh. +*** New language environment and input method for Tifinagh. The Tifinagh script is used to write the Berber languages. --- @@ -473,8 +473,8 @@ a web browser to load them. For example, it could be used like this: (add-to-list 'browse-url-transform-alist '("www.google.com" . "www.duckduckgo.com")) -*** New function 'browse-url-qutebrowser' for the Qutebrowser. -For better integration with the Qutebrowser, set +*** New function 'browse-url-qutebrowser' for Qutebrowser. +For better integration with Qutebrowser, set 'browse-url(-secondary)-browser-function' to 'browse-url-qutebrowser'. *** New GTK-native launch mode. @@ -1262,7 +1262,7 @@ observed on Android). +++ *** 'yank-media' now auto-selects the most preferred MIME type. -Major-mode authors can customise the variables +Major-mode authors can customize the variables 'yank-media-autoselect-function' and/or 'yank-media-preferred-types' to change the selection rules. diff --git a/etc/NEWS.28 b/etc/NEWS.28 index 6ec6e19942f..2c0009e1902 100644 --- a/etc/NEWS.28 +++ b/etc/NEWS.28 @@ -1559,7 +1559,7 @@ either an internal or external browser. If a remote file is specified, a local temporary copy of that file is passed to the browser. -*** Support for the conkeror browser is now obsolete. +*** Support for the Conkeror browser is now obsolete. *** Support for the Mosaic browser has been removed. This support has been obsolete since 25.1. diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 7f791de1988..1a73eea5c91 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -5568,7 +5568,7 @@ the end of the string. *** Function ~org-info-export~ changes. -HTML links created from certain info links now point to =gnu.org= URL's rather +HTML links created from certain info links now point to =gnu.org= URLs rather than just to local files. For example info links such as =info:emacs#List Buffers= used to be converted to HTML links like this: diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index b0b32ca263b..c23ef59f8e4 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -196,7 +196,7 @@ See `auth-source-pass-get'." "Return a string with the file content of ENTRY." (with-temp-buffer ;; `file-name-handler-alist' could be nil, or miss the - ;; `epa-file-handler' entry. We ensure, that it does exist. + ;; `epa-file-handler' entry. We ensure that it does exist. ;; (Bug#67937) (let ((file-name-handler-alist (cons epa-file-handler file-name-handler-alist))) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 1d792952f98..1c8b27cf19e 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -420,7 +420,7 @@ The format is an alist, with string keys ABBREV-UNIT, and elements like: (ABBREV-UNIT UNIT UNIT-PLURAL SECS) -where UNIT is a unit of time, ABBREV-UNIT is the abreviated form of +where UNIT is a unit of time, ABBREV-UNIT is the abbreviated form of UNIT, UNIT-PLURAL is the plural form of UNIT, and SECS is the number of seconds per UNIT.") diff --git a/lisp/disp-table.el b/lisp/disp-table.el index afce22deb85..23671da5107 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el @@ -112,7 +112,7 @@ Valid symbols are `truncation', `wrap', `escape', `control', (princ "\nBox vertical line glyph: ") (prin1 (display-table-slot dt 'box-vertical)) - (princ "\nBox horizonal line glyph: ") + (princ "\nBox horizontal line glyph: ") (prin1 (display-table-slot dt 'box-horizontal)) (princ "\nBox upper left corner glyph: ") (prin1 (display-table-slot dt 'box-down-right)) @@ -125,7 +125,7 @@ Valid symbols are `truncation', `wrap', `escape', `control', (princ "\nBox double vertical line glyph: ") (prin1 (display-table-slot dt 'box-double-vertical)) - (princ "\nBox double horizonal line glyph: ") + (princ "\nBox double horizontal line glyph: ") (prin1 (display-table-slot dt 'box-double-horizontal)) (princ "\nBox double upper left corner glyph: ") (prin1 (display-table-slot dt 'box-double-down-right)) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 4a83e9d6a7c..2a952b57646 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -286,7 +286,7 @@ This function is considered deprecated in favor of the built-in function "Return t if INTEGER is odd. This function is considered deprecated in favor of the built-in function -`evenp' that was added in Emacs 31.1.") +`oddp' that was added in Emacs 31.1.") (defalias 'cl-evenp #'evenp "Return t if INTEGER is even. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index dc6f71af7db..2a1045b18ed 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4525,7 +4525,7 @@ of an installed ELPA package. The return value is a string (or nil in case we can't find it). It works in more cases if the call is in the file which contains the `Version:' header." - ;; In a sense, this is a lie, but it does just what we want: precompute + ;; In a sense, this is a lie, but it does just what we want: precomputes ;; the version at compile time and hardcodes it into the .elc file! (declare (pure t)) ;; Hack alert! diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 2431d00dad3..be9f4917e80 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -403,7 +403,7 @@ If CANCEL-ON-INPUT is non-nil and the user inputs something while the function is waiting, then any future replies to the request by the remote endpoint (normal or error) are ignored and the function exits returning CANCEL-ON-INPUT-RETVAL. If CANCEL-ON-INPUT is a function, it -is invoked with one argument, an integer identifying the cancelled +is invoked with one argument, an integer identifying the canceled request as specified in the JSONRPC 2.0 spec." (let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer canceled diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index db0510c7e84..9337ee9401a 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -356,7 +356,7 @@ for `smtpmail-try-auth-method'.") (erase-buffer)))) ;; Encode the header according to RFC2047. (mail-encode-header (point-min) delimline) - ;; Get recipients' adresses + ;; Get recipients' addresses (setq smtpmail-recipient-address-list (smtpmail-deduce-address-list tembuf (point-min) delimline)) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 18a72e97fcb..fcd0c8d9090 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -58,7 +58,7 @@ Non-nil if EWW should ask for confirmation before sending the selected region to the configured search engine. This is the default to mitigate the risk of accidental data leak. Set this variable to nil to send the region to the search engine -straightaway." +straight away." :version "31.1" :group 'eww :type 'boolean) diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 448a2b4aa91..faff22304dc 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -417,7 +417,7 @@ were rampant use of small subgroup prime or composite number for DHE by many servers, and thus allowed themselves to be vulnerable to backdoors[1]. Given the difficulty in validating Diffie-Hellman parameters, major browser vendors had started to remove DHE since -2016[2]. In 2020, the so-called Racoon Attack was discovered, a +2016[2]. In 2020, the so-called Raccoon Attack was discovered, a server-side vulnerability that exploits a side-channel to get the shared secret key[3]. diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 10cf51cdd6c..945187e863f 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -918,7 +918,7 @@ comment delimiters." (when (> beg end) (setq beg (prog1 end (setq end beg)))) ;; Bind `comment-use-global-state' to nil. While uncommenting a region ;; (which works a line at a time), a comment can appear to be - ;; included in a mult-line string, but it is actually not. + ;; included in a multi-line string, but it is actually not. (let ((comment-use-global-state nil)) (save-excursion (funcall uncomment-region-function beg end arg)))) diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 7ebd0770a5d..250e3879b57 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -538,7 +538,7 @@ characters on the current line." ;;; Baseline indent rule (defvar c-ts-common-list-indent-style 'align - "Intructs `c-ts-common-baseline-indent-rule' how to indent lists. + "Instructs `c-ts-common-baseline-indent-rule' how to indent lists. If the value is `align', indent lists like this: @@ -594,7 +594,7 @@ chaining like .method() front of the node. But ff `treesit-simple-indent-standalone-predicate' is non-nil, use that -for determining standlone line." +for determining standalone line." (let (anchor) (save-excursion (catch 'term @@ -620,7 +620,7 @@ chaining like .method() front of the node. But ff `treesit-simple-indent-standalone-predicate' is non-nil, use that -for determining standlone line." +for determining standalone line." (save-excursion (setq node (treesit-node-prev-sibling node 'named)) (goto-char (treesit-node-start node)) @@ -710,7 +710,7 @@ The rule also handles method chaining like (rx (or "(" "["))) (let ((first-sibling (treesit-node-child parent 0 'named))) (cond - ;; Closing delimeters. + ;; Closing delimiters. ((treesit-node-match-p node (rx (or ")" "]"))) (if (eq c-ts-common-list-indent-style 'align) (cons (treesit-node-start (treesit-node-child parent 0)) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index b758734db73..5603d238b4f 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -7522,7 +7522,7 @@ multi-line strings (but not C++, for example)." "Construct a regexp for a C++ raw string opener matching CLOSER." (concat "\\(R\\(\"\\)" (regexp-quote (substring closer 1 -1)) "(\\)")) -;; The positions of various components of mult-line strings surrounding BEG, +;; The positions of various components of multi-line strings surrounding BEG, ;; END and (1- BEG) (of before-change-functions) as returned by ;; `c-ml-string-delims-around-point'. (defvar c-old-beg-ml nil) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index bd28174e7da..df93f899069 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -573,7 +573,7 @@ under cursor." (const :tag "Call hierarchies" :callHierarchyProvider))) (defcustom eglot-advertise-cancellation nil - "If non-nil, Eglot attemps to inform server of cancelled requests. + "If non-nil, Eglot attempts to inform server of canceled requests. This is done by sending an additional '$/cancelRequest' notification every time Eglot decides to forget a request. The effect of this notification is implementation defined, and is only useful for some diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d910c816188..047ca54f755 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -7230,7 +7230,7 @@ implementations: `python-mode' and `python-ts-mode'." (when python-indent-guess-indent-offset (python-indent-guess-indent-offset)) - (add-to-list 'auto-mode-alist (cons python--auto-mode-alist-regexp 'python-ts-mode)) + (add-to-list 'auto-mode-alist (cons python--auto-mode-alist-regexp 'python-ts-mode)) (add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode)))) (derived-mode-add-parents 'python-ts-mode '(python-mode)) diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index e91c42069be..43390cc19d2 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -239,7 +239,7 @@ Argument LANGUAGE is either `typescript' or `tsx'." (ignore-errors (treesit-query-compile language queries-b t) queries-b) - ;; Return a dummy query that doens't do anything, if neither + ;; Return a dummy query that doesn't do anything, if neither ;; query works. '("," @_ignore)))) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 69b8e87613f..2bef0573bed 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -88,7 +88,7 @@ If this is a function, call it to generate the initial field text." :risky t) ;; The functionality provided by `bibtex-include-OPTkey' is a special case ;; of what `bibtex-aux-opt-alist' offers. Which BibTeX style files actually -;; use the key field? The BibTeX docomentation suggests it is used rarely. +;; use the key field? The BibTeX documentation suggests it is used rarely. ;; Under biblatex, the key field is an alias for sortkey, see Secs. 2.2.3 ;; and 2.2.5. (make-obsolete-variable 'bibtex-include-OPTkey diff --git a/lisp/textmodes/mhtml-ts-mode.el b/lisp/textmodes/mhtml-ts-mode.el index 190967fcab7..33c5f3c3019 100644 --- a/lisp/textmodes/mhtml-ts-mode.el +++ b/lisp/textmodes/mhtml-ts-mode.el @@ -107,7 +107,7 @@ By default should have same value as `html-ts-mode-indent-offset'." executable html-ts-mode-indent-offset)) ((setq executable (executable-find "xmllint")) (format "%s --html --quiet --format -" executable)) - (t "Install tidy, ore some other HTML pretty print tool, and set `mhtml-ts-mode-pretty-print-command'."))) + (t "Install tidy, or some other HTML pretty print tool, and set `mhtml-ts-mode-pretty-print-command'."))) "The command to pretty print the current HTML buffer." :type 'string :version "31.1") @@ -522,7 +522,7 @@ Powered by tree-sitter." js--treesit-jsdoc-comment-regexp)) - ;; Many treesit fuctions need to know the language at-point. + ;; Many treesit functions need to know the language at-point. ;; So you should define such a function. (setq-local treesit-language-at-point-function #'mhtml-ts-mode--language-at-point) (setq-local prettify-symbols-alist mhtml-ts-mode--prettify-symbols-alist) @@ -594,7 +594,7 @@ Powered by tree-sitter." ;; Flymake (add-hook 'flymake-diagnostic-functions #'mhtml-ts-mode-flymake-mhtml nil 'local))) -;; Add nome extra parents. +;; Add some extra parents. (derived-mode-add-parents 'mhtml-ts-mode '(css-mode js-mode)) (when (and (treesit-ready-p 'html) (treesit-ready-p 'javascript) (treesit-ready-p 'css)) diff --git a/lisp/tmm.el b/lisp/tmm.el index 9dcbf90b657..f893df2cb7a 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -342,7 +342,7 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'." ;; the menu entry and the keybinding by two spaces ;; because we added two characters at the front (one ;; digit and one space) and this would cause a - ;; misalignement otherwise. + ;; misalignment otherwise. (tmm--shorten-space-width (concat (propertize (char-to-string char) 'face 'highlight) " " str))) diff --git a/lisp/treesit.el b/lisp/treesit.el index 921c1b01be8..98ecf37f2e1 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -49,7 +49,7 @@ ;; so there will be more than one parser for each language in a buffer. ;; We can also have local parser of the same language as the host ;; parser. All of which means we can't equalize language and parser, -;; and create paresr for a language willy-nilly anymore. Major mode +;; and create parser for a language willy-nilly anymore. Major mode ;; will manage their parsers. ;;; Code: @@ -1843,7 +1843,7 @@ but not in this case: } The value of this variable affects the `standalone-parent' indent preset -for treesit-simple-indent. If the value is nil, the standlone condition +for treesit-simple-indent. If the value is nil, the standalone condition is as described. Some major mode might want to relax the condition a little bit, so that it ignores some punctuation like \".\". For example, a Javascript mode might want to consider the method call below @@ -2516,7 +2516,7 @@ This function only affects `treesit-simple-indent-rules', WHERE can be either :before or :after, which means adding RULES before or after the existing rules in `treesit-simple-indent-rules'. If -ommited, default to adding the rules before (so it overrides existing +omitted, default to adding the rules before (so it overrides existing rules). If ANCHOR is non-nil, add RULES before/after the rules in diff --git a/lisp/window-x.el b/lisp/window-x.el index 14009db1223..ad34f67c9c0 100644 --- a/lisp/window-x.el +++ b/lisp/window-x.el @@ -73,7 +73,7 @@ where HEIGHT and WIDTH are the normal height and width of the window. (nreverse list))) (defsubst window--rotate-interactive-arg () - "Return interative window argument for window rotation commands." + "Return interactive window argument for window rotation commands." (if current-prefix-arg (window-parent) (window-main-window))) ;;;###autoload diff --git a/src/buffer.c b/src/buffer.c index 40f7ec83d6b..a408b799ff4 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1357,7 +1357,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer) case SYMBOL_LOCALIZED: { /* Look in local_var_alist. */ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); - XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ + XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ result = assq_no_quit (variable, BVAR (buf, local_var_alist)); if (!NILP (result)) { diff --git a/src/dispnew.c b/src/dispnew.c index c222e721077..228aab77753 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3514,7 +3514,7 @@ make_matrix_current (struct frame *f) /* Prepare ROOT's desired row at index Y for copying child frame contents to it. Value is the prepared desired row or NULL if we - don't have, and can't contruct a desired row. */ + don't have, and can't construct a desired row. */ static struct glyph_row * prepare_desired_root_row (struct frame *root, int y) diff --git a/src/doprnt.c b/src/doprnt.c index d8403bedbe4..fb97b89c243 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -164,7 +164,7 @@ doprnt_non_null_end (char *buffer, ptrdiff_t bufsize, char const *format, return nbytes; } -/* Format to BUFFER (of positive size BUFSIZE) data formated by FORMAT, +/* Format to BUFFER (of positive size BUFSIZE) data formatted by FORMAT, terminated at either the first NUL or (if FORMAT_END is non-null and there are no NUL bytes between FORMAT and FORMAT_END) terminated at position FORMAT_END. AP specifies format arguments. diff --git a/src/emacs.c b/src/emacs.c index 42074c56271..dc7041c2338 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -166,7 +166,7 @@ char const EXTERNALLY_VISIBLE RCS_Id[] = "$Id" ": GNU Emacs " PACKAGE_VERSION " (" EMACS_CONFIGURATION " " EMACS_CONFIG_FEATURES ") $"; -/* Empty lisp strings. To avoid having to build any others. */ +/* Empty Lisp strings. To avoid having to build any others. */ Lisp_Object empty_unibyte_string, empty_multibyte_string; #ifdef WINDOWSNT @@ -3539,7 +3539,7 @@ Also note that this is not a generic facility for accessing external libraries; only those already known by Emacs will be loaded. */); #ifdef WINDOWSNT /* FIXME: We may need to load libgccjit when dumping before - term/w32-win.el defines `dynamic-library-alist`. This will fail + term/w32-win.el defines `dynamic-library-alist`. This will fail if that variable is empty, so add libgccjit-0.dll to it. */ if (will_dump_p ()) Vdynamic_library_alist = list1 (list2 (Qgccjit, diff --git a/src/frame.c b/src/frame.c index bcf11e25222..440d0cbe294 100644 --- a/src/frame.c +++ b/src/frame.c @@ -206,7 +206,7 @@ set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) /* Menu bars on child frames don't work on all platforms, which is the reason why prepare_menu_bar does not update_menu_bar for child frames (info from Martin Rudalics). This could be - implemented in ttys, but it's probaly not worth it. */ + implemented in ttys, but it's probably not worth it. */ if (is_tty_child_frame (f)) { FRAME_MENU_BAR_LINES (f) = 0; diff --git a/src/image.c b/src/image.c index dfab0d76edb..b051e4ca796 100644 --- a/src/image.c +++ b/src/image.c @@ -12030,7 +12030,7 @@ svg_css_length_to_pixels (RsvgLength length, double dpi, int font_size) The basic process, which is used for all versions of librsvg, is to load the SVG and parse it, then extract the image dimensions. We then use those image dimensions to calculate the final size and - wrap the SVG data inside another SVG we build on the fly. This + wrap the SVG data inside another SVG we build on the fly. This wrapper does the necessary resizing and setting of foreground and background colors and is then parsed and rasterized. @@ -12117,8 +12117,8 @@ svg_load_image (struct frame *f, struct image *img, char *contents, rsvg_handle_write (rsvg_handle, (unsigned char *) contents, size, &err); if (err) goto rsvg_error; - /* The parsing is complete, rsvg_handle is ready to be used, close - it for further writes. */ + /* The parsing is complete, rsvg_handle is ready to be used, close it + for further writes. */ rsvg_handle_close (rsvg_handle, &err); if (err) goto rsvg_error; #endif @@ -12348,7 +12348,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, SBYTES (wrapped_contents), &err); if (err) goto rsvg_error; - /* The parsing is complete, rsvg_handle is ready to used, close it + /* The parsing is complete, rsvg_handle is ready to be used, close it for further writes. */ rsvg_handle_close (rsvg_handle, &err); if (err) goto rsvg_error; diff --git a/src/pdumper.c b/src/pdumper.c index fc3b5d18bde..b954421e225 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -4295,7 +4295,7 @@ types. */) dump_emacs_reloc_to_emacs_ptr_raw (ctx, &staticvec[i], staticvec[i]); dump_emacs_reloc_immediate_int (ctx, &staticidx, staticidx); - /* Dump until while we keep finding objects to dump. We add new + /* Dump while we keep finding objects to dump. We add new objects to the queue by side effect during dumping. We accumulate some types of objects in special lists to get more locality for these object types at runtime. */ diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 1cdf7877f60..00377ff73a0 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -198,7 +198,7 @@ pgtk_enumerate_devices (struct pgtk_display_info *dpyinfo, else { /* GTK bug 7737 results in GDK seats being initialized - with NULL devices in some cirumstances. As events will + with NULL devices in some circumstances. As events will presumably also be delivered with their device fields set to NULL, insert a ersatz device record associated with NULL. (bug#76239) */ diff --git a/src/sound.c b/src/sound.c index 5e6acdb4743..38f1b0c356c 100644 --- a/src/sound.c +++ b/src/sound.c @@ -139,7 +139,7 @@ struct wav_header u_int32_t data_length; }; -/* The file header of Sun adio files (*.au). Files are always in +/* The file header of Sun audio files (*.au). Files are always in big-endian byte-order. */ struct au_header diff --git a/src/xdisp.c b/src/xdisp.c index 7a164ba2972..b6d9094e684 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -17466,7 +17466,7 @@ redisplay_internal (void) if (is_tty_frame (f)) { - /* Ignore all invisble tty frames, children or root. */ + /* Ignore all invisible tty frames, children or root. */ if (!frame_redisplay_p (f)) continue; commit ce28916282800b2e4a5f8e244616e25f9e81831a Author: Lockywolf Date: Thu Feb 13 11:51:50 2025 +0800 recentf.el: Add verbosity option * lisp/recentf.el (recentf-show-messages): New defcustom to control verbosity. (recentf-save-list): Use that to control verbosity. (Bug#67946) diff --git a/etc/NEWS b/etc/NEWS index 2121400b8ac..31190111ffa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -531,6 +531,13 @@ This user option controls the width of the type column on the bookmark menu 'bookmark-bmenu-list'. The default value is 8 which is backwards compatible. +** Recentf + +--- +*** New user option 'recentf-show-messages'. +'recentf-save-list' can print a message when saving the recentf list. +The new option, if set to nil, suppresses this message. + ** Saveplace --- diff --git a/lisp/recentf.el b/lisp/recentf.el index 53825b6eaf0..e9173c406b7 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -321,6 +321,14 @@ If non-nil, `recentf-open-files' will show labels for keys that can be used as shortcuts to open the Nth file." :group 'recentf :type 'boolean) + +(defcustom recentf-show-messages t + "Whether to show verbose messages about low-level recentf actions. +nil means to not show messages related to the recentf machinery. +t means show messages that were printed by default on Emacs <= 31.1." + :group 'recentf + :type 'boolean + :version "31.1") ;;; Utilities ;; @@ -1331,8 +1339,12 @@ Write data into the file specified by `recentf-save-file'." (insert "\n \n;; Local Variables:\n" (format ";; coding: %s\n" recentf-save-file-coding-system) ";; End:\n") - (write-region (point-min) (point-max) - (expand-file-name recentf-save-file)) + (write-region (point-min) + (point-max) + (expand-file-name recentf-save-file) nil + (unless (or (called-interactively-p 'interactive) + recentf-show-messages) + 'quiet)) (when recentf-save-file-modes (set-file-modes recentf-save-file recentf-save-file-modes)) nil) commit e682fd2d5ba5f471a6e4d07b7f691a1ba9fa1139 Author: Michael Albinus Date: Sat Feb 22 14:38:24 2025 +0100 * lisp/net/tramp-sh.el (tramp-find-executable): Fix check. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e008bc07301..3468ea060d7 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4107,8 +4107,9 @@ This function expects to be in the right *tramp* buffer." vec (format "%s type -P %s 2>%s" (if dirlist (concat "PATH=" (string-join dirlist ":")) "") progname (tramp-get-remote-null-device vec))) - (unless (zerop (buffer-size)) - (string-trim (buffer-string))))) + (goto-char (point-min)) + (when (search-forward-regexp "/" nil 'noerror) + (string-trim (buffer-substring (match-beginning 0) (point-max)))))) ;; On hydra.nixos.org, the $PATH environment variable is too long to ;; send it. This is likely not due to PATH_MAX, but PIPE_BUF. We commit f0d58d976a62b92bdcfe0bebdfe81c7f463fb938 Author: Eli Zaretskii Date: Sat Feb 22 13:35:30 2025 +0200 ; * lisp/ibuf-macs.el (define-ibuffer-op): Fix long lines. diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index 667dd1fff0f..4a283420efd 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -256,11 +256,13 @@ buffer object. ()) (and after `(,after)) ; post-operation form. `((ibuffer-redisplay t) - (message (concat "Operation finished; " (if (functionp ,opstring-sym) - (funcall ,opstring-sym) - ,opstring-sym) + (message (concat "Operation finished; " + (if (functionp ,opstring-sym) + (funcall ,opstring-sym) + ,opstring-sym) " %s %s") - count (ngettext "buffer" "buffers" count))))) + count (ngettext "buffer" "buffers" + count))))) (inner-body (if complex `(progn ,@body) `(progn @@ -285,14 +287,16 @@ buffer object. (prog1 ,inner-body (when (not (eq ibuffer-tmp-previous-buffer-modification (buffer-modified-p buf))) - (setq ibuffer-did-modification t)))) + (setq + ibuffer-did-modification t)))) inner-body))))) ,finish))) (if dangerous - `(when (ibuffer-confirm-operation-on (if (functionp ,active-opstring-sym) - (funcall ,active-opstring-sym) - ,active-opstring-sym) - marked-names) + `(when (ibuffer-confirm-operation-on + (if (functionp ,active-opstring-sym) + (funcall ,active-opstring-sym) + ,active-opstring-sym) + marked-names) ,body) body)))) :autoload-end)))) commit 9a4b9a1e65857422b4c3f3ff27f21a46a30356c2 Author: Eli Zaretskii Date: Sat Feb 22 13:32:48 2025 +0200 ; * lisp/ibuffer.el: Avoid byte-compiler warnings. diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 4d381ba88c6..4aac9be37cc 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -372,6 +372,15 @@ directory, like `default-directory'." (regexp :tag "From") (regexp :tag "To")))) +;; These declarations are here to avoid byte-compiler warnings about +;; functions defined later via 'define-ibuffer-op'. +(declare-function ibuffer-do-toggle-lock "ibuffer.el") +(declare-function ibuffer-do-toggle-read-only "ibuffer.el") +(declare-function ibuffer-do-save "ibuffer.el") +(declare-function ibuffer-do-delete "ibuffer.el") +(declare-function ibuffer-do-toggle-modified "ibuffer.el") +(declare-function ibuffer-do-kill-on-deletion-marks "ibuffer.el") + (defvar-keymap ibuffer--filter-map "RET" #'ibuffer-filter-by-mode "SPC" #'ibuffer-filter-chosen-by-completion commit ecb7ad1a9aa9b98e7d582c0c9769a1ae0c52a78b Author: Eli Zaretskii Date: Sat Feb 22 13:24:53 2025 +0200 ; * etc/NEWS: Fix punctuation of last change. diff --git a/etc/NEWS b/etc/NEWS index e290f9c22be..2121400b8ac 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -432,9 +432,9 @@ set to 'title'. When non-nil, buffer sizes are shown in human readable format. --- -*** define-ibuffer-op prompts can now be functions. -The prompts opstring and active-opstring can now either be strings or -functions. This is useful when your prompts can benefit from dynamic +*** 'define-ibuffer-op' prompts can now be functions. +The prompts 'opstring' and 'active-opstring' can now either be strings +or functions. This is useful when your prompts can benefit from dynamic content. --- commit 26bd9f61f43c6898f5b143fae8f9d10150c1ba64 Author: shipmints Date: Wed Feb 12 06:09:38 2025 -0500 define-ibuffer-op opstring active-opstring functions (bug#76222) * lisp/ibuf-macs.el: (define-ibuffer-op): 'opstring' and 'active-opstring' can now be strings or functions. * etc/NEWS: Announce the change. diff --git a/etc/NEWS b/etc/NEWS index 110e955e82a..e290f9c22be 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -431,6 +431,12 @@ set to 'title'. *** New user option 'ibuffer-human-readable-size'. When non-nil, buffer sizes are shown in human readable format. +--- +*** define-ibuffer-op prompts can now be functions. +The prompts opstring and active-opstring can now either be strings or +functions. This is useful when your prompts can benefit from dynamic +content. + --- ** Buffer Menu diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index 7dbc9b4125a..667dd1fff0f 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -196,9 +196,13 @@ prompted before performing this operation. OPSTRING is a string which will be displayed to the user after the operation is complete, in the form: \"Operation complete; OPSTRING x buffers\" +OPSTRING may also be a function that returns prompt text. ACTIVE-OPSTRING is a string which will be displayed to the user in a confirmation message, in the form: \"Really ACTIVE-OPSTRING x buffers?\" +ACTIVE-OPSTRING may also be a function that returns prompt text, or +if DOCUMENTATION is not provided, ACTIVE-OPSTRING should return +documentation text. BEFORE is a form to evaluate before start the operation. AFTER is a form to evaluate once the operation is complete. COMPLEX means this function is special; if COMPLEX is nil BODY @@ -211,76 +215,87 @@ buffer object. \(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)" (declare (indent 2) (doc-string 3)) - `(progn - (defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op)) - "" "ibuffer-do-") - (symbol-name op))) - ,args - ,(if (stringp documentation) - documentation - (format "%s marked buffers." active-opstring)) - ,(if (not (null interactive)) - `(interactive ,interactive) - '(interactive)) - (cl-assert (derived-mode-p 'ibuffer-mode)) - (setq ibuffer-did-modification nil) - (let ((marked-names (,(pcase mark - (:deletion - 'ibuffer-deletion-marked-buffer-names) - (_ - 'ibuffer-marked-buffer-names))))) - (when (null marked-names) - (cl-assert (get-text-property (line-beginning-position) - 'ibuffer-properties) - nil "No buffer on this line") - (setq marked-names (list (buffer-name (ibuffer-current-buffer)))) - (ibuffer-set-mark ,(pcase mark - (:deletion - 'ibuffer-deletion-char) - (_ - 'ibuffer-marked-char)))) - ,(let* ((finish (append - '(progn) - (if (eq modifier-p t) - '((setq ibuffer-did-modification t)) - ()) - (and after `(,after)) ; post-operation form. - `((ibuffer-redisplay t) - (message ,(concat "Operation finished; " opstring - " %s %s") - count (ngettext "buffer" "buffers" count))))) - (inner-body (if complex - `(progn ,@body) - `(progn - (with-current-buffer buf - (save-excursion - ,@body)) - t))) - (body `(let ((_ ,before) ; pre-operation form. - (count - (,(pcase mark - (:deletion - 'ibuffer-map-deletion-lines) - (_ - 'ibuffer-map-marked-lines)) - (lambda (buf mark) - ;; Silence warning for code that doesn't - ;; use `mark'. - (ignore mark) - ,(if (eq modifier-p :maybe) - `(let ((ibuffer-tmp-previous-buffer-modification - (buffer-modified-p buf))) - (prog1 ,inner-body - (when (not (eq ibuffer-tmp-previous-buffer-modification - (buffer-modified-p buf))) - (setq ibuffer-did-modification t)))) - inner-body))))) - ,finish))) - (if dangerous - `(when (ibuffer-confirm-operation-on ,active-opstring marked-names) - ,body) - body)))) - :autoload-end)) + (let ((opstring-sym (make-symbol "opstring")) + (active-opstring-sym (make-symbol "active-opstring"))) + `(progn + (let ((,opstring-sym ,opstring) + (,active-opstring-sym ,active-opstring)) + (defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op)) + "" "ibuffer-do-") + (symbol-name op))) + ,args + ,(if (stringp documentation) + documentation + (format "%s marked buffers." (if (functionp active-opstring) + (funcall active-opstring) + active-opstring))) + ,(if (not (null interactive)) + `(interactive ,interactive) + '(interactive)) + (cl-assert (derived-mode-p 'ibuffer-mode)) + (setq ibuffer-did-modification nil) + (let ((marked-names (,(pcase mark + (:deletion + 'ibuffer-deletion-marked-buffer-names) + (_ + 'ibuffer-marked-buffer-names))))) + (when (null marked-names) + (cl-assert (get-text-property (line-beginning-position) + 'ibuffer-properties) + nil "No buffer on this line") + (setq marked-names (list (buffer-name (ibuffer-current-buffer)))) + (ibuffer-set-mark ,(pcase mark + (:deletion + 'ibuffer-deletion-char) + (_ + 'ibuffer-marked-char)))) + ,(let* ((finish (append + '(progn) + (if (eq modifier-p t) + '((setq ibuffer-did-modification t)) + ()) + (and after `(,after)) ; post-operation form. + `((ibuffer-redisplay t) + (message (concat "Operation finished; " (if (functionp ,opstring-sym) + (funcall ,opstring-sym) + ,opstring-sym) + " %s %s") + count (ngettext "buffer" "buffers" count))))) + (inner-body (if complex + `(progn ,@body) + `(progn + (with-current-buffer buf + (save-excursion + ,@body)) + t))) + (body `(let ((_ ,before) ; pre-operation form. + (count + (,(pcase mark + (:deletion + 'ibuffer-map-deletion-lines) + (_ + 'ibuffer-map-marked-lines)) + (lambda (buf mark) + ;; Silence warning for code that doesn't + ;; use `mark'. + (ignore mark) + ,(if (eq modifier-p :maybe) + `(let ((ibuffer-tmp-previous-buffer-modification + (buffer-modified-p buf))) + (prog1 ,inner-body + (when (not (eq ibuffer-tmp-previous-buffer-modification + (buffer-modified-p buf))) + (setq ibuffer-did-modification t)))) + inner-body))))) + ,finish))) + (if dangerous + `(when (ibuffer-confirm-operation-on (if (functionp ,active-opstring-sym) + (funcall ,active-opstring-sym) + ,active-opstring-sym) + marked-names) + ,body) + body)))) + :autoload-end)))) ;;;###autoload (cl-defmacro define-ibuffer-filter (name documentation commit 9c1d13c89a94685c0d1120d15e28bfb24e9644c3 (refs/remotes/origin/emacs-30) Author: Eli Zaretskii Date: Sat Feb 22 12:07:16 2025 +0200 ; * admin/authors.el (authors-aliases): Add Vladimir Nikishkin. diff --git a/admin/authors.el b/admin/authors.el index f724e871056..946b1598f37 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -179,6 +179,7 @@ files.") ("Lars Magne Ingebrigtsen" "Lars Ingebrigtsen") ("Laurence Warne" "lWarne" "laurencewarne@gmail\\.com") (nil "lensplaysgames@gmail\\.com") + ("Vladimir Nikishkin" "lockywolf") (nil "lorniu@gmail\\.com") (nil "LynX@bk\\.ru") (nil "lu4nx") commit 456c52978c505ce09467564cda3db30d3d38197c Author: Eli Zaretskii Date: Sat Feb 22 11:49:25 2025 +0200 ; Fix saveplace-tests for MS-Windows * test/lisp/saveplace-tests.el (saveplace-test-load-alist-from-file): Fix test for MS-Windows. diff --git a/test/lisp/saveplace-tests.el b/test/lisp/saveplace-tests.el index ac4ee3acffe..a694dacff8d 100644 --- a/test/lisp/saveplace-tests.el +++ b/test/lisp/saveplace-tests.el @@ -86,9 +86,17 @@ (save-place-alist nil)) (save-place-load-alist-from-file) (should (equal save-place-alist - '(("/home/skangas/.emacs.d/cache/recentf" . 1306) - ("/home/skangas/wip/emacs/" - (dired-filename . "/home/skangas/wip/emacs/COPYING"))))))) + (list + (cons + ;; We use expand-file-name here because on + ;; MS-Windows an absolute file name should have a + ;; drive letter. + (expand-file-name "/home/skangas/.emacs.d/cache/recentf") + 1306) + (list + (expand-file-name "/home/skangas/wip/emacs/") + (cons 'dired-filename + (expand-file-name "/home/skangas/wip/emacs/COPYING")))))))) (provide 'saveplace-tests) ;;; saveplace-tests.el ends here commit 8f45cbdee45317faa978732fa5311c3c056b559f Author: shipmints Date: Thu Feb 13 08:10:45 2025 -0500 Inhibit "Wrote" message in saveplace.el when non-interactive * lisp/saveplace.el (save-place-alist-to-file): Tell 'write-region' to be quiet when called non-interactively. This is in harmony with 'savehist-save'. (Bug#76267) diff --git a/lisp/saveplace.el b/lisp/saveplace.el index b6c57d2da80..19075d8c7ea 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -401,7 +401,8 @@ may have changed) back to `save-place-alist'." t)))) (condition-case nil ;; Don't use write-file; we don't want this buffer to visit it. - (write-region (point-min) (point-max) file) + (write-region (point-min) (point-max) file nil + (unless (called-interactively-p 'interactive) 'quiet)) (file-error (message "Saving places: can't write %s" file))))))) (defun save-places-to-alist () commit 0ee50a3420fb8df8f3477dac610dcd53c633fff5 Author: Visuwesh Date: Thu Feb 13 16:43:06 2025 +0530 Make yank-media auto select the best mime type * lisp/yank-media.el (yank-media-preferred-types): Add new variable that holds the list of mime types in order of their preference. (yank-media-autoselect-function): Add new variable and function to choose the most preferred media type. (yank-media): Make 'yank-media' choose the most preferred mime type by default. * doc/emacs/killing.texi (Clipboard): * doc/lispref/frames.texi (Yanking Media): Document the new behaviour, and the new variables. * etc/NEWS: Announce the change. (Bug#75116) diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 070e15dee76..aee68608bbf 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -587,8 +587,10 @@ change the variable @code{select-enable-clipboard} to @code{nil}. instance, a web browser will usually let you choose ``Copy Image'' on images, and this image will be put on the clipboard. On capable platforms, Emacs can yank these objects with the @code{yank-media} -command---but only in modes that have support for it (@pxref{Yanking -Media,,, elisp, The Emacs Lisp Reference Manual}). +command---but only in modes that have support for it. By default, it +auto-selects the preferred media type available in the clipboard but +this can be overriden by giving the prefix argument to the command +(@pxref{Yanking Media,,, elisp, The Emacs Lisp Reference Manual}). @cindex clipboard manager @vindex x-select-enable-clipboard-manager diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index bc2d6b07ae8..984f9bb597d 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4812,6 +4812,30 @@ designating the matching selection data type, and the data returned by @code{gui-get-selection}. @end defun +The @code{yank-media} command auto selects the preferred @sc{mime} type +by default. The rules used for the selection can be controlled through +the variables @code{yank-media-autoselect-function} and +@code{yank-media-preferred-types}. + +@defvar yank-media-autoselect-function +This variable should specify a function that will be called with the +list of @sc{mime} types available for the current major mode, and should +return a list of preferred @sc{mime} types to use. The first @sc{mime} +type in the list will always be used by the @code{yank-media} command +when auto selection is requested. +@end defvar + +@defvar yank-media-preferred-types +This variable changes the default selection process of +@code{yank-media-autoselect-function}. It is a list that should contain +the sole @sc{mime} type to choose in the order of their preference. It +can also contain a function in which case it is called with the list of +available @sc{mime} types and must return a list of preferred @sc{mime} +types in order of their preference. This list is passed onto the +@code{yank-media} command so the first element of the returned list is +chosen when auto selection is requested. +@end defvar + The @code{yank-media-types} command presents a list of selection data types that are currently available, which is useful when implementing yank-media handlers; for programs generally offer an eclectic and diff --git a/etc/NEWS b/etc/NEWS index b9b537ab4f5..110e955e82a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1252,6 +1252,14 @@ connected, to facilitate enabling 'strokes-mode' in sessions where the availability of a mouse device varies during execution (as is frequently observed on Android). +** Yank media + ++++ +*** 'yank-media' now auto-selects the most preferred MIME type. +Major-mode authors can customise the variables +'yank-media-autoselect-function' and/or 'yank-media-preferred-types' to +change the selection rules. + * New Modes and Packages in Emacs 31.1 diff --git a/lisp/yank-media.el b/lisp/yank-media.el index bb62ba272d3..31166b8e634 100644 --- a/lisp/yank-media.el +++ b/lisp/yank-media.el @@ -29,19 +29,67 @@ (defvar yank-media--registered-handlers nil) +(defvar yank-media-autoselect-function #'yank-media-autoselect-function + "Function to auto select the best MIME types when many are available. +The function is called with a list of MIME types that have handler in +the current buffer, and should return the list of MIME types to use in +order of their priority. When `yank-media' auto-selects the MIME type, +it will always choose the first one of the returned list. +Major-mode authors can change this variable to influence the selection +process.") + +(defvar yank-media-preferred-types + `(;; Check first since LibreOffice also puts a PNG image in the + ;; clipboard when a table cell is copied. + application/x-libreoffice-tsvc + ;; Give PNG more priority. + image/png + image/jpeg + ;; These are files copied/cut to the clipboard from a file manager + ;; in a GNU/Linux and/or BSD environment. + ,@(when (memq window-system '(x pgtk)) + (list (lambda (mimetypes) + (ensure-list + (seq-find (lambda (type) + (string-match-p "x-special/\\(gnome\\|KDE\\|mate\\)-copied-files" + (symbol-name type))) + mimetypes))))) + ;; FIXME: We should have a way to handle text/rtf. + text/html) + "List of MIME types in the order of preference. +Each element in the list should be a symbol to choose that MIME type +exclusively, or a function of one argument and should return the list of +MIME types to use in order of their priority or nil if no preferred type +is found. +Major-mode authors can change this variable to influence the selection +process, or by directly changing the variable +`yank-media-autoselect-function'.") + +(defun yank-media-autoselect-function (mimetypes) + (catch 'preferred + (dolist (typ yank-media-preferred-types) + (let ((ret (if (functionp typ) + (funcall typ mimetypes) + (and (memq typ mimetypes) (list typ))))) + (when ret (throw 'preferred ret)))))) + ;;;###autoload -(defun yank-media () +(defun yank-media (&optional noselect) "Yank media (images, HTML and the like) from the clipboard. This command depends on the current major mode having support for accepting the media type. The mode has to register itself using the `yank-media-handler' mechanism. +Optional argument NOSELECT non-nil (interactively, with a prefix +argument) means to skip auto-selecting the best MIME type and ask for +the MIME type to use. Also see `yank-media-types' for a command that lets you explore all the different selection types." - (interactive) + (interactive "P") (unless yank-media--registered-handlers (user-error "The `%s' mode hasn't registered any handlers" major-mode)) - (let ((all-types nil)) + (let ((all-types nil) + pref-type) (pcase-dolist (`(,handled-type . ,handler) yank-media--registered-handlers) (dolist (type (yank-media--find-matching-media handled-type)) @@ -49,18 +97,35 @@ all the different selection types." (unless all-types (user-error "No handler in the current buffer for anything on the clipboard")) - ;; We have a handler in the current buffer; if there's just - ;; matching type, just call the handler. - (if (length= all-types 1) + (setq pref-type (and (null noselect) + (funcall yank-media-autoselect-function + (mapcar #'car all-types)))) + (cond + ;; We are asked to autoselect and have a preferred MIME type. + ((and (null noselect) pref-type) + (funcall (cdr (assq (car pref-type) all-types)) + (car pref-type) + (yank-media--get-selection (car pref-type)))) + ;; We are asked to autoselect and no preferred MIME type. + ((and (null noselect) (null pref-type)) + (message + (substitute-command-keys + "No preferred MIME type to yank, try \\[universal-argument] \\[yank-media]"))) + ;; No autoselection and there's only one media type available. + ((and noselect (length= all-types 1)) + (when (y-or-n-p (format "Yank the `%s' clipboard item?" + (caar all-types))) (funcall (cdar all-types) (caar all-types) - (yank-media--get-selection (caar all-types))) - ;; More than one type the user for what type to insert. + (yank-media--get-selection (caar all-types))))) + ;; No autoselection and multiple media types available. + ((and noselect (length> all-types 1)) (let ((type (intern (completing-read "Several types available, choose one: " - (mapcar #'car all-types) nil t)))) + (or pref-type (mapcar #'car all-types)) + nil t)))) (funcall (alist-get type all-types) - type (yank-media--get-selection type)))))) + type (yank-media--get-selection type))))))) (defun yank-media--find-matching-media (handled-type) (seq-filter commit 3e269371507ea4cd7e933e39320d258a3b98de44 Author: Mauro Aranda Date: Thu Feb 6 08:01:08 2025 -0300 Speed up widget creation (Bug#53606) * lisp/wid-edit.el (widget-default-create, widget-checklist-add-item) (widget-radio-add-item, widget-editable-list-entry-create): Don't insert format escapes into the buffer, only to delete them after. This avoids calls to delete-char and makes widget creation about 3 times faster. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index a1d4c4850ae..2d6075c10a8 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1776,18 +1776,20 @@ to a given widget." (defun widget-default-create (widget) "Create WIDGET at point in the current buffer." (widget-specify-insert - (let ((from (point)) + (let ((str (widget-get widget :format)) + (onext 0) (next 0) button-begin button-end sample-begin sample-end doc-begin doc-end value-pos (markers (widget--prepare-markers-for-inside-insertion widget))) - (insert (widget-get widget :format)) - (goto-char from) ;; Parse escapes in format. - (while (re-search-forward "%\\(.\\)" nil t) - (let ((escape (char-after (match-beginning 1)))) - (delete-char -2) + (while (string-match "%\\(.\\)" str next) + (setq next (match-end 1)) + ;; If we skipped some literal text, insert it. + (when (/= (- next onext) 2) + (insert (substring str onext (- next 2)))) + (let ((escape (string-to-char (match-string 1 str)))) (cond ((eq escape ?%) (insert ?%)) ((eq escape ?\[) @@ -1831,7 +1833,11 @@ to a given widget." (widget-apply widget :value-create) (setq value-pos (point)))) (t - (widget-apply widget :format-handler escape))))) + (widget-apply widget :format-handler escape)))) + (setq onext next)) + ;; Insert remaining literal text, if any. + (when (> (length str) next) + (insert (substring str next))) ;; Specify button, sample, and doc, and insert value. (and button-begin button-end (widget-specify-button widget button-begin button-end)) @@ -2578,14 +2584,15 @@ If the item is checked, CHOSEN is a cons whose cdr is the value." (buttons (widget-get widget :buttons)) (button-args (or (widget-get type :sibling-args) (widget-get widget :button-args))) - (from (point)) + (str (widget-get widget :entry-format)) + (onext 0) (next 0) child button) - (insert (widget-get widget :entry-format)) - (goto-char from) ;; Parse % escapes in format. - (while (re-search-forward "%\\([bv%]\\)" nil t) - (let ((escape (char-after (match-beginning 1)))) - (delete-char -2) + (while (string-match "%\\([bv%]\\)" str next) + (setq next (match-end 1)) + (when (/= (- next onext) 2) + (insert (substring str onext (- next 2)))) + (let ((escape (string-to-char (match-string 1 str)))) (cond ((eq escape ?%) (insert ?%)) ((eq escape ?b) @@ -2609,7 +2616,10 @@ If the item is checked, CHOSEN is a cons whose cdr is the value." (widget-create-child-value widget type (car (cdr chosen))))))) (t - (error "Unknown escape `%c'" escape))))) + (error "Unknown escape `%c'" escape)))) + (setq onext next)) + (when (> (length str) next) + (insert (substring str next))) ;; Update properties. (and button child (widget-put child :button button)) (and button (widget-put widget :buttons (cons button buttons))) @@ -2756,16 +2766,17 @@ Return an alist of (TYPE MATCH)." (buttons (widget-get widget :buttons)) (button-args (or (widget-get type :sibling-args) (widget-get widget :button-args))) - (from (point)) + (str (widget-get widget :entry-format)) + (onext 0) (next 0) (chosen (and (null (widget-get widget :choice)) (widget-apply type :match value))) child button) - (insert (widget-get widget :entry-format)) - (goto-char from) ;; Parse % escapes in format. - (while (re-search-forward "%\\([bv%]\\)" nil t) - (let ((escape (char-after (match-beginning 1)))) - (delete-char -2) + (while (string-match "%\\([bv%]\\)" str next) + (setq next (match-end 1)) + (when (/= (- next onext) 2) + (insert (substring str onext (- next 2)))) + (let ((escape (string-to-char (match-string 1 str)))) (cond ((eq escape ?%) (insert ?%)) ((eq escape ?b) @@ -2784,7 +2795,10 @@ Return an alist of (TYPE MATCH)." (to (widget-get child :to))) (widget-specify-unselected child from to)))) (t - (error "Unknown escape `%c'" escape))))) + (error "Unknown escape `%c'" escape)))) + (setq onext next)) + (when (> (length str) next) + (insert (substring str next))) ;; Update properties. (when chosen (widget-put widget :choice type)) @@ -3053,17 +3067,20 @@ Save CHILD into the :last-deleted list, so it can be inserted later." ;; Create a new entry to the list. (let ((type (nth 0 (widget-get widget :args))) ;; (widget-push-button-gui widget-editable-list-gui) + (str (widget-get widget :entry-format)) + (onext 0) (next 0) child delete insert) (widget-specify-insert (save-excursion (and (widget--should-indent-p) (widget-get widget :indent) - (insert-char ?\s (widget-get widget :indent))) - (insert (widget-get widget :entry-format))) + (insert-char ?\s (widget-get widget :indent)))) ;; Parse % escapes in format. - (while (re-search-forward "%\\(.\\)" nil t) - (let ((escape (char-after (match-beginning 1)))) - (delete-char -2) + (while (string-match "%\\(.\\)" str next) + (setq next (match-end 1)) + (when (/= (- next onext) 2) + (insert (substring str onext (- next 2)))) + (let ((escape (string-to-char (match-string 1 str)))) (cond ((eq escape ?%) (insert ?%)) ((eq escape ?i) @@ -3079,7 +3096,10 @@ Save CHILD into the :last-deleted list, so it can be inserted later." widget type (if conv value (widget-default-get type))))) (t - (error "Unknown escape `%c'" escape))))) + (error "Unknown escape `%c'" escape)))) + (setq onext next)) + (when (> (length str) next) + (insert (substring str next))) (let ((buttons (widget-get widget :buttons))) (if insert (push insert buttons)) (if delete (push delete buttons)) commit 443df12eddc66f4e2dbb14113b868f12419508bc Author: Eli Zaretskii Date: Sat Feb 22 09:16:05 2025 +0200 ; * INSTALL.REPO: Minor copyedits. diff --git a/INSTALL.REPO b/INSTALL.REPO index 6a6c7a2187b..0a687ce8d9e 100644 --- a/INSTALL.REPO +++ b/INSTALL.REPO @@ -15,6 +15,11 @@ example: $ make configure="--prefix=/opt/emacs CFLAGS='-O0 -g3'" +(We recommend the above CFLAGS if you want to build Emacs that will +be easy to debug. In addition, including --enable-checking=all in +the value of 'configure' above will turn on many run-time checks +that will identify problematic code sooner rather than later.) + If the above doesn't work, or if you have special build requirements, the following information may be helpful. @@ -25,8 +30,9 @@ autoconf - at least the version specified near the start of configure.ac (in the AC_PREREQ command). git - at least Git 1.7.1. If your repository was created by an older Git version, you may need to reclone it. -makeinfo - not strictly necessary, but highly recommended, so that - you can build the manuals. GNU Texinfo 4.13 or later should work. +makeinfo - required to build the manuals (whose Info files are not + in the repository). Installing GNU Texinfo 4.13 or later should + work. To use the autotools, run the following shell command to generate the 'configure' script and some related files, and to set up your git @@ -96,6 +102,9 @@ problem is known about and is just waiting for someone to fix it. This is especially true for Lisp compilation errors, which are almost never platform-specific. +If you need to debug Emacs, the instructions in 'etc/DEBUG' will help. +You can display that file in Emacs with 'C-h C-d', or just read it with +any program that can display text files, such as Less. Copyright (C) 2002-2025 Free Software Foundation, Inc. commit 76b938fc1d24b9dcc0c50db1dc520fbdacc19a16 Author: Ulrich Müller Date: Fri Feb 21 12:13:20 2025 +0100 ; Don't fail image tests if jpeg is supported via imagemagick * test/lisp/image-tests.el (image-supported-file-p/optional): Consider also the imagemagick case. (Bug#76465) diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index 03d20758052..455118cb98c 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -80,9 +80,12 @@ (should (eq (image-supported-file-p "foo.pbm") 'pbm))) (ert-deftest image-supported-file-p/optional () - (if (image-type-available-p 'jpeg) - (should (eq (image-supported-file-p "foo.jpg") 'jpeg)) - (should-not (image-supported-file-p "foo.jpg")))) + (cond ((image-type-available-p 'jpeg) + (should (eq (image-supported-file-p "foo.jpg") 'jpeg))) + ((fboundp 'imagemagick-types) + (should (eq (image-supported-file-p "foo.jpg") 'imagemagick))) + (nil + (should-not (image-supported-file-p "foo.jpg"))))) (ert-deftest image-supported-file-p/unsupported-returns-nil () (should-not (image-supported-file-p "foo.some-unsupported-format"))) commit f8ff9592be9181465740ee98b71513cdbcafc35f Author: Ulrich Müller Date: Fri Feb 21 09:15:50 2025 +0100 ; Skip autorevert test when notify support is missing * test/lisp/autorevert-tests.el (auto-revert-test07-auto-revert-several-buffers): Skip if file notification support is not available. (Bug#76459) diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 6f5e0192791..73fd5a66fa2 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -572,6 +572,8 @@ This expects `auto-revert--messages' to be bound by ;; This is inspired by Bug#44638, Bug#71424. (ert-deftest auto-revert-test07-auto-revert-several-buffers () "Check autorevert for several buffers visiting the same file." + (skip-unless (or file-notify--library + (file-remote-p temporary-file-directory))) ;; (with-auto-revert-test (ert-with-temp-file tmpfile (let ((auto-revert-use-notify t) commit 230ecb1e273e3fec6400cfad76e9b13f648d9055 Author: Ulrich Müller Date: Fri Feb 21 10:36:52 2025 +0100 ; Skip shr-test/zoom-image test if png or libxml support is missing * test/lisp/net/shr-tests.el (shr-test/zoom-image): Skip if png images or libxml are not supported. (Bug#76464) diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el index beb9bfe85a9..8d66684c96d 100644 --- a/test/lisp/net/shr-tests.el +++ b/test/lisp/net/shr-tests.el @@ -135,7 +135,9 @@ settings, then once more for each (OPTION . VALUE) pair.") (ert-deftest shr-test/zoom-image () "Test that `shr-zoom-image' properly replaces the original image." - (skip-unless (bound-and-true-p image-types)) + (skip-unless (and (bound-and-true-p image-types) + (image-type-available-p 'png) + (fboundp 'libxml-parse-html-region))) (let* ((image (expand-file-name "data/image/blank-100x200.png" (getenv "EMACS_TEST_DIRECTORY"))) (image-url (concat "file://" (if (string-prefix-p "/" image) commit cc51bd569874cd89a7fa1c3241033e69a5c2dd01 Author: Ulrich Müller Date: Fri Feb 21 09:58:16 2025 +0100 ; Skip image type test if support is missing * test/lisp/image-tests.el (image-type-from-file-name): Skip if image types are not available. (Bug#76462) diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index 69557c83657..03d20758052 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -88,6 +88,9 @@ (should-not (image-supported-file-p "foo.some-unsupported-format"))) (ert-deftest image-type-from-file-name () + (skip-unless (and (image-type-available-p 'jpeg) + (image-type-available-p 'png) + (image-type-available-p 'webp))) (with-suppressed-warnings ((obsolete image-type-from-file-name)) (should (eq (image-type-from-file-name "foo.jpg") 'jpeg)) (should (eq (image-type-from-file-name "foo.png") 'png))