From 55725724dd0891e1e195158d0774a3f9a8619361 Mon Sep 17 00:00:00 2001
From: Antero Mejr <antero@mailbox.org>
Date: Tue, 12 Jul 2022 22:50:07 +0000
Subject: home: Add -I, --list-installed option.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* guix/scripts/package.scm (list-installed): New procedure.
* guix/scripts/home.scm (%options, show-help): Add '--list-installed'.
(process-command): For 'describe' and 'list-generations', honor the
'list-installed option.
(display-home-environment-generation): Add #:list-installed-regex and
honor it.
(list-generations): Likewise.
* guix/scripts/utils.scm (pretty-print-table): New argument "left-pad".
* doc/guix.texi (Invoking Guix Home): Add information and example for
--list-installed flag.

Co-authored-by: Ludovic Courtès <ludo@gnu.org>
---
 guix/scripts/package.scm | 33 ++++++++++++++++++++-------------
 1 file changed, 20 insertions(+), 13 deletions(-)

(limited to 'guix/scripts/package.scm')

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 99a6cfaa29..7d92598efa 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
 ;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
+;;; Copyright © 2022 Antero Mejr <antero@mailbox.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -67,6 +68,7 @@
             delete-generations
             delete-matching-generations
             guix-package
+            list-installed
 
             search-path-environment-variables
             manifest-entry-version-prefix
@@ -773,6 +775,22 @@ doesn't need it."
 
   (add-indirect-root store absolute))
 
+(define (list-installed regexp profiles)
+  "Write to the current output port the list of packages matching REGEXP in
+PROFILES."
+  (let* ((regexp    (and regexp (make-regexp* regexp regexp/icase)))
+         (manifest  (concatenate-manifests
+                     (map profile-manifest profiles)))
+         (installed (manifest-entries manifest)))
+    (leave-on-EPIPE
+     (let ((rows (filter-map
+                  (match-lambda
+                    (($ <manifest-entry> name version output path _)
+                     (and (regexp-exec regexp name)
+                          (list name (or version "?") output path))))
+                  installed)))
+       rows))))
+
 
 ;;;
 ;;; Queries and actions.
@@ -824,19 +842,8 @@ processed, #f otherwise."
        #t)
 
       (('list-installed regexp)
-       (let* ((regexp    (and regexp (make-regexp* regexp regexp/icase)))
-              (manifest  (concatenate-manifests
-                          (map profile-manifest profiles)))
-              (installed (manifest-entries manifest)))
-         (leave-on-EPIPE
-          (let ((rows (filter-map
-                       (match-lambda
-                         (($ <manifest-entry> name version output path _)
-                          (and (regexp-exec regexp name)
-                               (list name (or version "?") output path))))
-                       installed)))
-            ;; Show most recently installed packages last.
-            (pretty-print-table (reverse rows)))))
+       ;; Show most recently installed packages last.
+       (pretty-print-table (reverse (list-installed regexp profiles)))
        #t)
 
       (('list-available regexp)
-- 
cgit v1.2.3