171/197: installer: New page to edit user accounts.

[Danny Milosavljevic]

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

commit be5014524bcbf07cd3f70830caeb2bdb8a34dad5
Author: John Darrington <address@hidden>
Date:   Mon Feb 6 19:57:36 2017 +0100

    installer: New page to edit user accounts.
    
    * gnu/system/installer/user-edit.scm: New file.
    * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
    * gnu/system/installer/users.scm (user-page-key-handler): Start edit page on
    select.
---
 gnu/local.mk                       |   1 +
 gnu/system/installer/user-edit.scm | 153 +++++++++++++++++++++++++++++++++++++
 gnu/system/installer/users.scm     |  16 ++--
 3 files changed, 164 insertions(+), 6 deletions(-)

diff --git a/gnu/local.mk b/gnu/local.mk
index 3e8bdb7..e69b0c0 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -476,6 +476,7 @@ GNU_SYSTEM_MODULES =                                \
   %D%/system/installer/ping.scm                 \
   %D%/system/installer/key-map.scm              \
   %D%/system/installer/role.scm                 \
+  %D%/system/installer/user-edit.scm            \
   %D%/system/installer/users.scm                \
   %D%/system/installer/utils.scm                \
   %D%/system/installer/page.scm                 \
diff --git a/gnu/system/installer/user-edit.scm 
b/gnu/system/installer/user-edit.scm
new file mode 100644
index 0000000..27b8c2e
--- /dev/null
+++ b/gnu/system/installer/user-edit.scm
@@ -0,0 +1,153 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016, 2017 John Darrington <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system installer user-edit)
+  #:use-module (gnu system installer page)
+  #:use-module (gnu system installer misc)
+  #:use-module (gnu system installer utils)
+  #:use-module (gnu system shadow)
+  #:use-module (gurses form)
+  #:use-module (gurses buttons)
+  #:use-module (ncurses curses)
+  #:use-module (srfi srfi-1)
+
+  #:export (make-user-edit-page)
+  )
+
+(include "i18n.scm")
+
+(define (my-fields) `((comment     ,(M_ "Real Name") 40)
+                      (name        ,(M_ "User Name") 40)
+                      (home        ,(M_ "Home Directory") 16)))
+
+(define (make-user-edit-page parent title)
+  (let ((page (make-page (page-surface parent)
+                       title
+                       user-edit-refresh
+                       1
+                       user-edit-page-key-handler)))
+
+    (page-set-datum! page 'parent parent)
+    page))
+
+
+(define (user-edit-refresh page)
+  (when (not (page-initialised? page))
+    (user-edit-page-init page)
+    (page-set-initialised! page #t))
+  (let ((form  (page-datum page 'form)))
+    (refresh* (outer (page-wwin page)))
+    (refresh* (form-window form))))
+
+(define (user-edit-page-key-handler page ch)
+  (let ((form  (page-datum page 'form))
+       (nav   (page-datum page 'navigation))
+        (parent   (page-datum page 'parent))
+       (dev   (page-datum page 'device)))
+
+    (cond
+     ((buttons-key-matches-symbol? nav ch 'save)
+      (set! users
+            (cons
+             (user-account
+              (name    (form-get-value form 'name))
+              (supplementary-groups '("video" "audio" "desktop"))
+              (group   "users")
+              (comment (form-get-value form 'comment))
+              (home-directory (form-get-value form 'home)))
+             (remove (lambda (user)
+                       (equal? user (page-datum page 'account)))
+                     users)))
+      (page-set-initialised! parent #f)
+      (page-leave))
+
+     ((buttons-key-matches-symbol? nav ch 'cancel)
+      (page-leave))
+
+     ((or (eq? ch KEY_RIGHT)
+         (eq? ch #\tab))
+      (form-set-enabled! form #f)
+      (buttons-select-next nav))
+
+     ((eq? ch KEY_LEFT)
+      (form-set-enabled! form #f)
+      (buttons-select-prev nav))
+
+     ((eq? ch KEY_UP)
+      (buttons-unselect-all nav)
+      (form-set-enabled! form #t))
+
+     ((eq? ch KEY_DOWN)
+      (buttons-unselect-all nav)
+      (form-set-enabled! form #t)))
+
+    (form-enter form ch)
+  #f))
+
+(define my-buttons `((save ,(M_ "Save") #f)
+                    (cancel     ,(M_ "Cancel") #f)))
+
+(define (user-edit-page-init p)
+  (let* ((s (page-surface p))
+        (pr (make-boxed-window
+             #f
+             (- (getmaxy s) 4) (- (getmaxx s) 2)
+             2 1
+             #:title (page-title p)))
+
+        (text-window (derwin (inner pr) 3 (getmaxx (inner pr))
+                             0 0 #:panel #t))
+
+        (bwin (derwin (inner pr)
+                      3 (getmaxx (inner pr))
+                      (- (getmaxy (inner pr)) 3) 0
+                      #:panel #t))
+
+        (nav (make-buttons my-buttons 1))
+
+        (fw (derwin (inner pr)
+                     (-
+                      (getmaxy (inner pr))
+                      (getmaxy text-window)
+                      (getmaxy bwin))
+                    (getmaxx (inner pr))
+                    (getmaxy text-window) 0 #:panel #f))
+
+        (form (make-form (my-fields))))
+
+    (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)))
+
+    (push-cursor (page-cursor-visibility p))
+    (buttons-post nav bwin)
+    (page-set-datum! p 'form form)
+
+    (page-set-wwin! p pr)
+    (refresh* (outer pr))))
diff --git a/gnu/system/installer/users.scm b/gnu/system/installer/users.scm
index 03137cf..4234095 100644
--- a/gnu/system/installer/users.scm
+++ b/gnu/system/installer/users.scm
@@ -20,6 +20,7 @@
   #:use-module (gnu system installer page)
   #:use-module (gnu system installer misc)
   #:use-module (gnu system installer utils)
+  #:use-module (gnu system installer user-edit)
   #:use-module (gnu system shadow)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
@@ -42,9 +43,9 @@
             users-page-key-handler))
 
 
-(define my-buttons `((delete ,(M_ "_Delete") #t)
-                     (add ,(M_ "_Add") #t)
-                     (cancel ,(M_ "Canc_el") #t)))
+(define my-buttons `((add ,(M_ "_Add") #t)
+                     (delete ,(M_ "_Delete") #t)
+                     (continue ,(M_ "_Continue") #t)))
 
 (define (users-page-key-handler page ch)
   (let ((menu (page-datum page 'menu))
@@ -76,11 +77,14 @@
       (buttons-unselect-all nav)
       (menu-set-active! menu #t))
 
-
      ((select-key? ch)
-      (page-leave))
+      (let* ((account  (menu-get-current-item menu))
+            (next  (make-user-edit-page page  "Edit User")))
+
+       (page-set-datum! next 'account account)
+        (page-enter next)))
 
-     ((buttons-key-matches-symbol? nav ch 'cancel)
+     ((buttons-key-matches-symbol? nav ch 'continue)
       (page-leave))
 
      ((buttons-key-matches-symbol? nav ch 'delete)