diff options
Diffstat (limited to 'gnu/installer/newt/user.scm')
| -rw-r--r-- | gnu/installer/newt/user.scm | 64 |
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)))))) |