From c687d10681cb4455e27dceec68aa5379305ec76c Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhitton@spwhitton.name>
Date: Mon, 7 Jun 2021 10:03:25 -0700
Subject: factor out LAMBDA-IGNORING-ARGS

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
---
 src/combinator.lisp         | 9 +++------
 src/package.lisp            | 1 +
 src/property/container.lisp | 9 +++------
 src/property/disk.lisp      | 6 ++----
 src/property/libvirt.lisp   | 6 ++----
 src/util.lisp               | 7 +++++++
 6 files changed, 18 insertions(+), 20 deletions(-)

diff --git a/src/combinator.lisp b/src/combinator.lisp
index 7ba8ad6..68ae61e 100644
--- a/src/combinator.lisp
+++ b/src/combinator.lisp
@@ -239,15 +239,12 @@ FLAGFILE exists, PROPAPPS are assumed to all be already applied."
   (:retprop :type (propapptype propapp)
             :desc (get (car propapp) 'desc)
             :hostattrs (get (car propapp) 'hostattrs)
-            :check (lambda (&rest ignore)
-                     (declare (ignore ignore))
+            :check (lambda-ignoring-args
                      (remote-exists-p flagfile))
-            :apply (lambda (&rest ignore)
-                     (declare (ignore ignore))
+            :apply (lambda-ignoring-args
                      (prog1 (propappapply propapp)
                        (mrun "touch" flagfile)))
-            :unapply (lambda (&rest ignore)
-                       (declare (ignore ignore))
+            :unapply (lambda-ignoring-args
                        (prog1 (propappunapply propapp)
                          (mrun "rm" flagfile)))
             :args (cdr propapp)))
diff --git a/src/package.lisp b/src/package.lisp
index 1b2f6f7..fcd611c 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -84,6 +84,7 @@
            #:escape-sh-token
            #:escape-sh-command
            #:defpackage-consfig
+           #:lambda-ignoring-args
 
            #:*consfigurator-debug-level*
            #:with-indented-inform
diff --git a/src/property/container.lisp b/src/property/container.lisp
index a99bbb6..454cd75 100644
--- a/src/property/container.lisp
+++ b/src/property/container.lisp
@@ -58,13 +58,10 @@ container type."
                       ,form
                       :no-change))))
     (:retprop :type (propapptype propapp)
-              :hostattrs (lambda (&rest ignore)
-                           (declare (ignore ignore))
+              :hostattrs (lambda-ignoring-args
                            (propappattrs propapp))
-              :apply (lambda (&rest ignore)
-                       (declare (ignore ignore))
+              :apply (lambda-ignoring-args
                        (check-contained (propappapply propapp)))
-              :unapply (lambda (&rest ignore)
-                         (declare (ignore ignore))
+              :unapply (lambda-ignoring-args
                          (check-contained (propappunapply propapp)))
               :args (cdr propapp))))
diff --git a/src/property/disk.lisp b/src/property/disk.lisp
index c3db619..bcbe89f 100644
--- a/src/property/disk.lisp
+++ b/src/property/disk.lisp
@@ -751,13 +751,11 @@ must not be modified."
     (volumes propapp &key (mount-below nil mount-below-supplied-p))
   (:retprop
    :type (propapptype propapp)
-   :hostattrs (lambda (&rest ignore)
-                (declare (ignore ignore))
+   :hostattrs (lambda-ignoring-args
                 (require-volumes-data volumes)
                 (propappattrs propapp))
    :apply
-   (lambda (&rest ignore)
-     (declare (ignore ignore))
+   (lambda-ignoring-args
      (with-connattrs (:opened-volumes
                       (apply #'open-volumes-and-contents
                              `(,volumes ,@(and mount-below-supplied-p
diff --git a/src/property/libvirt.lisp b/src/property/libvirt.lisp
index dea12bc..5362c40 100644
--- a/src/property/libvirt.lisp
+++ b/src/property/libvirt.lisp
@@ -117,11 +117,9 @@ already running, for a VM which is not always booted, e.g. on a laptop."
     (:retprop :type (propapptype propapp)
               :desc (get (car propapp) 'desc)
               :hostattrs (get (car propapp) 'hostattrs)
-              :apply (lambda (&rest ignore)
-                       (declare (ignore ignore))
+              :apply (lambda-ignoring-args
                        (check-started (propappapply propapp)))
-              :unapply (lambda (&rest ignore)
-                         (declare (ignore ignore))
+              :unapply (lambda-ignoring-args
                          (check-started (propappunapply propapp)))
               :args (cdr propapp))))
 
diff --git a/src/util.lisp b/src/util.lisp
index fb11fec..9dd417d 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -252,6 +252,13 @@ expansion as a starting point for your own DEFPACKAGE form for your consfig."
     ;;   (push '(:use '#:cl '#:consfigurator) forms))
     `(defpackage ,name ,@forms)))
 
+(defmacro lambda-ignoring-args (&body body)
+  (multiple-value-bind (forms declarations) (parse-body body)
+    (with-gensyms (ignore)
+      `(lambda (&rest ,ignore)
+         (declare (ignore ,ignore) ,@declarations)
+         ,@forms))))
+
 
 ;;;; Progress & debug printing
 
-- 
cgit v1.2.3