From 68679bb6cab3b4480fa4f1b89d7a87ac1ddb3c64 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Wed, 5 Jan 2022 16:12:54 +0530
Subject: build-aux: Abstract out opening an archive file.

* build-aux/distcheck.scm (call-with-archive-file): New function.
(package-in-archive): Use call-with-archive-file.
* .dir-locals.el (scheme-mode): Indent call-with-archive-file
correctly.
---
 .dir-locals.el          |  3 ++-
 build-aux/distcheck.scm | 14 +++++++++-----
 2 files changed, 11 insertions(+), 6 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index d20a471..ffa88a2 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -6,4 +6,5 @@
  (makefile-gmake-mode
   (indent-tabs-mode t))
  (scheme-mode
-  (eval . (put 'call-with-input-pipe 'scheme-indent-function 1))))
+  (eval . (put 'call-with-input-pipe 'scheme-indent-function 1))
+  (eval . (put 'call-with-archive-file 'scheme-indent-function 2))))
diff --git a/build-aux/distcheck.scm b/build-aux/distcheck.scm
index 4b08c66..83e3db3 100644
--- a/build-aux/distcheck.scm
+++ b/build-aux/distcheck.scm
@@ -39,13 +39,17 @@ arguments."
          (cut proc port)
          (cut close-pipe port))))))
 
+(define (call-with-archive-file archive file proc)
+  "Call PROC with port reading FILE in lzip compressed tar ARCHIVE."
+  (call-with-input-pipe (list "tar" "--extract" "--to-stdout"
+                              "--file" archive
+                              (string-append (basename archive ".tar.lz")
+                                             "/" file))
+    proc))
+
 (define (package-in-archive dist-archive)
   "Return the package object in guix.scm of DIST-ARCHIVE."
-  (call-with-input-pipe (list "tar" "--extract" "--to-stdout"
-                              "--file" dist-archive
-                              (string-append
-                               (basename dist-archive ".tar.lz")
-                               "/guix.scm"))
+  (call-with-archive-file dist-archive "guix.scm"
     (lambda (port)
       (eval-string (get-string-all port)
                    #:file (string-append (getcwd) "/guix.scm")))))
-- 
cgit v1.2.3