From 824d3b56b5f4bd1aac1b933c353715155edc7698 Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Sun, 1 Aug 2021 12:33:14 -0400
Subject: [PATCH] Add macro 'pcase-setq'

* doc/lispref/control.texi: Document this macro.
* lisp/emacs-lisp/pcase.el: Add this macro.

This macro is the 'setq' equivalent of 'pcase-let'.
---
 doc/lispref/control.texi |  4 ++++
 etc/NEWS                 |  4 ++++
 lisp/emacs-lisp/pcase.el | 41 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 49 insertions(+)

diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 5026d0a4d7..a0540005d2 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -1312,6 +1312,10 @@ Destructuring with pcase Patterns
 up being equivalent to @code{dolist} (@pxref{Iteration}).
 @end defmac
 
+@defmac pcase-setq pattern value@dots{}
+Bind variables to values in a @code{setq} form, destructuring each
+@var{value} according to its respective @var{pattern}.
+@end defmac
 
 @node Iteration
 @section Iteration
diff --git a/etc/NEWS b/etc/NEWS
index 95a2c87d05..0f11caf512 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -553,6 +553,10 @@ The new 'cl-type' pattern compares types using 'cl-typep', which allows
 comparing simple types like '(cl-type integer)', as well as forms like
 '(cl-type (integer 0 10))'.
 
+*** New macro 'pcase-setq'
+This macro is the 'setq' equivalent of 'pcase-let', which allows for
+destructuring patterns in a 'setq' form.
+
 +++
 ** profiler.el
 The results displayed by 'profiler-report' now have the usage figures
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 006517db75..f9665eba97 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -317,6 +317,47 @@ pcase-dolist
          (pcase-let* ((,(car spec) ,tmpvar))
            ,@body)))))
 
+;;;###autoload
+(defmacro pcase-setq (&rest args)
+  "Bind values by destructuring with `pcase'.
+
+\(fn PATTERN VALUE PATTERN VALUE ...)"
+  (declare (debug (&rest [pcase-PAT form])))
+  (let ((results)
+        (pattern)
+        (value))
+    (while args
+      (setq pattern (pop args)
+            value (pop args))
+      (push (if (pcase--trivial-upat-p pattern)
+                (list 'setq pattern value)
+              (pcase-compile-patterns
+               value
+               (list (cons pattern
+                           (lambda (varvals &rest _)
+                             (cons 'setq
+                                   (mapcan (lambda (varval)
+                                             (let ((var (car varval))
+                                                   (val (cadr varval)))
+                                               (list var val)))
+                                           varvals)))))))
+            results))
+
+    ;; Combine multiple calls to `setq' to a single call where we can.
+    (let ((returned-setqs)
+          (combining))
+      (dolist (i results)
+        (if (eq (car i) 'setq)
+            (push (cdr i) combining)
+          (when combining
+            (push `(setq ,@(apply #'append combining))
+                  returned-setqs)
+            (setq combining nil))
+          (push i returned-setqs)))
+      (when combining
+        (push `(setq ,@(apply #'append combining))
+              returned-setqs))
+      (macroexp-progn returned-setqs))))
 
 (defun pcase--trivial-upat-p (upat)
   (and (symbolp upat) (not (memq upat pcase--dontcare-upats))))
-- 
2.25.1