pull: Add channel filtering options to the CLI.

* doc/guix.texi (Invoking guix pull): Document channel selection and exclusion
flags.
* etc/news.scm: Add entry.
* guix/scripts/pull.scm (show-help): Add help strings for channel selection
and exclusion flags.
(%options): Handle channel selection and exclusion flags.
(collect-alist-values): New procedure.
(options->channel-transformation): New procedure.
(channel-list): Implement channel selection and exclusion logic.
* guix/scripts/time-machine.scm (show-help): Add help strings for channel
selection and exclusion flags.
(%options): Handle channel selection and exclusion flags.

Change-Id: Ia22c5c38903ed1a2b9a9353ff94b70795820376d
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Modified-by: Ludovic Courtès <ludo@gnu.org>

3 files changed, 140 insertions, 11 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 7950843c3c2..127c87f7f48 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -140,7 +140,7 @@ Copyright @copyright{} 2024 Greg Hogan@*
 Copyright @copyright{} 2025 Sören Tempel@*
 Copyright @copyright{} 2025 Rostislav Svoboda@*
 Copyright @copyright{} 2025 Zacchaeus@*
-Copyright @copyright{} 2025 Sergio Pastor Pérez@*
+Copyright @copyright{} 2025, 2026 Sergio Pastor Pérez@*
 Copyright @copyright{} 2024 Evgeny Pisemsky@*
 Copyright @copyright{} 2025 jgart@*
 Copyright @copyright{} 2025 Artur Wroblewski@*
@@ -5014,6 +5014,21 @@ understand the code of the channel files you use!
 Inhibit loading of the user and system channel files,
 @file{~/.config/guix/channels.scm} and @file{/etc/guix/channels.scm}.
 
+@cindex pinning channels, with @command{guix pull}
+@anchor{pull-select}
+@item --select=@var{channel}
+@itemx -e
+Update only @var{channel}, keeping the commit of any other non-selected
+channel unchanged.  In other words, any channel not selected with this
+option is effectively @dfn{pinned} to its current commit.  This option
+can be repeated.
+
+@item --exclude=@var{channel}
+@itemx -x
+Prevent @var{channel} from being updated, effectively @dfn{pinning} it
+to its current commit as shown by @command{guix describe}.  All the
+other channels will be updated.  This option can be repeated.
+
 @cindex channel news
 @item --news
 @itemx -N
@@ -5325,6 +5340,13 @@ Substitution,,, bash, The GNU Bash Reference Manual}):
 guix time-machine -C <(echo %default-channels) @dots{}
 @end example
 
