aboutsummaryrefslogtreecommitdiff
path: root/gnu/installer/newt/user.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/installer/newt/user.scm')
-rw-r--r--gnu/installer/newt/user.scm64
1 files changed, 39 insertions, 25 deletions
diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm
index b01d52172b..ad711d665a 100644
--- a/gnu/installer/newt/user.scm
+++ b/gnu/installer/newt/user.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
@@ -23,6 +23,7 @@
#:use-module ((gnu installer steps) #:select (&installer-step-abort))
#:use-module (gnu installer newt page)
#:use-module (gnu installer newt utils)
+ #:use-module (gnu installer utils)
#:use-module (guix i18n)
#:use-module (newt)
#:use-module (ice-9 match)
@@ -115,6 +116,7 @@ REAL-NAME, and HOME-DIRECTORY as the initial values in the form."
GRID-ELEMENT-SUBGRID entry-grid
GRID-ELEMENT-SUBGRID button-grid)
title)
+
(let ((error-page
(lambda ()
(run-error-page (G_ "Empty inputs are not allowed.")
@@ -230,33 +232,45 @@ administrator (\"root\").")
(set-current-component form ok-button))
(receive (exit-reason argument)
- (run-form form)
+ (run-form-with-clients form '(add-users))
(dynamic-wind
(const #t)
(lambda ()
- (when (eq? exit-reason 'exit-component)
- (cond
- ((components=? argument add-button)
- (run (cons (run-user-add-page) users)))
- ((components=? argument del-button)
- (let* ((current-user-key (current-listbox-entry listbox))
- (users
- (map (cut assoc-ref <> 'user)
- (remove (lambda (element)
- (equal? (assoc-ref element 'key)
- current-user-key))
- listbox-elements))))
- (run users)))
- ((components=? argument ok-button)
- (when (null? users)
- (run-error-page (G_ "Please create at least one user.")
- (G_ "No user"))
- (run users))
- (reverse users))
- ((components=? argument exit-button)
- (raise
- (condition
- (&installer-step-abort)))))))
+ (match exit-reason
+ ('exit-component
+ (cond
+ ((components=? argument add-button)
+ (run (cons (run-user-add-page) users)))
+ ((components=? argument del-button)
+ (let* ((current-user-key (current-listbox-entry listbox))
+ (users
+ (map (cut assoc-ref <> 'user)
+ (remove (lambda (element)
+ (equal? (assoc-ref element 'key)
+ current-user-key))
+ listbox-elements))))
+ (run users)))
+ ((components=? argument ok-button)
+ (when (null? users)
+ (run-error-page (G_ "Please create at least one user.")
+ (G_ "No user"))
+ (run users))
+ (reverse users))
+ ((components=? argument exit-button)
+ (raise
+ (condition
+ (&installer-step-abort))))))
+ ('exit-fd-ready
+ ;; Read the complete user list at once.
+ (match argument
+ ((('user ('name names) ('real-name real-names)
+ ('home-directory homes) ('password passwords))
+ ..1)
+ (map (lambda (name real-name home password)
+ (user (name name) (real-name real-name)
+ (home-directory home)
+ (password password)))
+ names real-names homes passwords))))))
(lambda ()
(destroy-form-and-pop form))))))