From 5f0313c01121a0a1e7f39f447425b5a8b70fb8c0 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 1 May 2021 12:19:05 +0200
Subject: [PATCH 11/11] etc: committer: Handle substitute-keyword-arguments.

* etc/committer.scm.in
  (keyword-list->alist): Rename to ...
  (keyword-list->alist/list): ..., and document the input format.
  While we're at it, correct the arguments to 'warning'.
  (keyword-list->alist/possibly-quoted): New procedure, removing
  'quote', 'quasiquote' and supporting 'substitute-keyword-arguments'.
  (pairwise-foreach-keyword): Use new procedure.
  (unwrap-list): Also remove 'quote' and 'quasiquote' when in a
  'let', 'let*' form.  Does not strictly belong in this commit,
  but it was required for my test case.
  (change-commit-message/one-pass)[get-values/list]: Remove ...
  (change-commit-message/one-pass)[get-values/no-unquote]: ... and replace
  with this.
  (change-commit-message/one-pass): Use new procedure get-values/no-unquote
  instead of get-values/list.
---
 etc/committer.scm.in | 41 ++++++++++++++++++++++++++++-------------
 1 file changed, 28 insertions(+), 13 deletions(-)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index c056de912c..7c63e38e8a 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -207,18 +207,34 @@ corresponding to the top-level definition containing the staged changes."
                         (+ (lines-to-first-change hunk)
                            (hunk-new-line-number hunk))))))
 
-(define (keyword-list->alist kwlist)
+;; Input: a list of keywords and the corresponding values,
+;; without an exterior quote, quasiquote or list.
+(define (keyword-list->alist/list kwlist)
   (match kwlist
     (() '())
     (((? keyword? k) object . rest)
      `((,k . ,object) . ,(keyword-list->alist rest)))
-    (_ (warning (G_ "cannot interpret as keyword argument list: ‘~a’~%") '())
+    (_ (warning (G_ "cannot interpret as keyword argument list: ‘~a’~%") kwlist)
+       '())))
+
+;; Input: an expression representing a list of keywords and the corresponding
+;; values, including any exterior quote, quasiquote or list.
+(define (keyword-list->alist/possibly-quoted list-sexp)
+  (match list-sexp
+    (((or 'quote 'quasiquote) l)
+     (keyword-list->alist/list l))
+    ((substitute-keyword-arguments _ (((? keyword? k) _) l) ...)
+     (map (lambda (key value)
+            (cons key (unwrap-list value)))
+          k l))
+    (_ (warning (G_ "cannot interpret as keyword argument list: ‘~a’~%")
+                list-sexp)
        '())))
 
 (define (pairwise-foreach-keyword proc . arguments)
   "Apply PROC with each keyword argument and corresponding values
 in ARGUMENTS.  If a value is not present in a argument, pass #f instead."
-  (let* ((alists (map keyword-list->alist arguments))
+  (let* ((alists (map keyword-list->alist/possibly-quoted arguments))
          (keywords (delete-duplicates
                     (apply append (map (cut map car <>) alists))
                     eq?)))
@@ -301,12 +317,13 @@ Return false if all changes could be explained and truth otherwise."
 ;; '(x ...) -> (x ...)
 ;; `(x ...) -> (x ...)
 ;; (list x ...) -> (x ...)
+;; and remove let and let* bindings
 (define (unwrap-list list)
   (case (car list)
     ((quasiquote quote) (second list))
     ((list) (cdr list))
     ;; Hopefully the bindings weren't important ...
-    ((let let*) (last list))
+    ((let let*) (unwrap-list (last list)))
     (else (error "I can't interpret that as a list!"))))
 
 (define* (change-commit-message/one-pass
@@ -322,14 +339,12 @@ SUMMARY: first using a ‘void port’, then with the ‘real’ output port."
       (() '())
       ((first . rest)
        (map cadadr first))))
-  ;; Like get-values, but also allow quote and do not treat
-  ;; the value of the field as an alist.
-  (define (get-values/list expr field)
-    (match ((sxpath `(// ,field ,(node-or (sxpath '(quasiquote))
-                                          (sxpath '(quote))))) expr)
+  ;; Like get-values, but do not remove the exterior quasiquote
+  ;; or quote.
+  (define (get-values/no-unquote expr field)
+    (match ((sxpath `(// ,field *)) expr)
       (() '())
-      ((first . rest)
-       (second first))))
+      ((first . rest) first)))
   (define (listify items)
     (match items
       ((one) one)
@@ -444,8 +459,8 @@ SUMMARY: first using a ‘void port’, then with the ‘real’ output port."
            (_ (format port "[arguments]<#:phases>: Update.~%"))))
         ;; There were some unexplained changes.
         (else (format port "[arguments]<~a>: Update.~%" keyword)))))
-  (let ((old-arguments (or (get-values/list old 'arguments) '()))
-        (new-arguments (or (get-values/list new 'arguments) '())))
+  (let ((old-arguments (get-values/no-unquote old 'arguments))
+        (new-arguments (get-values/no-unquote new 'arguments)))
     (pairwise-foreach-keyword explain-argument old-arguments
                               new-arguments)))
 
-- 
2.31.1