From 0a5fac443cdcbeb9312d7ee68bafdd22e0905828 Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Sun, 28 Jan 2024 22:48:13 -0500
Subject: [PATCH] Add setf support for seq-subseq

* lisp/emacs-lisp/seq.el (seq-subseq): Add a generic version of
calling setf on seq-subseq and add a specialized version for when the
modified sequence is a list.
* test/lisp/emacs-lisp/seq-tests.el (test-setf-seq-subseq)
(test-setf-seq-subseq-combinations): Add tests for the feature.
---
 lisp/emacs-lisp/seq.el            | 43 +++++++++++++++++
 test/lisp/emacs-lisp/seq-tests.el | 76 +++++++++++++++++++++++++++++++
 2 files changed, 119 insertions(+)

diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 4c6553972c2..fd971806d87 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -193,6 +193,49 @@ seq-subseq
         (copy-sequence sequence))))
    (t (error "Unsupported sequence: %s" sequence))))
 
+(cl-defgeneric (setf seq-subseq) (store sequence start &optional end)
+  "Modify the elements of SEQUENCE from START to END to be those of STORE.
+
+SEQUENCE is neither lengthened nor shortened."
+  (let* ((len (seq-length sequence))
+         (idx (if (< start 0)
+                  (+ start len)
+                start))
+         (end (cond
+               ((null end) len)
+               ((< end 0)
+                (+ end len))
+               (t (min len end)))))
+    (when (< idx end)
+      (seq-do (lambda (v)
+                (when (< idx end)
+                  (setf (seq-elt sequence idx) v
+                        idx (1+ idx))))
+              store)))
+  store)
+
+(cl-defmethod (setf seq-subseq) (store (sequence list) start &optional end)
+  "Modify the elements of SEQUENCE from START to END to be those of STORE.
+
+SEQUENCE is neither lengthened nor shortened."
+  (let* ((len (seq-length sequence))
+         (idx (if (< start 0)
+                  (+ start len)
+                start))
+         (end (cond
+               ((null end) len)
+               ((< end 0)  (+ end len))
+               (t          (min len end)))))
+    (when (< idx end)
+      (seq-do (let ((replaced (nthcdr idx sequence)))
+                (lambda (v)
+                  (when (< idx end)
+                    (setf (car replaced) v
+                          replaced (cdr replaced)
+                          idx (1+ idx)))))
+              store)))
+  store)
+
 
 (cl-defgeneric seq-map (function sequence)
   "Return the result of applying FUNCTION to each element of SEQUENCE."
diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el
index c06ceb00bdb..6b8789688d3 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -312,6 +312,82 @@ test-seq-subseq
                   (:success
                    (should (equal (seq-subseq list start end) res))))))))))))
 
+(cl-defmacro test-setf-seq-subseq-combinations (&key result range init-vals
+                                                     sub-vals)
+  "Produce substitutions tests for `seq-subseq' using `setf'.
+
+- INIT-VALS is a list holding the initial elements.
+- RESULT is what the final value should be after substitution.
+- SUB-VALS is a list holding the elements to be substituted in.
+- RANGE is a list of the `start' and `end' arguments of `seq-subseq'."
+  (let ((tests))
+    (dolist (type1 '(list vector string))
+      (dolist (type2 '(list vector string))
+        (push  `(should (equal (,type1 ,@result)
+                               (let ((seq (,type1 ,@init-vals)))
+                                 (setf (seq-subseq seq ,@range)
+                                       (,type2 ,@sub-vals))
+                                 seq)))
+               tests)))
+    `(progn ,@tests)))
+
+(ert-deftest test-setf-seq-subseq ()
+  "Test using `seq-subseq' with `setf'.
+Any combination of sequences should work."
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2)
+   :sub-vals (10 11 12)
+   :range (0)
+   :result (10 11 12))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1)
+   :sub-vals (10 11 12)
+   :range (0)
+   :result (10 11))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1)
+   :sub-vals (10 11 12)
+   :range (0 100)
+   :result (10 11))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4)
+   :sub-vals (12 13 14 15)
+   :range (2 100)
+   :result (0 1 12 13 14))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4)
+   :sub-vals (12 13 14 15)
+   :range (2 3)
+   :result (0 1 12 3 4))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4)
+   :sub-vals (12 13 14 15)
+   :range (2 2)
+   :result (0 1 2 3 4))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (-2)
+   :result (0 1 2 10 11))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (-6 -3)
+   :result (0 1 2 3 10 11 12 7 8 9))
+
+  (test-setf-seq-subseq-combinations
+   :init-vals (0 1 2 3 4 5 6 7 8 9)
+   :sub-vals (10 11 12 13 14)
+   :range (-6 -10)
+   :result (0 1 2 3 4 5 6 7 8 9)))
+
 (ert-deftest test-seq-concatenate ()
   (with-test-sequences (seq '(2 4 6))
     (should (equal (seq-concatenate 'string seq [8]) (string 2 4 6 8)))
-- 
2.34.1