07/08: installer: Provide the ability to add new users.

[John Darrington]

jmd pushed a commit to branch wip-installer
in repository guix.

commit c8a02e7a19c7a9c244d8bfafc94bc7c147762dd9
Author: John Darrington <address@hidden>
Date:   Tue Feb 7 09:09:12 2017 +0100

    installer: Provide the ability to add new users.
    
    * gnu/system/installer/misc.scm (users) : Delete test data.
    * gnu/system/installer/user-edit.scm (user-edit-page-init): Do not
    initialise fields if the account is #f.
    * gnu/system/installer/users.scm (users-page-key-handler): Add handler
    for the "add" button.
---
 gnu/system/installer/misc.scm      | 17 +----------------
 gnu/system/installer/user-edit.scm | 26 ++++++++++++++------------
 gnu/system/installer/users.scm     |  9 ++++++---
 3 files changed, 21 insertions(+), 31 deletions(-)

diff --git a/gnu/system/installer/misc.scm b/gnu/system/installer/misc.scm
index c3cc93c..f1d1ac7 100644
--- a/gnu/system/installer/misc.scm
+++ b/gnu/system/installer/misc.scm
@@ -75,19 +75,4 @@
     (t            . ,normal)))
 
 
-(define users
-  (list
-   (user-account
-    (name "fred")
-    (supplementary-groups '("video" "audio" "desktop"))
-    (group "users")
-    (comment "Fred Bloggs")
-    (home-directory "/home/empty")
-    )
-
-   (user-account
-    (name "john")
-    (group "users")
-    (comment "John Darrington")
-    (home-directory "/home/john")
-    )))
+(define users '())
diff --git a/gnu/system/installer/user-edit.scm 
b/gnu/system/installer/user-edit.scm
index 27b8c2e..b3f62d6 100644
--- a/gnu/system/installer/user-edit.scm
+++ b/gnu/system/installer/user-edit.scm
@@ -35,13 +35,14 @@
                       (name        ,(M_ "User Name") 40)
                       (home        ,(M_ "Home Directory") 16)))
 
-(define (make-user-edit-page parent title)
+(define (make-user-edit-page parent title account)
   (let ((page (make-page (page-surface parent)
                        title
                        user-edit-refresh
                        1
                        user-edit-page-key-handler)))
 
+    (page-set-datum! page 'account account)
     (page-set-datum! page 'parent parent)
     page))
 
@@ -132,18 +133,19 @@
 
     (page-set-datum! p 'navigation nav)
 
-    (addstr*
-     text-window
-     (format #f
-             (gettext
-              "The user is currently with properties as follows.  You may 
change any of the details here as required.")))
-
-    (form-post form fw)
-
     (let ((acc (page-datum p 'account)))
-      (form-set-value! form 'name (user-account-name acc))
-      (form-set-value! form 'comment (user-account-comment acc))
-      (form-set-value! form 'home (user-account-home-directory acc)))
+      (addstr*
+       text-window
+       (if acc
+       (format #f (M_ "This user account currently has the following details.  
You may change any details here as required."))
+       (format #f (M_ "Enter the details of the new user below."))))
+
+      (form-post form fw)
+
+      (when acc
+            (form-set-value! form 'name (user-account-name acc))
+            (form-set-value! form 'comment (user-account-comment acc))
+            (form-set-value! form 'home (user-account-home-directory acc))))
 
     (push-cursor (page-cursor-visibility p))
     (buttons-post nav bwin)
diff --git a/gnu/system/installer/users.scm b/gnu/system/installer/users.scm
index 4234095..214d58a 100644
--- a/gnu/system/installer/users.scm
+++ b/gnu/system/installer/users.scm
@@ -78,10 +78,13 @@
       (menu-set-active! menu #t))
 
      ((select-key? ch)
-      (let* ((account  (menu-get-current-item menu))
-            (next  (make-user-edit-page page  "Edit User")))
+      (let* ((account  (menu-get-current-item menu)))
+             (if account
+                 (page-enter  (make-user-edit-page page  "Edit User" 
account)))))
 
-       (page-set-datum! next 'account account)
+     ((buttons-key-matches-symbol? nav ch 'add)
+      (let* (
+            (next  (make-user-edit-page page  "Add New User" #f)))
         (page-enter next)))
 
      ((buttons-key-matches-symbol? nav ch 'continue)