+@item --select
+@itemx -e
+@itemx --exclude
+@itemx -x
+Select or exclude channels that need to be updated.  @xref{pull-select}, for
+more info.
+
 @end table
 
 Note that @command{guix time-machine} can trigger builds of channels and
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 7fba0efa2a6..681354f6e3e 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2013-2015, 2017-2024, 2026 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2026 Sergio Pastor Pérez <sergio.pastorperez@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -94,6 +95,10 @@ Download and deploy the latest version of Guix.\n"))
   -q, --no-channel-files
                          inhibit loading of user and system 'channels.scm'"))
   (display (G_ "
+  -e, --select=CHANNEL   select CHANNEL to update"))
+  (display (G_ "
+  -x, --exclude=CHANNEL  exclude CHANNEL from being updated"))
+  (display (G_ "
       --url=URL          download \"guix\" channel from the Git repository at URL"))
   (display (G_ "
       --commit=COMMIT    download the specified \"guix\" channel COMMIT"))
@@ -155,6 +160,12 @@ Download and deploy the latest version of Guix.\n"))
          (option '(#\q "no-channel-files") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'ignore-channel-files? #t result)))
+         (option '(#\e "select") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'select (string->symbol arg) result)))
+         (option '(#\x "exclude") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'exclude (string->symbol arg) result)))
          (option '(#\l "list-generations") #f #t
                  (lambda (opt name arg result)
                    (cons `(query list-generations ,arg)
@@ -807,6 +818,69 @@ identifier."
     (#f (leave (G_ "~a: invalid content SWHID~%") swhid))
     (port port)))
 
+(define (collect-alist-values key alist)
+  "Return a list of all values from ALIST that matches KEY."
+  (filter-map (match-lambda
+                ((k . value)
+                 (and (eq? k key) value)))
+              alist))
+
+(define (options->channel-transformation opts)
+  "Return a procedure that, when passed a channel, applies the transformations
+specified by OPTS and returns the resulting channel.  OPTS must be a list of
+symbol/string pairs such as:
+
+  ((select . \"channelA\")
+   (exclude . \"channelB\"))
+
+Each symbol names a transformation and the corresponding string is an argument
+to that transformation."
+  (define selected-channels
+    (collect-alist-values 'select opts))
+
+  (define excluded-channels
+    (collect-alist-values 'exclude opts))
+
+  (define current-channels
+    (let ((profile (or (assoc-ref opts 'profile) %current-profile)))
+      (profile-channels profile)))
+
+  (define (find-channel name lst)
+    (find (lambda (c)
+            (eq? (channel-name c) name))
+          lst))
+
+  (when (and (not (null? selected-channels))
+             (not (null? excluded-channels)))
+    (raise
+     (condition
+      (&message
+       (message (G_ "mixing incompatible '--select' and '--exclude' options"))))))
+
+  (lambda (c)
+    (let* ((name (channel-name c))
+           (raise-unknown (lambda ()
+                            (raise
+                             (make-exception
+                              (formatted-message
+                               (G_ "unknown channel '~a': cannot \
+select/exclude a channel that has never been pulled")
+                               name))))))
+      (cond
+       ;; Selection.
+       ((not (null? selected-channels))
+        (if (member name selected-channels)
+            (channel (inherit c) (commit #f))        ;unpin selected.
+            (or (find-channel name current-channels) ;pin others.
+                (raise-unknown))))
+       ;; Exclusion.
+       ((not (null? excluded-channels))
+        (if (member name excluded-channels)
+            (or (find-channel name current-channels) ;pin excluded.
+                (raise-unknown))
+            (channel (inherit c) (commit #f))))      ;unpin others.
+       (else c)))))                                  ;do nothing.
+
 (define (channel-list opts)
   "Return the list of channels to use.  If OPTS specify a channel file,
 channels are read from there; otherwise, if ~/.config/guix/channels.scm
@@ -856,17 +930,40 @@ transformations specified in OPTS (resulting from '--url', '--commit', or
             result)
           (leave (G_ "'~a' did not return a list of channels~%") file))))
 
+  (define selected-channels
+    (collect-alist-values 'select opts))
+
+  (define excluded-channels
+    (collect-alist-values 'exclude opts))
+
   (define channels
-    (cond (file
-           (load-channels file))
-          ((and (not ignore-channel-files?)
-                (file-exists? default-file))
-           (load-channels default-file))
-          ((and (not ignore-channel-files?)
-                (file-exists? global-file))
-           (load-channels global-file))
-          (else
-           %default-channels)))
+    (let* ((channels (cond (file
+                            (load-channels file))
+                           ((and (not ignore-channel-files?)
+                                 (file-exists? default-file))
+                            (load-channels default-file))
+                           ((and (not ignore-channel-files?)
+                                 (file-exists? global-file))
+                            (load-channels global-file))
+                           (else
+                            %default-channels))))
+      ;; Validate options.
+      (let ((names (cond
+                    ((not (null? selected-channels))
+                     selected-channels)
+                    ((not (null? excluded-channels))
+                     excluded-channels)
+                    (else '())))
+            (valid-names (map channel-name channels)))
+        (unless (null? names)
+          (for-each
+           (lambda (name)
+             (unless (member name valid-names)
+               (leave (G_ "channel '~a' is missing from channel list~%")
+                      name)))
+           names)))
+
+      (map (options->channel-transformation opts) channels)))
 
   (define (environment-variable)
     (match (getenv "GUIX_PULL_URL")
diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm
index ffba7ffc355..030819f6052 100644
--- a/guix/scripts/time-machine.scm
+++ b/guix/scripts/time-machine.scm
@@ -62,6 +62,10 @@ If COMMAND is not provided, print path to the time-machine profile.\n"))
   -q, --no-channel-files
                          inhibit loading of user and system 'channels.scm'"))
   (display (G_ "
+  -e, --select=CHANNEL   select CHANNEL to update"))
+  (display (G_ "
+  -x, --exclude=CHANNEL  exclude CHANNEL from being updated"))
+  (display (G_ "
       --url=URL          use the Git repository at URL"))
   (display (G_ "
       --commit=COMMIT    use the specified COMMIT"))
@@ -98,6 +102,12 @@ If COMMAND is not provided, print path to the time-machine profile.\n"))
          (option '(#\q "no-channel-files") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'ignore-channel-files? #t result)))
+         (option '(#\e "select") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'select (string->symbol arg) result)))
+         (option '(#\x "exclude") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'exclude (string->symbol arg) result)))
          (option '("url") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'repository-url arg